hardwired 发表于 2008-2-20 09:30:15

在VBA中绘制对象的顺序...

嗨,
有没有办法排序VBA创建的对象的绘制顺序?
基本上........
' Check for correct titleblocks..
Select Case entX.Name
      Case "A3 - AbiCAD Titleblock"
                A3logo_IP(0) = 9.442: A3logo_IP(1) = 5: A3logo_IP(2) = 0
                Set blockLOGO_A3 = ThisDrawing.Blocks.Item("A3 - AbiCAD Titleblock").InsertBlock(A3logo_IP, LogoPath, 1#, 1#, 1#, 0)
                blockLOGO_A3.Layer = "ABI-BORDER"
                blockLOGO_A3.Update
                GoTo RUN_TBE
End Select
....当用户选择一个客户名称时,它会将该徽标插入主标题栏,但有些徽标是彩色的,应该位于主标题栏边框线的后面..
在VBA,这些块对象没有draworder属性,或者有其他方法可以做到这一点吗?
有什么想法吗?干杯,保罗代码1]
P4 3.0Ghz / 2GB内存
XP Pro SP2
蓝宝石X1950 512MB双DVi显卡..
AutoCAD 2008..
**** Hidden Message *****

Bryco 发表于 2008-2-20 09:51:09

AcadSortentsTable,这方面的帮助也很好。

hardwired 发表于 2008-2-20 11:42:03

嗨,
已经研究了它,并从网络上的其他地方复制了一些代码(红色)并修改了它以达到我自己的目的:
Private Sub cmdUpdateTitleblock_click()
'Draworder the LOGO to the back..
Dim eDictionary As Object
Dim sentityObj As Object
Dim A3_STB(0), A2_STB(0), A1_STB(0) As AcadObject
Set eDictionary = ThisDrawing.PaperSpace.GetExtensionDictionary
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
' Loop through every layout in the drawing..
ThisDrawing.ActiveSpace = acPaperSpace
For Each layoutX In ThisDrawing.Layouts
If layoutX.Name"Model" Then 'Disregard ModelSpace..
ThisDrawing.ActiveLayout = layoutX
   
' Start main loop to get attribute values for the attributes..
For Each entX In ThisDrawing.PaperSpace
    ' If the found object is a block..
If entX.EntityName = "AcDbBlockReference" Then
' Check for correct titleblocks and insert logos. Also, set draworder for blocks to movetobottom..
Select Case entX.Name
      Case "A1 - AbiCAD Titleblock"
                A1logo_IP(0) = 446.415: A1logo_IP(1) = 17.085: A1logo_IP(2) = 0
                Set blockLOGO_A1 = ThisDrawing.Blocks.Item("A1 - AbiCAD Titleblock").InsertBlock(A1logo_IP, LogoPath, 1#, 1#, 1#, 0)
                blockLOGO_A1.Layer = "ABI-BORDER"
                blockLOGO_A1.Update
                Set A1_STB(0) = blockLOGO_A1
                sentityObj.MoveToBottom A1_STB
                AcadApplication.Update
                GoTo RUN_TBE
               
      Case "A2 - AbiCAD Titleblock"
                A2logo_IP(0) = 183.049: A2logo_IP(1) = 5: A2logo_IP(2) = 0
                Set blockLOGO_A2 = ThisDrawing.Blocks.Item("A2 - AbiCAD Titleblock").InsertBlock(A2logo_IP, LogoPath, 1#, 1#, 1#, 0)
                blockLOGO_A2.Layer = "ABI-BORDER"
                blockLOGO_A2.Update
                Set A2_STB(0) = blockLOGO_A2
                sentityObj.MoveToBottom A2_STB
                AcadApplication.Update
                GoTo RUN_TBE
               
      Case "A3 - AbiCAD Titleblock"
                A3logo_IP(0) = 9.442: A3logo_IP(1) = 5: A3logo_IP(2) = 0
                Set blockLOGO_A3 = ThisDrawing.Blocks.Item("A3 - AbiCAD Titleblock").InsertBlock(A3logo_IP, LogoPath, 1#, 1#, 1#, 0)
                blockLOGO_A3.Layer = "ABI-BORDER"
                blockLOGO_A3.Update
                Set A3_STB(0) = blockLOGO_A3
                sentityObj.MoveToBottom A3_STB
                AcadApplication.Update
                GoTo RUN_TBE
End Select
            
RUN_TBE:
'blah blah blah more code here for other stuff...
End Sub
....但是这段代码在'sentityObj.MoveToBottom A3_STB','sentityObj.MoveToBottom A2_STB'和'sentityObj.MoveToBottom A1_STB'行上触底反弹,指出:
'无效输入'
可能出了什么问题?是将徽标块插入到另一个块(嵌套块)中,还是有一个简单的解决方案?
有什么想法吗?
干杯,
保罗
基点设计有限公司。
P4 3.0Ghz / 2GB 内存
XP Pro SP2
蓝宝石 X1950 512MB 双 DVi 显卡。
AutoCAD 2008..

Bryco 发表于 2008-2-20 12:20:51

试着做一个函数
但是,首先尝试一下“帮助”的功能,我认为您可能需要学习编程基础知识
首先,你要弄清楚怎么做,然后再弄清楚如何使之适应你正在编写的特定代码。
对每个人来说,这都需要时间。
页: [1]
查看完整版本: 在VBA中绘制对象的顺序...