龙龙仔
发表于 2009-3-27 16:49:00
<p>8楼巳修改(程序只是勉強可用)</p>
userzhl
发表于 2009-3-27 18:09:00
<strong><font face="Verdana" color="#da2549">龙龙仔</font></strong>,8楼的程序我试了,没有修改呀.
英雄无敌
发表于 2009-3-28 16:11:00
<p>修改了一下龙龙仔的程序，不过这种情况只适用于所多重块内的所有块都是同一个插入点，如果不同，则还是有可能能位置移动的</p><p>(defun C:TT ()<br/> (setq DOC (vla-get-activedocument (vlax-get-acad-object)))<br/> (setq E (nentselp "\nSelect block:"));;要點綠色文字<br/> (setq A (car E))<br/> (setq OBJ_A (vlax-ename->vla-object A))<br/> (setq B (vla-objectidtoobject DOC (vla-get-ownerid OBJ_A)))<br/> (entmake (list '(0 . "INSERT")<br/> '(100 . "AcDbBlockReference")<br/> (cons 2 (vla-get-name B))<br/> (assoc 10 (entget (last (last e))))<br/> '(41 . 1.0)<br/> )<br/> )<br/> (command "_.explode" (entlast))<br/> (command "_.erase" (last (last E)) "")<br/>)</p>
userzhl
发表于 2009-3-28 20:01:00
<p>楼上<strong><font face="Verdana" color="#61b713">英雄无敌</font></strong>,你可以打开文件试试,还是移位.</p>
samshs
发表于 2009-3-29 15:25:00
<p>以前见过有这样的代码 找到后再发上来</p>
龙龙仔
发表于 2009-3-30 08:06:00
;;未詳細測試
(defun C:TT (/ A B C DOC)
(setq DOC (vla-get-activedocument (vlax-get-acad-object)))
(setq A (nentselp "\nSelect block:"))
;;要點綠色文字
(setq C (entget (last (last A))))
(setq B (vla-objectidtoobject
DOC
(vla-get-ownerid (vlax-ename->vla-object (car A)))
)
)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbBlockReference")
(cons 2 (vla-get-name B))
(assoc 10 C)
(assoc 50 C)
(assoc 41 C)
)
)
(command "_.explode" (entlast))
(command "_.erase" (last (last A)) "")
)
userzhl
发表于 2009-3-30 10:13:00
谢谢<strong><font face="Verdana" color="#da2549">龙龙仔</font></strong>
huxu823
发表于 2021-4-30 11:24:21
感谢分享！！！！！
nijiea123
发表于 2022-7-18 18:25:16
测试有用 就是差个批量的