所有层的颜色变化

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

像这样的？

copy


(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

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

copy


(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

copy


(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想要的（或者我认为是这样）

也许是这样的

copy

(defun  c:test (/ LayerColl e ss lst)
 (vl-load-com)
 (setq  LayerColl
    (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证明了方法---

[编程交流] 所有层的颜色变化

发表回复

精选推荐