[编程交流] 组合两个lisp fun时出现问题

(defun c:HBKLICMelding (/ adoc item afstandbegin afstandeind truecol aci R G B)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(vlax-for item (vla-get-layers adoc)
        (vl-catch-all-apply 'vla-put-name 
                (list item
                        (cond
                                ((= (substr(vla-get-name item)1 5) "B-OI-")
                                (setq afstandbegin (-(strlen (vla-get-name item))28))
                                (setq afstandeind (-(strlen (vla-get-name item))1))
                                (strcat (substr(vla-get-name item)1 afstandbegin)(substr(vla-get-name item) afstandeind))
                                )
                                (t
                                (princ)
                                )
                        )
                )
        )
)
(vlax-for item (vla-get-layers adoc)
(setq truecol (vla-get-truecolor item))
        (if (= (vla-get-ColorMethod truecol) acColorMethodByACI)
                (progn
                        (setq aci (vla-get-ColorIndex truecol))            
                        (vla-put-ColorMethod truecol acColorMethodByRGB)
                        (vla-put-ColorIndex truecol aci)
                        (setq R (vla-get-red truecol))
                        (setq G (vla-get-green truecol))
                        (setq B (vla-get-blue truecol))
                        (vla-setRGB truecol R G B)
                        (vla-put-truecolor item truecol)
                        )
                )
        )  
)
(vla-endundomark adoc)
(princ)
)
(princ)

(defun c:HBKLICMelding (/ adoc item afstandbegin afstandeind truecol aci R G B)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(vlax-for item (vla-get-layers adoc)
        (vl-catch-all-apply 'vla-put-name 
                (list item
                        (cond
                                ((= (substr(vla-get-name item)1 5) "B-OI-")
                                (setq afstandbegin (-(strlen (vla-get-name item))28))
                                (setq afstandeind (-(strlen (vla-get-name item))1))
                                (strcat (substr(vla-get-name item)1 afstandbegin)(substr(vla-get-name item) afstandeind))
                                (setq truecol (vla-get-truecolor item))
                                (setq aci (vla-get-ColorIndex truecol))            
                                (vla-put-ColorMethod truecol acColorMethodByRGB)
                                (vla-put-ColorIndex truecol aci)
                                (setq R (vla-get-red truecol))
                                (setq G (vla-get-green truecol))
                                (setq B (vla-get-blue truecol))
                                (vla-setRGB truecol R G B)
                                (vla-put-truecolor item truecol)
                                )
                                (t
                                (princ)
                                )
                        )
                )
        )
)
(vla-endundomark adoc)
(princ)
)
(princ)

(if (= (substr (vla-get-name item) 1 5) "B-OI-")
 (progn
   (setq newName ...)
   (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list item newName))))
     (progn
       ...
       (vla-put-truecolor item truecol)
     )
   )
 )
)

[color=GREEN];; Define function, declare local variables[/color]
([color=BLUE]defun[/color] c:HBKLICMelding ( [color=BLUE]/[/color] col doc lay lst )
   [color=GREEN];; Assign the Active Document object to a local variable[/color]
   ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   [color=GREEN];; If an undo group is already open[/color]
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 8 ([color=BLUE]logand[/color] 8 ([color=BLUE]getvar[/color] 'undoctl)))
       ([color=BLUE]vla-endundomark[/color] doc) [color=GREEN];; close it[/color]
   ) [color=GREEN];; end if[/color]
   
   [color=GREEN];; Open a new undo group[/color]
   ([color=BLUE]vla-startundomark[/color] doc)
   [color=GREEN];; For each Layer object in the Layers Collection[/color]
   ([color=BLUE]vlax-for[/color] obj ([color=BLUE]vla-get-layers[/color] doc)
       [color=GREEN];; Retrieve the layer name[/color]
       ([color=BLUE]setq[/color] lay ([color=BLUE]vla-get-name[/color] obj))
       
       [color=GREEN];; if the layer name starts with "B-OI-"[/color]
       ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] lay) [color=MAROON]"B-OI-*"[/color])
           [color=GREEN];; Then do the following:[/color]
           ([color=BLUE]progn[/color]
               [color=GREEN];; If the layer name has more than 28 characters[/color]
               ([color=BLUE]if[/color] ([color=BLUE]<[/color] 28 ([color=BLUE]setq[/color] len ([color=BLUE]strlen[/color] lay)))
                   
                   [color=GREEN];; Then rename the layer[/color]
                   [color=GREEN];; (wrap in vl-catch-all-apply in case another layer exists with the same name - sledgehammer approach)[/color]
                   ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] obj ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] lay 1 ([color=BLUE]-[/color] len 28)) ([color=BLUE]substr[/color] lay ([color=BLUE]1-[/color] len)))))
                   
               ) [color=GREEN];; end if[/color]
               [color=GREEN];; Retrieve current layer color (color object)[/color]
               ([color=BLUE]setq[/color] col ([color=BLUE]vla-get-truecolor[/color] obj))
               [color=GREEN];; If the color object is set to use an ACI color[/color]
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=BLUE]accolormethodbyaci[/color] ([color=BLUE]vla-get-colormethod[/color] col))
                   [color=GREEN];; Then do the following:[/color]
                   ([color=BLUE]progn[/color]
                       [color=GREEN];; Retrieve the current RGB values[/color]
                       ([color=BLUE]setq[/color] lst ([color=BLUE]mapcar[/color] '[color=BLUE]vlax-get-property[/color] ([color=BLUE]list[/color] col col col) '(red green blue)))
                       [color=GREEN];; Change the color method to RGB[/color]
                       ([color=BLUE]vla-put-colormethod[/color] col [color=BLUE]accolormethodbyrgb[/color])
                       [color=GREEN];; Configure the RGB values accordingly[/color]
                       ([color=BLUE]apply[/color] '[color=BLUE]vla-setrgb[/color] ([color=BLUE]cons[/color] col lst))
                       [color=GREEN];; Apply the color to the layer[/color]
                       ([color=BLUE]vla-put-truecolor[/color] obj col)
                       
                   ) [color=GREEN];; end progn[/color]
                   
               ) [color=GREEN];; end if[/color]
               
           ) [color=GREEN];; end progn[/color]
           
       ) [color=GREEN];; end if[/color]
       
   ) [color=GREEN];; end vlax-for[/color]
   [color=GREEN];; Close the open undo group[/color]
   ([color=BLUE]vla-endundomark[/color] doc)
   
   [color=GREEN];; Suppress the value returned by the last evaluated expression[/color]
   ([color=BLUE]princ[/color])
) [color=GREEN];; end defun[/color]
[color=green];; Load the ActiveX component of Visual LISP and suppress the value returned on load[/color]
([color=blue]vl-load-com[/color]) ([color=blue]princ[/color])

(defun KGA_Sys_ObjectColor_Aci_To_Rgb (obj / clr rgb)
 (if (= accolormethodbyaci (vla-get-colormethod (setq clr (vla-get-truecolor obj))))
   (progn
     (setq rgb (list (vla-get-red clr) (vla-get-green clr) (vla-get-blue clr)))
     (apply 'vla-setrgb (cons clr rgb)) ; Also changes the color method.
     (vla-put-truecolor obj clr)
     rgb
   )
 )
)