组合两个lisp fun时出现问题
大家好，我成功地构建了这个lisp：
(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)
第一部分删除所有以“B-OI-”开头的层名称中的一部分。
第二部分将所有层的颜色更改为真彩色。
但是。。。我只希望符合第一个标准（“B-OI-”）的图层更改为颜色。
当我将代码更改为下面的代码时，更改颜色部分可以工作，但它不再重命名我的层。。。
(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)
有什么建议吗？？ 帮自己一个大忙，正确地缩进代码。
在第一个代码块中，函数在（vla endundomark adoc）之前结束。
(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)
)
)
)
) 也许这种解剖将有助于：
;; Define function, declare local variables
(defun c:HBKLICMelding ( / col doc lay lst )
;; Assign the Active Document object to a local variable
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
;; If an undo group is already open
(if (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc) ;; close it
) ;; end if
;; Open a new undo group
(vla-startundomark doc)
;; For each Layer object in the Layers Collection
(vlax-for obj (vla-get-layers doc)
;; Retrieve the layer name
(setq lay (vla-get-name obj))
;; if the layer name starts with "B-OI-"
(if (wcmatch (strcase lay) "B-OI-*")
;; Then do the following:
(progn
;; If the layer name has more than 28 characters
(if (< 28 (setq len (strlen lay)))
;; Then rename the layer
;; (wrap in vl-catch-all-apply in case another layer exists with the same name - sledgehammer approach)
(vl-catch-all-apply 'vla-put-name (list obj (strcat (substr lay 1 (- len 28)) (substr lay (1- len)))))
) ;; end if
;; Retrieve current layer color (color object)
(setq col (vla-get-truecolor obj))
;; If the color object is set to use an ACI color
(if (= accolormethodbyaci (vla-get-colormethod col))
;; Then do the following:
(progn
;; Retrieve the current RGB values
(setq lst (mapcar 'vlax-get-property (list col col col) '(red green blue)))
;; Change the color method to RGB
(vla-put-colormethod col accolormethodbyrgb)
;; Configure the RGB values accordingly
(apply 'vla-setrgb (cons col lst))
;; Apply the color to the layer
(vla-put-truecolor obj col)
) ;; end progn
) ;; end if
) ;; end progn
) ;; end if
) ;; end vlax-for
;; Close the open undo group
(vla-endundomark doc)
;; Suppress the value returned by the last evaluated expression
(princ)
) ;; end defun
;; Load the ActiveX component of Visual LISP and suppress the value returned on load
(vl-load-com) (princ)
你说得很对，罗伊-以下内容在AutoCAD中也适用：
(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
)
)
) 谢谢李。你的建议（又一次）奏效了
页:
[1]