重命名/恢复所有动态b
我正在寻找一种方法来替换所有已更改的动力学块(并命名为。例如*U*)。我有一个简单的代码,可以很好地处理各个块。
(defun c:blockrepair (/ #blk)
(vl-load-com)
(setq #blk (entsel))
(blockfix)
);;
(defun blockfix (/ obj #blk)
(vl-load-com)
(setq obj (vlax-ename->vla-object (car #blk)))
(vlax-put obj 'Name (vlax-get obj 'Effectivename))
)
但如果我能让它作为一个“SSGET”来运行,以便能够将多个或所有块恢复为有效名称,那我就完了
有人可以帮助修复或改进下面的代码吗。它留给我
; 错误:错误的参数类型:lentyp nil。
(defun c:test (/ acdoc ss i sset nme #blk)
(vl-load-com)
(setvar "cmdecho" 1)
(if
(setq ss (ssget))
(repeat
(setq i (sslength ss))
(setq sset (ssname ss (setq i (1- i))))
(setq #blk (cdr (assoc 0 (entget sset))))
(blockfix)
(princ)
)
)
) 第一个观察结果是DXF代码0存储实体的类型,而不是其名称;您应该使用-1:
(setq #blk (cdr (assoc -1 (entget sset))))
也需要调整blockfix函数的定义;请记住,ENTSEL返回一个列表:
(setq obj (vlax-ename->vla-object (car #blk))) 非常感谢!!
这似乎现在起作用了。
(defun c:test (/ acdoc ss i sset nme #blk obj)
(vl-load-com)
(setvar "cmdecho" 1)
(if
(setq ss (ssget))
(repeat
(setq i (sslength ss))
(setq sset (ssname ss (setq i (1- i))))
(setq #blk (cdr (assoc -1 (entget sset))))
(setq obj (vlax-ename->vla-object #blk))
(vlax-put obj 'Name (vlax-get obj 'Effectivename))
(princ)
)
)
) 抱歉打扰了。但是你知道如何修改这个,而不是ssget吗。或:
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
我已经准备好了。。
它将创建一个由块有效名称组成的选择集。即该区块称为“TAG_区”。它将选择所有tag_区域块,即使它们已被修改,因此具有名称*U*等。
但不会选择已编辑的不同动态块? 这就是我要做的。。我唯一能看到的是如何利用我目前(缺乏)的知识。。就是在里面放一个IF,告诉它继续重命名。(如果“blkname”=标记区域。但我的格式可能有点不正确。
(defun c:blockfixall2 (/ ss i sset#blk obj blkname)
(vl-load-com)
(setvar "cmdecho" 1)
(if
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(repeat
(setq i (sslength ss))
(setq sset (ssname ss (setq i (1- i))))
(setq #blk (cdr (assoc -1 (entget sset))))
(setq obj (vlax-ename->vla-object #blk))
(setq blkame (strcase (vlax-get obj 'Effectivename)))
(IF
(= blkname "TAG_AREA")
(PROGN
(setq obj (vlax-ename->vla-object #blk))
(vlax-put obj 'Name (vlax-get obj 'Effectivename))))
(princ)
)
)
) 知道了。最终使用了李·麦克的注释性参考工具,并进行了一些微调。。
业务端位于“blockfixall”函数的末尾。在需要将动态块重置为实际名称的其他例程之前加载。
(defun LM:getanonymousreferences ( blk / ano def lst rec ref )
(setq blk (strcase blk))
(while (setq def (tblnext "block" (null def)))
(if
(and (= 1 (logand 1 (cdr (assoc 70 def))))
(setq rec
(entget
(cdr
(assoc 330
(entget
(tblobjname "block"
(setq ano (cdr (assoc 2 def)))
)
)
)
)
)
)
)
(while
(and
(not (member ano lst))
(setq ref (assoc 331 rec))
)
(if
(and
(entget (cdr ref))
(= blk (strcase (LM:al-effectivename (cdr ref))))
)
(setq lst (cons ano lst))
)
(setq rec (cdr (member (assoc 331 rec) rec)))
)
)
)
(reverse lst)
)
;; Effective Block Name-Lee Mac
;; ent - Block Reference entity
(defun LM:al-effectivename ( ent / blk rep )
(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
(if
(and
(setq rep
(cdadr
(assoc -3
(entget
(cdr
(assoc 330
(entget
(tblobjname "block" blk)
)
)
)
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(setq blk (cdr (assoc 2 (entget rep))))
)
)
blk
)
(defun blockfixall (/ acdoc ss i sset nme #blk obj BLK)
(vl-load-com)
(setvar "cmdecho" 1)
(setq blk "TAG_AREA");; this is the part where the specific block name is entered
(if
(setq ss (ssget "_X"
(list '(0 . "INSERT")
(cons 2
(apply 'strcat
(cons blk
(mapcar '(lambda ( x ) (strcat ",`" x))
(LM:getanonymousreferences blk)
)
)
)
)
)
))
(repeat
(setq i (sslength ss))
(setq sset (ssname ss (setq i (1- i))))
(setq #blk (cdr (assoc -1 (entget sset))))
(setq obj (vlax-ename->vla-object #blk))
(vlax-put obj 'Name (vlax-get obj 'Effectivename))
(princ)
)
)
)
页:
[1]