Cad图块中线型比例修改
对图块进行操作时，在不炸开图块的情况下，如何修改图块内子图元的线型比例？；比如说：我在CAD图中插入一已经做好的图块，但由于绘图设置原因，在有的图中此图块中虚线比例太小，几乎看不清楚，想再编写一程序能修改图块中子图元的线型比例。就不知如何下手，折磨我好几天了？
谢谢你的帮助，从明经这几天的学习中，我自已慢慢摸索出如下方法，测试后能满足我工作的需要，但不知我这样编写的思路是不是太繁锁，希望论坛里的哪位大侠帮我再优化一下。万分感谢
(defun c:xg (/ ss sslen sname snlast n tk tl)
(vl-load-com)
(setq old_cm (getvar "cmdecho"))
(setq old_os (getvar "osmode"))
(setq old_bl (getvar "blipmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setvar "blipmode" 0)
(prompt "\n请选择要修改的图块...")
(setq ss (ssget(list '(0 . "INSERT"))))
(if (null ss)
(alert "\n没有选中任何要修改的图块...")
(progn
(repeat (setq sslen (sslength ss))
(setq sname (ssname ss (setq sslen (1- sslen))))
(setq
snlast (tblobjname "Block" (cdr (assoc 2 (entget sname))))
)
(while
(/= (cdr (assoc 6 (entget (setq snlast (entnext snlast)))))
"DASHED"
)
)
(setq n (getdist "\n请输入要修改的线型比例"))
(setq
tk (vla-put-linetypescale (vlax-ename->vla-object snlast) n)
)
(setq tl (vla-put-color (vlax-ename->vla-object snlast) 40))
(entmod (entget sname))
(redraw sname 1)
)
)
)
(setvar "cmdecho" old_cm)
(setvar "osmode" old_os)
(setvar "blipmode" old_bl)
(princ)
)
为何总是报错？有大神能帮忙完善了此贴？
感谢河流之王支持，帮忙调试好，无私奉献源码如下。
可修改单个线型改为设置输入的线型比例:lol
另外大家有需求的，可以找河流大神定制。专业且态度好
(defun c:lts (/ lts:processed idx scl sel LINENAME)
(initget 6)
(if (not scl2)
(setq scl2 20)
)
(if (NOT (setq scl
(getreal (STRCAT "\n 请输入线性型比例<" (rtos scl2 2 0) ">")
)
)
)
(SETQ SCL SCL2)
(SETQ SCL2 SCL)
)
(PRINC "\n 选择源线型和修改图形")
(if (setq sel (ssget))
(PROGN
(repeat (setq idx (sslength sel))
(SETQ E (ssname sel (setq idx (1- idx))))
(IF (/= "INSERT" (CDR (ASSOC 0 (ENTGET E))))
(PROGN
(SETQ LINENAME
(vl-catch-all-apply
'vla-GEt-linetype
(LIST (vlax-ename->vla-object E))
)
)
(IF (= LINENAME "ByLayer")
(SETQ LINENAME
(CDR (ASSOC
6
(tblsearch "LAYER"
(CDR (ASSOC 8 (ENTGET E)))
)
)
)
)
)
)
)
)
(repeat (setq idx (sslength sel))
(lts:obj
(vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
scl
LINENAME
)
)
)
)
(vla-regen lts:acdoc acallviewports)
(princ)
)
(defun lts:blk (obj scl / bln)
(if (not (member (setq bln (vla-get-name obj)) lts:processed))
(progn
(vlax-map-collection
(vla-item lts:acblk bln)
'(lambda (obj) (lts:obj obj scl LINENAME))
)
(setq lts:processed (cons bln lts:processed))
)
)
)
(defun lts:obj (obj scl LINENAME / LINENAME1)
(IF (= (vla-GEt-linetype obj) "ByLayer")
(SETQ LINENAME1
(CDR
(ASSOC
6
(tblsearch "LAYER"
(CDR (ASSOC 8 (ENTGET (vlax-vla-object->ename obj))))
)
)
)
)
(SETQ LINENAME1 (vla-GEt-linetype obj))
)
(if (and (vlax-write-enabled-p obj)
(vlax-property-available-p obj 'linetypescale t)
(= LINENAME LINENAME1)
)
(vla-put-linetypescale obj scl)
)
(if (= "AcDbBlockReference" (vla-get-objectname obj))
(lts:blk obj scl)
)
)
(setq lts:acdoc (vla-get-activedocument (vlax-get-acad-object))
lts:acblk (vla-get-blocks lts:acdoc)
)
(vl-load-com)
(princ)
本帖最后由 liuhe 于 2023-4-18 13:31 编辑
(defun c:lts ( / lts:processed idx scl sel )
(initget 6)
(if (setq scl (getreal "\n 请输入线性型比例"))
(if (setq sel (ssget "_:L"))
(repeat (setq idx (sslength sel))
(lts:obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) scl)
)
)
)
(vla-regen lts:acdoc acallviewports)
(princ)
)
(defun lts:blk ( obj scl / bln )
(if (not (member (setq bln (vla-get-name obj)) lts:processed))
(progn
(vlax-map-collection (vla-item lts:acblk bln) '(lambda ( obj ) (lts:obj obj scl)))
(setq lts:processed (cons bln lts:processed))
)
)
)
(defun lts:obj ( obj scl )
(if (and (vlax-write-enabled-p obj) (vlax-property-available-p obj 'linetypescale t)(="DASHED"(vla-GEt-linetype obj )));;;;只更改"DASHED"的
(vla-put-linetypescale obj scl)
)
(if (= "AcDbBlockReference" (vla-get-objectname obj))
(lts:blk obj scl)
)
)
(setq lts:acdoc (vla-get-activedocument (vlax-get-acad-object))
lts:acblk (vla-get-blocks lts:acdoc)
)
(vl-load-com) (princ)
;;;;代码来至于LeeMac
关于 entmod 函数所作的修改有一些限制：
不能改变一个图元的类型和句柄。如果一定要这样做，只能先调用 entdel 函数删除它，然后调用 command 或 entmake 函数创建新图元。
entmod 函数不能修改内部域，如 SEQEND 图元的 -2 组中的图元名，如果试图作这样的修改，将会被系统忽略。
不能使用 entmod 函数修改视口图元。
可以将图元的空间可见性改为 0 或 1（视口对象除外）。如果用 entmod 函数修改了块定义中的图元，该修改会影响图形中该块的所有实例。
在用 entmod 函数修改顶点图元前，应先读出或写入多段线的头部。如果最近处理的多段线图元不是该顶点所在的多段线，可能会丢失宽度信息（40 和 41 组）。
警告！ 可以用 entmod 函数修改块定义中的图元，但这样做可能会生成引用自身的块，导致 AutoCAD 系统崩溃。
(vla-Update lineObj)
加班画图敲码必备解压经典世界名曲，自提不谢file:///C:\Users\Administrator\AppData\Roaming\Tencent\QQTempSys\G@YVKCPZR)X}3UKB(_VF`LW.gif
链接：file:///C:\Users\Administrator\AppData\Roaming\Tencent\QQTempSys\%W@GJ$ACOF(TYDYECOKVDYB.pnghttps://pan.baidu.com/s/1sABJ7kVlrzfVNOAo4XENBA
提取码：1111
要学会自己搜索啊= =http://bbs.mjtd.com/thread-186469-1-1.html kucha007 发表于 2023-4-17 21:16
要学会自己搜索啊= =http://bbs.mjtd.com/thread-186469-1-1.html
连接中LEE的源码复制，运行不了呢 你的是修改过的吗？运行什么效果？没有GIF？ 是这个效果吗 是这样吗？:lol
你的while循环是没用的，你直接屏蔽掉就不报错了 各位有幸到访者，请查看录制动态gif教程，方便注明插件功能！
页:
[1]
2