[已解决]如何在没有激活的图纸空间增加图元
请教:能不能实现在没有激活的图纸空间增加图元我目前是先激活某个图纸空间(布局),然后再增加图元,但是当图纸比较大的时候,重生成模型的时候比较长。那能不能不激活图纸空间,就能直接在某个布局中写入图元?
我目前代码:
Dim Textlayout As Object
Set Textlayout = ThisDrawing.Layouts.Item(layoutItemI)
ThisDrawing.ActiveLayout = Textlayout
里面layoutItemI是我传入的一个参数。就是能不能不用激活(ThisDrawing.ActiveLayout = Textlayout),用某个方法吧图元增加到不激活图纸空间。
试下
Sub tt()
Dim blkdef As AcadBlock
Set blkdef = ThisDrawing.Layouts.Item("布局1").Block
Dim pt1(2) As Double, pt2(2) As Double
pt2(0) = 10
blkdef.AddLine pt1, pt2
End Sub
你目前用什么方法增加图元?
Public Function AcadText_paperspace(textString As String, insertPoint As Variant, Height As Variant, layoutItemI)
Dim anobj As Object, AddLine As Object
Dim minExt As Variant, maxExt As Variant
'写入居中的单行文本
Dim Textlayout As Object
Set Textlayout = ThisDrawing.Layouts.Item(layoutItemI)
ThisDrawing.ActiveLayout = Textlayout
Set anobj = ThisDrawing.PaperSpace.AddText(textString, insertPoint, Height) '这个insertPoint随便输。
anobj.Alignment = 10 '设置居中
anobj.TextAlignmentPoint = insertPoint '设置对齐点
Set AcadText_paperspace = anobj
End Function
增加图元如上:
因为要在指定的布局中写文字。所以我每次都要先激活指定的布局
Dim Textlayout As Object
Set Textlayout = ThisDrawing.Layouts.Item(layoutItemI)
ThisDrawing.ActiveLayout = Textlayout
然后再写入文字,我找到和布局有关的变量LAYOUTREGENCTL,但是也不能停止刷新。激活布局一刷新就要等一会儿,浪费时间。后来我又发现可以直接修改选择集中图元的字符串内容,所以但是我现在修改了方法,就是不增加图元了,直接用选择集获取text图元,然后在text中直接修改休息字符串的内容。也可以达到我需要的目的。
但是我还是想知道,就是能不能在没有激活的图纸空间增加图元?还有就是能不能激活的图纸空间的时候不刷新图形?
ps.在程序编写过程中,我还发现如果选择集中包含“没有激活的图纸空间的对象”时候,Erase方法删除这选择集中的图元就会发生“图元名无效”的错误。(其他方法也是)
lzh741206斑竹
我只能说:我对你的佩服如滔滔江水,连绵不绝。
在没有激活的图纸空间增加图元这个问题困扰了我一段时间,终于解决了。再次感谢
学习
页:
[1]