Lisp发送*显示*颜色
首先，我想感谢用户“irneb”完成了代码的第一部分，该部分根据对象的显示颜色选择对象。通过使用它，我添加了将这些对象发送回的功能。在我们的绘图表中，我们希望所有屏幕小于100%的对象都打印在所有实心黑线的“下方”，这就实现了这一点。
也就是说，有没有更好的方法来编码代码的较低部分？我是新来的，很难做到这一点，但我相信有一种更有效的方式来完成上述任务。最后，这种方法不包括块内的线——有没有办法将“颜色15”和“颜色17”（不是BYLAYER，块内的所有线都在第0层）发送回图形中的所有块内？我试了好几次都没用。谢谢你的帮助！！
;Shade2Back
(defun c:s2b()
(defun ssfilter-by-color (color / lay layers)
;; Get all the layer names which are set to the color
(setq lay (tblnext "LAYER" t) ;Get the 1st layer
layers "" ;Initialize the layer names filter string
)
(while lay ;Step through all layers
;; Check if current layer is set to color
(if (= (cdr (assoc 62 lay)) color)
(setq layers (strcat "," (cdr (assoc 2 lay)) layers)) ;Add to filter string
)
(setq lay (tblnext "LAYER")) ;Get the next layer
)
(if (= layers "")
(list (cons 62 color))
(list '(-4 . "<OR")
'(-4 . "<AND")
(cons 8 (substr layers 2))
'(62 . 256)
'(-4 . "AND>")
(cons 62 color)
'(-4 . "OR>")
)
)
)
(setq ss13 (ssget "_x" (ssfilter-by-color 13)))
(setq ss15 (ssget "_x" (ssfilter-by-color 15)))
(setq ss17 (ssget "_x" (ssfilter-by-color 17)))
(setq ss23 (ssget "_x" (ssfilter-by-color 23)))
(setq ss24 (ssget "_x" (ssfilter-by-color 24)))
(setq ss26 (ssget "_x" (ssfilter-by-color 26)))
(command "_draworder" ss17 "" "_back")
(command "_draworder" ss15 "" "_back")
(command "_draworder" ss13 "" "_back")
(command "_draworder" ss23 "" "_back")
(command "_draworder" ss24 "" "_back")
(command "_draworder" ss26 "" "_back")
(princ)) 您是否要求按特定顺序（根据您当前的代码）将具有各种颜色（13、15、17等）的对象发送到后面，或者只是要求所有此类对象显示在图形中其他对象的下方？ 我想我更倾向于这样的事情：
(defun c:db-s2b (/ cl td c l str ss)
(while (setq td (tblnext "LAYER" (not td)))
(setq c (cdr (assoc 62 td))
l (cdr (assoc 2 td)))
(if (assoc c cl)
(setq cl (subst (cons c (strcat (cdr (assoc c cl)) "," l))
(assoc c cl) cl))
(setq cl (cons (cons c l) cl))))
(foreach v '(13 15 17 23 24 26)
(and (setq str (cdr (assoc v cl)))
(setq ss (ssget "X" (list (cons 8 str))))
(command "_.DRAWORDER" ss "" "_Back")))
(prin1))
您只需通过图层表一次。
-大卫 或者，如果发送到后面的层的顺序无关紧要：
(defun c:s2b-lm ( / sel )
(if (setq sel (ssget "_X" (getfilter '(13 15 17 23 24 26))))
(command "_.draworder" sel "" "_b")
)
(princ)
)
(defun getfilter ( lst / def rtn )
(while (setq def (tblnext "layer" (not def)))
(if (member (abs (cdr (assoc 62 def))) lst)
(setq rtn (vl-list* "," (cdr (assoc 2 def)) rtn))
)
)
(append
'((-4 . "<OR"))
(mapcar '(lambda ( x ) (cons 62 x)) lst)
(if rtn
(append
'((-4 . "<AND"))
(list (cons 8 (apply 'strcat (cdr rtn))) '(62 . 256))
'((-4 . "AND>"))
)
)
'((-4 . "OR>"))
)
)
以上未经测试。 非常感谢您的帮助，以上两个代码都可以工作，而且非常干净、快速！！我确实喜欢David的代码按特定顺序将颜色发送回，例如，它可以将深色阴影线放在浅色阴影线的顶部。
我仍然不确定你如何在一幅图的所有块中都能做到这一点，最接近的例子是在一篇帖子中，它在块内发送“wipeout”。李的这段代码是否可以修改为将特定的颜色发送到背面？我试过了，但似乎没能成功。如果有什么不同的话，我需要发送到后面的唯一颜色是块内的15，而不是BYLAYER，是（cons 62.15）（？？）。再次感谢，我已经摸索了一个多星期了，但没有取得多大成功。
>>>>>在图形中的所有块内向后发送区域覆盖的代码-
(defun c:test ( / acdoc )
;; Lee Mac 20.06.11
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for block (vla-get-blocks acdoc)
(if
(and
(eq :vlax-false (vla-get-islayout block))
(eq :vlax-false (vla-get-isxref block))
)
(
(lambda ( / lst )
(vlax-for obj block
(if (eq "AcDbWipeout" (vla-get-objectname obj))
(setq lst (cons obj lst))
)
)
(if lst
(vla-movetobottom (LM:SortentsTable block)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst
)
)
)
)
)
)
)
)
(vla-regen acdoc acallviewports)
(princ)
)
(defun LM:SortentsTable ( space / dict result )
(cond
(
(not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply 'vla-item
(list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS")
)
)
)
)
result
)
( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") )
)
)
(vl-load-com) (princ) 有人接受吗？我真的很想能够发送所有实体与颜色15回。我附上了两张图片，表达了这是一个问题的原因。将其乘以20或30个单独的块名和多达20个图形。。。。任何帮助都将不胜感激！
https://s31.postimg.org/fq6z4c2ob/shadeover.jpg
https://s31.postimg.org/4ckft4s5n/shade_under.jpg 我对字典的了解还不够。
我想我可以收集所有的ename并添加/修改/操作字典定义-大卫 请尝试以下操作：
;; Colour to Back-Lee Mac
;; Sends all objects of a specific colour (object colour/layer colour) to the back of the draw order.
(defun c:col2back ( / *error* col doc lac lck )
(setq col 15) ;; Colour to send to back
(vlax-for lay (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object))))
(if (= :vlax-true (vla-get-lock lay))
(vla-put-lock (car (setq lck (cons lay lck))) :vlax-false)
)
(if (= col (vla-get-color lay))
(setq lac (cons (vla-get-name lay) lac))
)
)
(vlax-for blk (vla-get-blocks doc)
(if (= :vlax-false (vla-get-isxref blk))
( (lambda ( / lst )
(vlax-for obj blk
(if (or (and (= acbylayer (vla-get-color obj)) (member (vla-get-layer obj) lac))
(= col (vla-get-color obj))
)
(setq lst (cons obj lst))
)
)
(if lst
(vlax-invoke
(vla-addobject
(vla-getextensiondictionary blk)
"acad_sortents"
"acdbsortentstable"
)
'movetobottom lst
)
)
)
)
)
)
(foreach lay lck (vla-put-lock lay :vlax-true))
(vla-regen doc acallviewports)
(princ)
)
(vl-load-com) (princ) 李，我疯了！我让办公室里的每个人都对这件事垂涎三尺——多年来，这一直是一件让人恼火的事，没有人敢处理它。非常感谢CADtutor和这里愿意帮助他人的杰出人士！再次感谢李和大卫的帮助！ 很高兴听到jweber的演讲，我很高兴这个项目对你的工作很有用-谢谢你的感谢
页:
[1]
2