Lisp发送*显示*颜色

jweber · 发表于 2022-7-5 16:45:37

首先，我想感谢用户“irneb”完成了代码的第一部分，该部分根据对象的显示颜色选择对象。

通过使用它，我添加了将这些对象发送回的功能。在我们的绘图表中，我们希望所有屏幕小于100%的对象都打印在所有实心黑线的“下方”，这就实现了这一点。

也就是说，有没有更好的方法来编码代码的较低部分？我是新来的，很难做到这一点，但我相信有一种更有效的方式来完成上述任务。最后，这种方法不包括块内的线——有没有办法将“颜色15”和“颜色17”（不是BYLAYER，块内的所有线都在第0层）发送回图形中的所有块内？我试了好几次都没用。谢谢你的帮助！！

copy


;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))

Lee Mac · 发表于 2022-7-5 16:49:01

您是否要求按特定顺序（根据您当前的代码）将具有各种颜色（13、15、17等）的对象发送到后面，或者只是要求所有此类对象显示在图形中其他对象的下方？

David Bethel · 发表于 2022-7-5 16:54:59

我想我更倾向于这样的事情：

copy


[b][color=BLACK]([/color][/b]defun c:db-s2b [b][color=FUCHSIA]([/color][/b]/ cl td c l str ss[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq td [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"LAYER"[/color] [b][color=GREEN]([/color][/b]not td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq c [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 62 td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              l [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 2 td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]assoc c cl[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq cl [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons c [b][color=RED]([/color][/b]strcat [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc c cl[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [color=#2f4f4f]","[/color] l[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                            [b][color=BLUE]([/color][/b]assoc c cl[b][color=BLUE])[/color][/b] cl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq cl [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]cons c l[b][color=BLUE])[/color][/b] cl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]foreach v '[b][color=NAVY]([/color][/b]13 15 17 23 24 26[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq str [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc v cl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 8 str[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.DRAWORDER"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_Back"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

您只需通过图层表一次。

-大卫

Lee Mac · 发表于 2022-7-5 16:56:58

或者，如果发送到后面的层的顺序无关紧要：

copy

(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>"))
   )
)

以上未经测试。

jweber · 发表于 2022-7-5 16:58:55

非常感谢您的帮助，以上两个代码都可以工作，而且非常干净、快速！！我确实喜欢David的代码按特定顺序将颜色发送回，例如，它可以将深色阴影线放在浅色阴影线的顶部。

我仍然不确定你如何在一幅图的所有块中都能做到这一点，最接近的例子是在一篇帖子中，它在块内发送“wipeout”。李的这段代码是否可以修改为将特定的颜色发送到背面？我试过了，但似乎没能成功。如果有什么不同的话，我需要发送到后面的唯一颜色是块内的15，而不是BYLAYER，是（cons 62.15）（？？）。再次感谢，我已经摸索了一个多星期了，但没有取得多大成功。

>>>>>在图形中的所有块内向后发送区域覆盖的代码-

copy

(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)

jweber · 发表于 2022-7-5 17:04:33

有人接受吗？我真的很想能够发送所有实体与颜色15回。我附上了两张图片，表达了这是一个问题的原因。将其乘以20或30个单独的块名和多达20个图形。。。。任何帮助都将不胜感激！

登录/注册后可看大图

David Bethel · 发表于 2022-7-5 17:04:54

我对字典的了解还不够。

我想我可以收集所有的ename并添加/修改/操作字典定义-大卫

Lee Mac · 发表于 2022-7-5 17:07:56

请尝试以下操作：

copy


;; 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)