嗨,
已经研究了它,并从网络上的其他地方复制了一些代码(红色)并修改了它以达到我自己的目的:
- Private Sub cmdUpdateTitleblock_click()
- [color=red]'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")[/color]
- ' 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
- [color=red]Set A1_STB(0) = blockLOGO_A1
- sentityObj.MoveToBottom A1_STB[/color]
- 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
- [color=red]Set A2_STB(0) = blockLOGO_A2
- sentityObj.MoveToBottom A2_STB[/color]
- 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
- [color=red]Set A3_STB(0) = blockLOGO_A3
- sentityObj.MoveToBottom A3_STB[/color]
- 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..
|