将柔和的颜色更改为altern
你好这是我的第一篇帖子。这是我和LISP的历史。我已经在工作中使用它两天了，到目前为止，我一直在尝试为Autocad 2008开发一个功能强大的LISP例程。我的问题是：
我有一系列518幅画。我将使用scriptpro运行它们，并应用LISP例程执行以下操作：
循环浏览图形中的所有图层，如果它们是黄色、青色或品红色，则分别将其更改为绿色、蓝色和红色。我还需要它运行任何和所有元素在绘图中做同样的事情，也要（命令“突发”）所有块应用相同的颜色变化。有道理？
我有一个破除障碍的代码：
（defun c：胸围（）
;（setvar“qaflags”1）
（setq ALLBOCKS（ssget“X”（列表（cons 0“INSERT”）））
（while（/=AllBlocks nil）
（程序
（sssetfirst nil ALLBOCKS）
（c：突发）
（setq ALLBOCKS（ssget“X”（列表（cons 0“INSERT”）））
（setq doc（vla get ActiveDocument（vlax get acad object）））
（vla SendCommand doc（chr 27））
);程序
);虽然
（普林斯）
);德芬
我有一个代码（仅适用于一种颜色，而不是所有3种颜色）用于更改图形中的元素（仅适用于纸张或模型空间，而不是我需要的两种）：
（定义c:pastel2（）
（setq-ylo（ssget“X”'（（62.2）））
（while（/=ylo nil）
（程序
（命令“_.change”ylo““p”color“green”）
（setq-ylo（ssget“X”'（（62.2）））
);程序
);虽然
（setq-cya（ssget“X”'（（62.4）））
（而（/=cya nil）
（程序
（命令“_.change”cya““p”“color”“blue”）
（setq-cya（ssget“X”'（（62.4）））
);程序
);虽然
（setq mag（ssget“X”（（62.6）））
（while（/=mag nil）
（程序
（命令“_.change”mag““p”color“red”）
（setq mag（ssget“X”（（62.6）））
);程序
);虽然
（setq doc（vla get ActiveDocument（vlax get acad object）））
（vla SendCommand doc（chr 27））
（普林斯）
);德芬
有人想帮我吗？非常感谢。 这将影响除“ByLayer”之外设置了颜色的任何对象：
(defun c:Pastel2 nil
(mapcar
(function
(lambda ( oc nc )
(if (setq ss (ssget "_X" (list (cons 62 oc))))
(
(lambda ( x )
(while (setq e (ssname ss (setq x (1+ x))))
(ColourChange e nc)
)
)
-1
)
)
)
)
'(2 4 6)
'(3 5 1)
)
(princ)
)
(defun ColourChange ( ent col / el )
;; © Lee Mac 2010
(entupd
(cdr
(assoc -1
(entmod
(if (assoc 62 (setq el (entget ent)))
(subst
(cons 62 col) (assoc 62 el) el
)
(append el (list (cons 62 col)))
)
)
)
)
)
)
谢谢你的代码李，但我需要影响的颜色是由层以及。
这将需要更多的代码-我将发布一个示例 尝试以下操作：
(defun c:Pastel2 ( / def l )
;; © Lee Mac 2010
(while (setq def (tblnext "LAYER" (not def)))
(setq l
(cons
(cons (abs (cdr (assoc 62 def))) (cdr (assoc 2 def))) l
)
)
)
(mapcar
(function
(lambda ( oc nc / a )
(if (setq ss
(ssget "_X"
(if (setq a (LM:mAssoc oc l))
(list
(cons -4 "<OR")
(cons 62 oc)
(cons 8 (LM:lst->str (mapcar 'cdr a) ","))
(cons -4 "OR>")
)
(list (cons 62 oc))
)
)
)
(
(lambda ( x )
(while (setq e (ssname ss (setq x (1+ x))))
(LM:ColourChange e nc)
)
)
-1
)
)
)
)
'(2 4 6)
'(3 5 1)
)
(princ)
)
(defun LM:ColourChange ( ent col / el )
;; © Lee Mac 2010
(entupd
(cdr
(assoc -1
(entmod
(if (assoc 62 (setq el (entget ent)))
(subst
(cons 62 col) (assoc 62 el) el
)
(append el (list (cons 62 col)))
)
)
)
)
)
)
(defun LM:lst->str ( lst del )
;; © Lee Mac 2010
(if (cdr lst)
(strcat (car lst) del (LM:lst->str (cdr lst) del))
(car lst)
)
)
(defun LM:mAssoc ( x lst )
;; © Lee Mac 2010
(vl-remove-if-not
(function
(lambda ( pair ) (= x (car pair)))
)
lst
)
)
它不会改变图层颜色，而是设置单独的颜色，但我不确定其意图。 李，太棒了！
是的，我想在图层属性管理器中更改图层颜色，但这也可以。
知道任何快速代码来打破模型和图纸空间中的所有块吗？
此代码目前仅在其中一种情况下有效。
(defun c:bust ()
;(setvar "qaflags" 1)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(while (/= AllBlocks nil)
(progn
(sssetfirst nil AllBlocks)
(c:burst)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-SendCommand doc (chr 27))
);progn
);while
(princ)
);defun 你到底为什么要炸掉你所有的积木？
我也这么认为：
(defun c:Pastel3 ( / col def a )
;; © Lee Mac 2010
(setq col '((2 . 3) (4 . 5) (6 . 1)))
(while (setq def (tblnext "LAYER" (not def)))
(if (setq a (assoc (abs (cdr (assoc 62 def))) col))
(LM:ColourChange (tblobjname "LAYER" (cdr (assoc 2 def))) (cdr a))
)
)
(mapcar
(function
(lambda ( entry / ss )
(if (setq ss (ssget "_X" (list (cons 62 (car entry)))))
(
(lambda ( x / e )
(while (setq e (ssname ss (setq x (1+ x))))
(LM:ColourChange e (cdr entry))
)
)
-1
)
)
)
)
col
)
(princ)
)
(defun LM:ColourChange ( ent col / el )
;; © Lee Mac 2010
(entupd
(cdr
(assoc -1
(entmod
(if (assoc 62 (setq el (entget ent)))
(subst
(cons 62 col) (assoc 62 el) el
)
(append el (list (cons 62 col)))
)
)
)
)
)
)
alanjt：
这些图纸是在实际绘图过程中绘制的，直接交给操作员打印。我知道这不是最漂亮的解决方案，但我想把它们全部爆裂，把它们变成单个实体，以最简单的形式改变颜色。我只是没有Lisp程序的诀窍去做那个ByBlock。 李，带着一个错误回来说：
命令：pastel3
; 错误：没有函数定义：colorchange
页:
[1]
2