如果有多个，只留下一个块
大家好，我正在寻找一个例程，它可以在图形中找到一个特定的块，如果有更多具有相同名称的块删除除一个以外的所有。
我在多个图形上运行lisp，根据该图形的“键”更改某些块的属性。因此，关键是块，它应该只在这些图纸中出现一次，否则代码中的所有计算都会出错。
这些键可以位于图形中的任何位置，这意味着它们不在彼此的顶部或具有相同的插入点。
任何想法都将受到高度赞赏。 完全未经测试，可能很危险：
(defun c:foo (/ bn b ss en i)
(while (not bn)
(setq b (strcase (getstring "\nBLOCK Name: ")))
(cond ((not (snvalid b)))
((not (tblsearch "BLOCK" b)))
((setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 b)))))
((setq bn b))))
(setq i 0)
(while (setq en (ssname ss i))
(if (/= i 0)
(entdel en))
(setq i (1+ i)))
(prin1))
而且可能对动态块完全无用。
-大卫 谢谢你的重播David，
我担心此代码将无法在我正在工作的模式下工作。我的代码中的所有处理都是在后台的多个图形上完成的，其中ssget选择是不可能的。 Davids代码将在多个DWG上工作，无需交互，只需采取不同的方法。
C： foo意味着在键盘上键入，因此2个选项（defun foo）将在键盘上或脚本中工作（foo）或（C:foo）
您可以硬编码块名或询问一次，然后将say保存到文本文件中。（setq b
使用脚本将更改多个DWG。我想这就是你现在要做的。如果没有，请解释你是怎么做的。 比加尔，
谢谢你出现在地平线上。
更多的信息可能确实有用。
这是我正在寻找解决方案的代码的一部分。
(setq *acad (vlax-get-acad-object)
docx(vla-get-activedocument *acad)
doc (vla-getinterfaceobject *acad (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer))))
dwgs files
dwgs (vl-sort dwgs '<)
)
(foreach dwg dwgs;for each dwg of the dwgs list
(setq dprefix (vl-filename-directory dwg))
(setq emsg (vl-catch-all-apply '(lambda ()
(vla-open doc dwg :vlax-false)
(setq my_doc(vla-get-activedocument (vlax-get-acad-object)))
(if (= drawing "1")
(progn
(vlax-for layout (vla-get-layouts doc)
(vlax-for ent (vla-get-block layout)
(if (and (vlax-property-available-p ent 'hasattributes)
(eq (vla-get-name ent) bname_dwg))
(progn
(setq atts (vlax-invoke ent 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tag_dwg)
(progn
(setq edit t)
(vla-put-textstring att val_dwg)
(setq key_dwg (vla-get-textstring att))
(setq val_dwg (itoa (+ (atoi val_dwg) _inc) ))
)
)
)
)
)
)))
);end if
; here i call another function to change the tag
(if (= TAG_EMPLOYER "1")
(replace_tags "DWG_" "EMPLOYER#" "B" "Sheet1" key_dwg 1))
)))) 谢谢Roy_043，
实现您的想法，并在每次绘制完成后将结果设置为零。
它现在工作得很好，当我运行代码时，我只需要少检查一件事。
我喜欢这个论坛：D 我会这样写（基本上就像罗伊那样）：
(vlax-for layout (vla-get-layouts doc)
(setq found nil)
(vlax-for ent (vla-get-block layout)
(if
(and
(eq (vla-get-name ent) bname_dwg)
(vlax-property-available-p ent 'hasattributes) ; Required?
)
(if found
(vla-delete ent) ; Already found one so delete.
(progn
(setq found T)
... ; Do your stuff.
)
)
)
)
)
现在我考虑在Documents集合中包含一个使用（getfield）和调用（vla open）的提示符。 @Grrr：我认为你的代码没有按预期工作。你测试过了吗？ @罗伊，这完全没有经过测试，在看了第二眼之后，我不应该包括这一行（我甚至不记得我添加了它-哈哈）：
(defun C:test ( / CADapp Docs BlkNms )
(setq CADapp (vlax-get-acad-object))
(setq Docs (vla-get-Documents CADapp))
(vlax-for doc Docs
(vlax-for blk (vla-get-Blocks doc)
(if
(and
(eq (vla-get-IsLayout blk) :vlax-false)
(eq (vla-get-IsDynamicBlock blk) :vlax-false)
(eq (vla-get-IsXRef blk) :vlax-false)
)
(setq BlkNms (cons (vla-get-Name blk) BlkNms))
)
); iterate blkdefs
(vlax-for layout (vla-get-Layouts doc)
(vlax-for obj (vla-get-Block layout)
(if
(and
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(not (vl-remove (vla-get-EffectiveName obj) BlkNms)) ; first block that remove its name from this list is NOT deleted
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)))
(progn
(vla-put-Lock (vla-item (vla-get-Layers doc) (vla-get-Layer obj)) :vlax-false)
(vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)))
); progn
); if
); if
); iterate graphical objects
); iterate tabs
); iterate docs
(princ)
);| defun |; (vl-load-com) (princ)
也许我不得不把它改成：
(eq (vla-get-IsDynamicBlock blk) :vlax-false)
此外，它不符合以下标准：
我不知道你是否指的是其他问题。 @Grrr：我看到的主要问题是blkNms列表。
建议：
(eq (vla-get-HasAttributes blk) :vlax-false)
页:
[1]
2