社区 › Auto Lisp › 所有层的颜色变化

cadamrao 发表于 2022-7-6 08:33:57

所有层的颜色变化

你好
 
这个lisp是从别人那里收集的，但我需要稍加修改；当我应用命令ColorX时，选择显示的颜色（索引对话框）。选择ok后，我需要在命令行询问select object；这意味着我需要更改颜色选择窗口。
谢谢
文基
 
defun C:ColorX（/文档列）
（vl load com）
（setq doc（vla get activedocument（vlax get acad object）））
（vla startundomark文件）
（mip：图层状态保存）
（if（setq col（acad\U colordlg 7 t））
（更改对象颜色文档列）；_col-颜色编号
)
（mip：层状态恢复）
（vla ENDUDOMARK文件）
（普林斯）
)
（princ“\n在命令行中键入ColorX”）
所有层的颜色变化。lsp

Tharwat 发表于 2022-7-6 08:43:51

像这样的？
 

(defun c:TesT (/ color ss i obj)
(vl-load-com)
;;; Tharwat 12. Dec. 2011 ;;;
(cond ((not acdoc) (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))))
(if (and (setq color (acad_colordlg 7 t)) (setq ss (ssget "_:L")))
   (progn (vla-startundomark acdoc)
          (repeat (setq i (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
            (vla-put-color obj color)
          )
          (vla-endundomark acdoc)
   )
   (princ)
)
(princ)
)

SLW210 发表于 2022-7-6 08:49:41

请阅读代码发布指南。

cadamrao 发表于 2022-7-6 08:52:05

 
 
 
 
 
 
抱歉，无法更改块对象。请检查您的代码。

Tharwat 发表于 2022-7-6 08:58:10

无论如何，看看这个。。。
 

(defun c:TesT (/ color ss i sn obj lst name)
(vl-load-com)
;;; Tharwat 13. Dec. 2011 ;;;
(cond ((not acdoc) (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))))
(if (and (setq color (acad_colordlg 7 t)) (setq ss (ssget "_:L")))
   (progn (vla-startundomark acdoc)
          (repeat (setq i (sslength ss))
            (setq obj (vlax-ename->vla-object (setq sn (ssname ss (setq i (1- i))))))
            (if (eq (cdr (assoc 0 (entget sn))) "INSERT")
            (vlax-for block (setq blk (vla-item (vla-get-blocks acdoc) (setq name (vla-get-EffectiveName obj))))
                (if (and (eq :vlax-false (vla-get-isLayout blk))
                         (eq :vlax-false (vla-get-isXref blk))
                         (if (not (member name lst))
                           (setq lst (cons name lst))
                         )
                  )
                  (vlax-for x blk
                  (if (not (eq "AcDbBlockReference" (vla-get-objectname x)))
                      (vla-put-color x color)
                  )
                  )
                )
            )
            (vla-put-color obj color)
            )
          )
          (vla-regen acdoc acAllViewports)
          (vla-endundomark acdoc)
   )
   (princ)
)
(princ)
)

pBe 发表于 2022-7-6 09:05:02

 
是否要更改所选实体的颜色或层的颜色？

Arin9916 发表于 2022-7-6 09:10:55

(defun c:aa( / doc bl ss co )
   (PTE:subload-111213-g)
   
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         bl(vla-get-blocks doc)
         ss(PTE:ss->obj(ssget))
         co(acad_colordlg 256 t)
   )
   
   (foreach ob ss
       (if (= (vla-get-objectname ob) "AcDbBlockReference")
         (PTE:changeC_ ob bl co)
         (vla-put-color ob co)
       )
   )(vla-regen doc acAllViewports)
   (princ)
)(vl-load-com)

(defun PTE:subload-111213-g nil
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 01            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:ss->obj ( ss / i re )
       (if ss
         (repeat (setq i (sslength ss))
               (setq re (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) re))
         )
       )
   )
   
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 02            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:changeC_ ( obj bl co )
       (vlax-for obj (vla-item bl (vla-get-name obj))
         (if (= (vla-get-objectname obj) "AcDbBlockReference")
               (PTE:changeC_ obj bl co)
               (vla-put-color obj co)
         )
       )
   )
)

pBe 发表于 2022-7-6 09:14:43

伙计们，我不明白为什么需要lisp代码，如果OP只希望实体是特定的颜色，其中颜色属性将不是“Bylayer”，对于块实体来说也一样：你真的不需要代码。用你们编写的代码Besdes将更改块的所有实例，而不仅仅是选定的块实体
 
这就是我要求OP澄清他的要求的原因
 
我认为更改当前指定实体所在层的颜色更可能是OP想要的（或者我认为是这样）
 
也许是这样的
 
(defunc:test (/ LayerColl e ss lst)
(vl-load-com)
(setqLayerColl
    (vla-get-Layers
      (vla-get-activedocument (vlax-get-acad-object))
      )
   )
(if (and (setq color (acad_colordlg 7 t))
       (setq ss (ssget)))
   (repeat (sslength ss)
   (setq e (cdr (assoc 8 (entget (ssname ss 0)))))
   (if (not (member e lst))
       (progn
         (vla-put-color (vla-item LayerColl e) color)
         (setq lst (cons e lst))
         )
       )
   (ssdel (ssname ss 0) ss)
   )
   )
)
 
授予所有enities颜色属性为“Bylayer”

cadamrao 发表于 2022-7-6 09:17:55

 
 
 
嗨，早上好！！！！！！！
 
（定义c:aa（/doc bl ss co）
（PTE:subload-111213-g）
 
（setq doc（vla get activedocument（vlax get acad object））
bl（vla get blocks doc）
ss（PTE:ss->obj（ssget））
co（acad_colordlg 256 t）
)
 
（foreach ob ss）
（if（=（vla get objectname ob）“AcDbBlockReference”）
（PTE:CHANGE C\ob bl co）
（vla put color ob co）
)
)（vla regen doc acAllViewports）
（普林斯）
)（vl load com）
 
（defun PTE:subload-111213-g零
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;;             子功能-01；；
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
（定义：ss->obj（ss/i re）
（如果ss
（重复（setq i（sslength ss））
（setq re（cons（vlax ename->vla object（ssname ss（setq i（1-i）））re））
)
)
)
 
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;;             子功能-02；；
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
（defun PTE:changeC_（obj bl co）
（用于obj的vlax（vla项目bl（vla get name obj））
（if（=（vla get objectname obj）“AcDbBlockReference”）
（私人股本：CHANGE C_ujBL co）
（vla put color obj co）
)
)
)
)
 
 
谢谢你的代码，做得很好。这个很好用，在再次更改颜色（包括块）后，我需要逐层更改，时间代码在块中不起作用（块颜色无法更改）。
 
再次感谢您的精彩作品
 
文基

pBe 发表于 2022-7-6 09:23:28

 
我被纠正了
 
奇怪的是，如果是这样的话，为什么不直接使用_属性呢？
 
另一个例子---end证明了方法---

查看完整版本: 所有层的颜色变化