李，
出于好奇，如果您只使用entmake-insert，那么由于代码的属性部分在程序之外，它还会是必需的吗？
如果是这样，如果有人要更改块定义，这会是一场等待发生的冲突吗？
我从来没有这样尝试过，所以我不确定结果。 Thaniks Lee公司
我已经按我想要的方式运行了脚本。
一旦我把它改得不那么具体，我就会贴出来。目前，它只为一个功能而构建
当做
奥利
很好的一点-我必须承认，我个人从未对具有属性的块使用过entmake INSERT方法，我现在大部分时间只使用vla insertblock。
但是，我们必须看看奥利走的路线
我提出这个问题的唯一原因是我以为他在使用一个带有属性标签的列表。如果有人在程序外的块中修改这些标记，那么程序当然无法正常运行。在大多数情况下，我见过这种程序生成属性。这只是一个想法。他需要记住相应地调整他的计划，无论如何都没什么大不了的。 集体劳动取得的成果
(Defun tee(/ sset cntr Ratt attlistblkblklist blkdef c)
(vl-load-com)
(setq bname "Attblock")
(setq cntr -1)
(setq sset (ssget "X" (list(cons 2 bname))))
(while (< (setq cntr (+ cntr 1)) (sslength sset))
(setq blk (vlax-ename->vla-object (ssname sset cntr)))
(setq attlist(list(cdr (assoc 10 (entget (vlax-vla-object->ename blk))))))
(if (= (vla-get-hasattributes blk) :vlax-true)
(progn
(foreach c (vlax-safearray->list (variant-value (vla-getattributes blk)))
(setq attlist (append attlist (list(list (vla-get-tagstring c)
(vla-get-textstring c)
(vla-get-height c)
(vla-get-invisible c)
(vla-get-layer c)
(getpmt bname (vla-get-tagstring c))))))
)
(setq blklist (append blklist (listattlist)))
(setq attlist nil)
)
)
)
(command"erase" sset"")
(setq Blkdef (cdar blklist))
(CreateBlock blkdef bname)
(foreach c blklist
(InsertBlock c bname)
)
(command"qsave")
)
(defun CreateBlock (attlist name / ent p1 )
(setq sset (ssadd))
(foreach c attlist
(setq tag (car c) text (nth 5 c) height (caddr c) visible (cadddr c) layer (nth 4 c ) )
(if (= p1 nil)
(setq p1 (list 0.0 0.0 0.0))
(setq p1 (list (car p1 )(- (cadr p1) (+ height (/ height 2)))(caddr p1)))
)
(entmake (list
(cons 0 "ATTDEF")
(cons 10 p1)
(cons 40 height)
(cons 8 layer)
(cons 1 "")
(cons 3 text)
(cons 7 (getvar "TEXTSTYLE"))
(cons 2 tag)
(cons 70 1)
)
)
(setq ent (entget (entlast)))
(setq ent(subst (cons 8 layer)(assoc 8 ent)ent))
(setq ent(subst (cons 40 height)(assoc 40 ent)ent))
(if (eq visible :vlax-true)
(
(setq ent(subst (cons 70 0)(assoc 70 ent)ent))
)
)
(entmod ent)
(ssadd (entlast) sset)
)
(setq p1 (list (car p1 )(- (cadr p1) (+ height (/ height 2)))(caddr p1)))
(entmake (list
(cons 0 "ATTDEF")
(cons 10 p1)
(cons 40 300)
(cons 8 layer)
(cons 1 "")
(cons 3 "F2")
(cons 7 (getvar "TEXTSTYLE"))
(cons 2 "FLOOR")
(cons 70 1)
)
)
(setq ent (entget (entlast)))
(setq ent(subst (cons 8 layer)(assoc 8 ent)ent))
(entmod ent)
(ssadd (entlast) sset)
(command"block" name "y" (list 0.0 -450.0 0.0) sset "")
)
(defun getpmt (blk aname)
(if (tblsearch "BLOCK" blk)
(vlax-for Obj (vla-item
(vla-get-Blocks
(vla-get-Activedocument
(vlax-get-acad-object))) blk)
(if (eq "AcDbAttributeDefinition"
(vla-get-ObjectName Obj))
(if (= (vla-get-tagstring obj) aname)
(setq pmt (vla-get-PromptString Obj)))))
)
pmt)
(defun InsertBlock(attlst bname / c ent tag)
(vl-load-com)
(if (vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ( )
(setq blk
(vla-insertblock
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(vlax-3D-point (car attlst)) bName 1. 1. 1. 0.)))))) nil
(if (eq :vlax-true (vla-get-HasAttributes blk))
(foreach att (vlax-safearray->list
(vlax-variant-value
(vla-getAttributes blk)))
(setq tag (vla-get-tagString att))
(foreach x (cdr attlst)
(if (eq tag (car x))
(vla-put-TextString att (cadr x)))
)
(if(eq tag "HEAD")
(progn
(setq lvl (substr (vla-get-textstring att )9 2))
(vla-put-TextString att (substr (vla-get-textstring att) 1 7))
)
)
(if (eq tag "FLOOR")
(vla-put-textstring att lvl)
)
))))
看起来很多代码回报很低，但主要的函数组（已发布）已经被证明是有用的，学习经验值得投入其中的每一个小时
[原文如此]这用于使用一个新属性重新创建和属性块，并将另一个属性值的值除以新属性值。
多亏了这些帮助
奥利 没问题，奥利，我看到你最终使用了VL方法
另一方面，像这样的东西可以用来重新创建一个块——事实上，我用它来重命名一个块。
http://www.cadtutor.net/forum/showthread.php?t=36729
此帖子：
http://www.cadtutor.net/forum/showpost.php?p=242147&postcount=24
我有一个vba脚本通过引用模板文件来替换块，该模板文件也允许我执行上述操作。我只需要将属性值分为两个字段。最后，lisp方法要麻烦得多。
是的，谢谢块插入的vl方法。我曾希望尝试使用entmake方法，但对于在entmake语句中间放置for循环以进行属性定义没有信心
谢谢
奥利 没问题，只要它对你有效，我想不管你如何到达那里（在合理范围内！），
李 李·麦克，
你的解决方案对我来说是新的和有趣的，我非常感谢你花时间发布它。当我查看代码和错误捕捉文档时，我认为可以对代码进行以下更改。你能对此发表评论吗？我想开始更多地实现这种编码风格（带有异常处理的ActiveX）。
基本上，我删除了（function）和（lambda）函数。为什么不呢？
p、 我希望我知道如何做代码高亮显示。
8 如果我重写的话，我也会这样编码的——我似乎从2009年7月起学到了更多
页:
1
[2]