改变所有颜色的lisp 13
问候语。我的画有13色的实体（不是图层颜色），需要更改为青色。这些实体嵌入在不同的块、不同的嵌套级别和不同的层中。请帮助lisp将所有实体颜色13更改为青色。
感谢任何人的帮助。 以下是一些让您开始学习的内容：
(defun c:test (/ *error* ss cnt)
(defun *error* (msg)
(if (not
(member msg '("Function cancelled" "quit / exit abort"))
)
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq ss (ssget "_X")
cnt 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss cnt)))
;;;Need to check if block is an xref or a layout and if so, ignore rest of code
;;;Use an if or statement or an if and statement to do this
(if (= (vla-get-truecolor obj) colortype)
(vla-put-truecolor obj desiredcolor)
)
(setq cnt (+ cnt 1))
)
) 不适用于外部参照，仅适用于嵌套到任何深度的块。。。也许李可以做到这一点，并为外部参照，但这是好的，这就是。。。
(defun c:chcolor ( / process sc dc ss i ent blnlst enx )
(vl-load-com)
(defun process ( b / ent blnlst enx )
(setq ent (tblobjname "BLOCK" b))
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (entget ent))) "INSERT")
(progn
(if
(and
(not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
(not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
)
(if blnlst
(foreach b blnlst
(process b)
)
)
)
(alert "Choose source color to be changed...")
(setq sc (acad_truecolordlg 256))
(alert "Choose destination color to be changed into...")
(setq dc (acad_truecolordlg 256))
(if (not (equal (sssetfirst nil (ssget "_A")) '(nil nil)))
(setq ss (ssget "_:L"))
)
(if ss
(progn
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(if (= (cdr (assoc 0 (entget ent))) "INSERT")
(progn
(if
(and
(not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
(not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
)
(if blnlst
(foreach b blnlst
(process b)
)
)
)
)
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
(princ)
)
M.R。
当做 这个？
只需将'（2 50 51）替换为'（13），将8替换为4。 马尔科先生，我遇到了一个错误。
出错后，我重新生成，然后颜色确实发生了变化。不需要外部参照。最好不要触摸外部参照。该文件中只有dwg。
我的工作伙伴ask可以选择块而不是整个图形。
谢谢你，先生
斯特凡先生，情况确实发生了变化。效果很好。
工作伙伴ask可以选择块，而不是更改整个图形。
谢谢你，先生 当然
(defun c:test ( / acdoc ss) (vl-load-com)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
(if
(ssget ":L")
(progn
(vlax-for obj (setq ss (vla-get-activeselectionset acdoc))
(change2cyan obj)
)
(vla-delete ss)
)
)
(vla-regen acdoc acAllViewports)
(princ)
)
(defun change2cyan (obj)
(cond
((eq (vla-get-objectname obj) "AcDbBlockReference")
(vlax-for x (vla-item (vla-get-blocks acdoc) (vla-get-name obj))
(change2cyan x))
)
((= (vla-get-color obj) 13)
(vla-put-color obj 4)
)
)
) 谢谢，先生。
我还有最后一个小要求。如果进行了更改，可能会得到反馈&如果没有太多麻烦，可能会得到多少更改。
您好，我已经更新了我第一次发布的代码，以绕过您收到的错误消息，我希望。。。测试并通知我。。。对于块定义（不是参考-这是不可能的-只有单个CAD可以用相同的名称定义更新所有块）。。。
(defun c:chcolor-blk ( / process sc dc ss n s i ent blnlst enx )
(vl-load-com)
(defun process ( b / ent blnlst enx )
(setq ent (tblobjname "BLOCK" b))
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (entget ent))) "INSERT")
(progn
(if
(and
(not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
(not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
)
(if blnlst
(foreach b blnlst
(process b)
)
)
)
(alert "Choose source color to be changed...")
(setq sc (acad_truecolordlg 256))
(alert "Choose destination color to be changed into...")
(setq dc (acad_truecolordlg 256))
(alert "Pick Block Reference on unlocked layer...")
(setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
(while (or (not ss) (vlax-property-available-p (vlax-ename->vla-object (ssname ss 0)) 'Path))
(prompt "\nMissed or picked entity not INSERT entity or picked INSERT entity belong to Xref or picked entity not on unlocked layer... Try again...")
(setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
)
(setq n (vla-get-effectivename (vlax-ename->vla-object (ssname ss 0))))
(if (not (equal (sssetfirst nil (ssget "_A" '((0 . "INSERT")))) '(nil nil)))
(setq s (ssget "_:L"))
)
(setq ss (ssadd))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(if (= n (vla-get-effectivename (vlax-ename->vla-object e)))
(ssadd e ss)
)
)
(if ss
(progn
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
(progn
(setq enx (entget ent))
(foreach c dc
(if (not (assoc (car c) enx))
(setq enx (append enx (list c)))
(setq enx (subst c (assoc (car c) enx) enx))
)
)
(if (not (assoc 62 dc))
(setq enx (vl-remove (assoc 62 enx) enx))
)
(if (not (assoc 420 dc))
(setq enx (vl-remove (assoc 420 enx) enx))
)
(entupd (cdr (assoc -1 (entmod enx))))
)
)
)
(process n)
)
)
(prompt "\nProcessed : ") (princ (sslength ss)) (prompt (strcat " block references with name of picked reference : \"" n "\"\n"))
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
(textscr)
(princ)
)
谢谢你，先生。现在工作没有错误。
如果您允许此请求，我们将非常高兴：
-在没有弹出对话框的情况下请求颜色。在命令行中就足够了。所以我只需要输入134
-能够选择多个对象，包括窗户围栏
-当命令结束时，命令上指示有多少块已更改的消息非常奇妙，但命令编辑器不能弹出。消息中是否包含任何更改
谢谢marko先生
页:
[1]