关于无名块
不知道能否将命名块转为无名块？用途是：无名块只能用entmake插入，效果不如insert好，而命名块插入后改为无名块以避免块名冲突。不知道能否实现，或思路如何？ ;;试试这个图块改名，如果输入*U就会变成无名块;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:RENBLK (/ doc blks old_blkref oldname newname)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))
(setq old_blkref
(vlax-ename->vla-object
(car (entsel "\nSelect a block to rename: "))
)
)
(setq oldbname (vla-get-name old_blkref))
(setq LOOP t)
(while LOOP
(if (NOT (= (setq
newbname (getstring
(strcat "\nEnter a new block name <"
oldbname
">: "
)
T
)
)
""
)
)
(if (and (not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-item
(list
blks
newbname
)
)
)
)
(/= newbname oldbname)
)
(alert "Duplicate record name. Try again.")
(setq LOOP nil)
)
)
) ; while
(if (= (strcase (substr oldbname 1 2)) "*U")
(Anon2Namedblock old_blkref newbname)
(vla-put-name
(vla-item blks (vla-get-name old_blkref))
newbname
)
)
(princ)
)
(defun Anon2Namedblock
(anonblkref bname / doc blks objs idx namedblkdef anonblkde)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))
(setq anonblkdef (vla-item blks (vla-get-name anonblkref)))
(setq namedblkdef (vla-add blks (vlax-3d-point '(0 0 0)) bname))
(setq objs (vlax-make-safearray
vlax-vbobject
(cons 0 (1- (vla-get-count anonblkdef)))
)
)
(setq idx 0)
(vlax-for obj anonblkdef
(vlax-safearray-put-element objs idx obj)
(setq idx (1+ idx))
)
(vla-copyobjects doc objs namedblkdef)
(vla-put-origin namedblkdef (vla-get-origin anonblkdef))
(vla-put-name anonblkref bname)
) 多谢alin的回复，但我不懂vlisp。
页:
[1]