如何在not act中编辑
大家好,好久不见……我有一个小问题。
我有一个名为 Basis 的“模板”布局。这是我要复制和重命名的布局。到目前为止,一切都很好。
要复制:
ThisDrawing.SendCommand "_layout" & vbCr & "C" & vbCr & "Basis" & vbCr & RSCheck.Fields("Object_ID") & vbCr
(RSCheck.Fields... 是一个包含值的 .mdb 记录集我想使用,Object_ID 是新布局的名称)
现在我想在新复制的布局中编辑一些属性。
ThisDrawing.ActiveLayout = ThisDrawing.Layouts((RSCheck.Fields("Object_ID")))
我要编辑的布局现在处于活动状态,我可以编辑我想要的所有内容。
问题是我必须复制和编辑大约 250 个布局。它运行有点慢,因为我必须激活布局。VBA 中有没有办法在不激活布局的情况下更改布局?
我希望使用 For Each Elem In ThisDrawing.Layouts(RSCheck.Fields("Object_ID")) 但这不起作用。
谁能帮我? 您可以尝试像这样编辑非活动布局
Dim actSpace as acadblockSet actSpace=thisdrawing.layouts("Object_ID").Block
'然后你可以直接在那里做你的事情,例如:
actspace.addline(p1,p2)actspace.addcircle(p3, radius) ETC...
~'J'~ 感谢您的回复Fixo!
actspace.add** 是关于添加线条或其他元素的。
但是我怎样才能读取复制布局中的所有元素并修改它们呢?
我想在名为“KADER”的布局中修改具有属性的块 像这样的东西可能会有所帮助,换上:
Dim ent as acadentityDim blkref as acadblockreferencefor each ent in actspaceif typeof ent is acadblockreference thenset blkref=entif blkref.Effectivename="KADER" thendim atts as variantdim att as attributereferenceatts= blkref.getattributesfor each att in attsif att.tagstring="MYTAG" thenatt.textstring="MYVALUE"exit forend ifnext attend ifend ifnext ent
~'J'~ 你是最棒的!! 很高兴我能帮助
干杯
~'J'~ 因为我想提高性能.....我该如何替换这个慢命令:
ThisDrawing.SendCommand "_layout" & vbCr & "C" & vbCr & "Basis" & vbCr & RSCheck.Fields("Object_ID") & vbCr
有没有更好的方法来复制布局而不使用 .SendCommand? 没试过,但 maube CopyObjects 方法可能有帮助
只是一个想法 试试我前面提到的这种方式
页:
[1]