如何不炸开块情况下修改改块内线形改为随块，线形比例改为100？（已经解决））

9701519

如何不炸开块情况下修改改块内线形改为随块，线形比例改为100？

2. (Defun c:tt (/ BLK)
   
3.   (and
   
4.     (setq blk (car (entsel "\n Pick Block <exit>:")))
   
5.     (setq blk (vlax-ename->vla-object blk))
   
6.     (vlax-property-available-p blk "effectivename")
   
7.     (= (vlax-for vlo
   
8.      (vla-item
   
9.        (vla-get-blocks
   
10.          (vla-get-activeDocument (vlax-get-acad-object))
    
11.        )
    
12.        (vla-get-effectivename blk)
    
13.      )
    
14.    (vla-put-Linetype vlo "ByBlock")
    
15.    (vla-put-LinetypeScale vlo 100.)
    
16.    (vla-put-Lineweight vlo acLnWtByBlock)
    
17.    (vla-put-Color vlo 0)
    
18.    (vla-put-Layer vlo "0")
    
19.        )
    
20.        (vla-update blk)
    
21.     )
    
22.   )
    
23. )

(Defun c:tt (/ BLK)<br />   (and<br />     (setq blk (car (entsel "\n Pick Block <exit>:")))<br />     (setq blk (vlax-ename->vla-object blk))<br />     (vlax-property-available-p blk "effectivename")<br />     (= (vlax-for vlo<br />      (vla-item<br />        (vla-get-blocks<br />          (vla-get-activeDocument (vlax-get-acad-object))<br />        )<br />        (vla-get-effectivename blk)<br />      )<br />    (vla-put-Linetype vlo "ByBlock")<br />    (vla-put-LinetypeScale vlo 100.)<br />    (vla-put-Lineweight vlo acLnWtByBlock)<br />    (vla-put-Color vlo 0)<br />    (vla-put-Layer vlo "0")<br />        )<br />        (vla-update blk)<br />     )<br />   )<br /> )

kozmosovia

代码搞复杂了

2. (Defun c:tt (/ BLK)
   
3.   (and
   
4.     (setq blk (car (entsel "\n Pick Block <exit>:")))
   
5.     (setq blk (vlax-ename->vla-object blk))
   
6.     (vlax-property-available-p blk "effectivename")
   
7.     (= (vlax-for vlo
   
8.      (vla-item
   
9.        (vla-get-blocks
   
10.          (vla-get-activeDocument (vlax-get-acad-object))
    
11.        )
    
12.        (vla-get-effectivename blk)
    
13.      )
    
14.    (vla-put-Linetype vlo "ByBlock")
    
15.    (vla-put-LinetypeScale vlo 100.)
    
16.    (vla-put-Lineweight vlo "byblock")
    
17.    (vla-put-Color vlo 0)
    
18.    (vla-put-Layer vlo "0")
    
19.        )
    
20.        (vla-update blk)
    
21.     )
    
22.   )
    
23. )

(Defun c:tt (/ BLK)<br />   (and<br />     (setq blk (car (entsel "\n Pick Block <exit>:")))<br />     (setq blk (vlax-ename->vla-object blk))<br />     (vlax-property-available-p blk "effectivename")<br />     (= (vlax-for vlo<br />      (vla-item<br />        (vla-get-blocks<br />          (vla-get-activeDocument (vlax-get-acad-object))<br />        )<br />        (vla-get-effectivename blk)<br />      )<br />    (vla-put-Linetype vlo "ByBlock")<br />    (vla-put-LinetypeScale vlo 100.)<br />    (vla-put-Lineweight vlo "byblock")<br />    (vla-put-Color vlo 0)<br />    (vla-put-Layer vlo "0")<br />        )<br />        (vla-update blk)<br />     )<br />   )<br /> )

llsheng_73

1. (DEFUN C:TT(/ e *BLCOKS e);;修改所有块内所有对象线型为随块、线型比例100
   
2.   (vl-load-com)
   
3.   (setq *blocks(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activedocument)'blocks))
   
4.   (while(setq e(TblNext "BLOCK"(not e)))
   
5.     (tt(cdadr e)"byblock" 100))
   
6.   )
   
7. 
   
8. (defun tt(blkname ltpname ltpscale / blk o i);;修改指定块名内所有对象线型、线型比例
   
9.   (setq blk(vlax-invoke-method *blocks 'item blkname)
   
10.         i -1)
    
11.   (repeat(vlax-get-property blk 'count)
    
12.     (setq i(1+ i)o(vlax-invoke-method blk 'item i))
    
13.     (vlax-put-property o 'Linetype ltpname)
    
14.     (vlax-put-property o 'LinetypeScale ltpscale)))

(DEFUN C:TT(/ e *BLCOKS e);;修改所有块内所有对象线型为随块、线型比例100<br />   (vl-load-com)<br />   (setq *blocks(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activedocument)'blocks))<br />   (while(setq e(TblNext "BLOCK"(not e)))<br />     (tt(cdadr e)"byblock" 100))<br />   )<br /> <br /> (defun tt(blkname ltpname ltpscale / blk o i);;修改指定块名内所有对象线型、线型比例<br />   (setq blk(vlax-invoke-method *blocks 'item blkname)<br />         i -1)<br />   (repeat(vlax-get-property blk 'count)<br />     (setq i(1+ i)o(vlax-invoke-method blk 'item i))<br />     (vlax-put-property o 'Linetype ltpname)<br />     (vlax-put-property o 'LinetypeScale ltpscale)))

9701519

kozmosovia 发表于 2024-11-4 12:50
遍历块定义改

在不炸开块的情况下实现以下功能

2. (defun C:tt( )
   
3.     (setq se1(ssget))
   
4.      (vl-cmdf "_change" "si" se1 "p" "lt" "byblock" "")
   
5.      (vl-cmdf "_change" "si" se1 "p" "s" "1" "")
   
6.      (vl-cmdf "_chprop" se1 "" "la" "0" "C" "byblock" "LW" "byblock" "")
   
7. )

(defun C:tt( )<br />     (setq se1(ssget))<br />      (vl-cmdf "_change" "si" se1 "p" "lt" "byblock" "")<br />      (vl-cmdf "_change" "si" se1 "p" "s" "1" "")<br />      (vl-cmdf "_chprop" se1 "" "la" "0" "C" "byblock" "LW" "byblock" "")<br /> )

kozmosovia

遍历块定义改

9701519

llsheng_73 发表于 2024-11-4 13:35

如何再加上以下功能：
1.框选选择需要修改的块
2.全部改0层，
3.颜色随块，
4.线宽随块，

9701519

kozmosovia 发表于 2024-11-4 14:04
代码搞复杂了

命令执行有点问题：
Pick Block <exit>:; 错误: 此类型的 LISP 值不能强制转换成 VARIANT:  "byblock"

panliang9

看这个。
http://bbs.mjtd.com/thread-59143-1-1.html

9701519

panliang9 发表于 2024-11-4 14:42
看这个。
http://bbs.mjtd.com/thread-59143-1-1.html

为什么块会变大

panliang9

改线型比例用这个：
http://bbs.mjtd.com/thread-186469-1-1.html

还有发例图才知道为什么块会变大。