社区 › Auto Lisp › 更改块

ghostware 发表于 2022-7-6 12:05:21

更改块

我想更改块颜色层和ltype（1000 pst）
 
块实体1：
层1到0
按层到按块的颜色
L将bylayer键入byblock
 
块实体2：
层1到0
颜色2到1
L类型Dashdot（不更改）
 
谢谢你的帮助。
帕斯卡

Lee Mac 发表于 2022-7-6 12:14:37

ET中的块替换？

ghostware 发表于 2022-7-6 12:22:45

无块替换
 
我想更改块的de颜色、图层和ltype。

fixo 发表于 2022-7-6 12:24:57

 
我没时间测试你自己试试
 

(defun C:CBC(/ blockobj bname en ent obj);change block

(setq ent (entsel "\nSelect block: "))
(setq en (car ent)
obj (vlax-ename->vla-object en)
bname (vla-get-effectivename obj)
blockobj
   (vla-item (vla-get-blocks
               (vla-get-activedocument
                   (vlax-get-acad-object)))
             bname)
    )

(vla-put-layer obj "0")

(vlax-for item blockobj

   (if (eq "1" (vla-get-layer item))
   (if (and (eq "AcDbLine" (vla-get-objectname item))
       (eq "DASHDOT" (strcat (vla-get-linetype item)))
       (eq 2 (vla-get-color item))
       )
(progn
(vla-put-layer item "0")
(vla-put-color item 1))
(progn
(vla-put-layer item "0")
(vla-put-color item acByBlock)
(vla-put-linetype item "BYBLOCK")
)
)
)
)

(vla-regen (vla-get-activedocument
       (vlax-get-acad-object))
   acallviewports)

(princ)
)
(princ "\n   ***Type CBC to execute***")
(prin1)

(vl-load-com)

 
~'J'~

ghostware 发表于 2022-7-6 12:30:38

嗨，菲索，
 
CBC。lsp效果很好，
 
现在我有以下问题。
 
我想更改3种颜色（参见示例）。
 
帕斯卡

fixo 发表于 2022-7-6 12:37:09

 
帕斯卡，请把样图贴出来
 
我使用A2008
 
你的照片对我来说不够清楚
 
~'J'~

ghostware 发表于 2022-7-6 12:45:56

这是我的样图。。
 
更改块。图纸

fixo 发表于 2022-7-6 12:50:01

 
好的，我明天回来
 
~'J'~

fixo 发表于 2022-7-6 12:57:52

 
嗨，帕斯卡
再试一次
 

(defun C:CB2(/ blockobj bname en ent obj)          ;change block

(setq ent (entsel "\nSelect block: "))
(setq        en       (car ent)
obj       (vlax-ename->vla-object en)
bname       (vla-get-effectivename obj)
blockobj
       (vla-item (vla-get-blocks
                     (vla-get-activedocument
                     (vlax-get-acad-object)))
                   bname)
)

(vla-put-layer obj "0")

(vlax-for itemblockobj

   (if        (and (eq "DASHDOT" (strcase (vla-get-linetype item)))
   (eq 2 (vla-get-color item))
   )
   (vla-put-color item 1)
   )

   (if        (and (eq "ByLayer" (vla-get-linetype item))
   (eq acLnWtByLayer (vla-get-lineweight item))
   (eq 2 (vla-get-color item))
   )
   (vla-put-color item
   )

   (if        (eq acByLayer (vla-get-color item))
   (vla-put-color item acByBlock)
   )

   (vla-put-layer item "0")

   )

(vla-regen (vla-get-activedocument
       (vlax-get-acad-object))
   acallviewports)

(princ)
)
(princ "\n   ***Type CB2 to execute***")
(prin1)

(vl-load-com)

 
~'J'~

ghostware 发表于 2022-7-6 12:59:44

Thx Fixo！对于你的日常（CB2.LSP）。
现在我可以比以前更快地完成工作了。
 
非常感谢您抽出时间。

查看完整版本: 更改块