[编程交流] 将块与属性合并

Public Sub Merge_LnBLk()
 Dim ss As ZcadSelectionSet
 Dim UNode As ZcadText
 Dim UGL As ZcadText
 Dim UIL As ZcadText
 Dim DNode As ZcadText
 Dim DGL As ZcadText
 Dim DIL As ZcadText
 Dim LnLen As ZcadText
 Dim Size As ZcadText
 Dim GetPt As Variant
 Dim BlkName As String
 
 Dim NodeBlk As ZcadBlockReference
 Dim FromBlk As ZcadBlockReference
 Dim ToBlk As ZcadBlockReference
 Dim SizeBlk As ZcadBlockReference
 
 Dim objAttribs As Variant
 Dim FromobjAttribs As Variant
 Dim ToobjAttribs As Variant
 Dim SizeobjAttribs As Variant
 
 On Error Resume Next
 ThisDrawing.SelectionSets("s").Delete
 On Error GoTo 0
 Set ss = ThisDrawing.SelectionSets.Add("s")
 ss.SelectOnScreen
 
 Set FromBlk = ss.Item(0)
 Set ToBlk = ss.Item(1)
 Set SizeBlk = ss.Item(2)
 GetPt = ActiveDocument.Utility.GetPoint(, "Pick where the block to be inserted")
 BlkName = "LNNode"
 Set NodeBlk = ActiveDocument.ModelSpace.InsertBlock(GetPt, BlkName, 1, 1, 1, 0)
 
 
 FromobjAttribs = FromBlk.GetAttributes()
 UNode.TextString = FromobjAttribs(0)
 UGL.TextString = FromobjAttribs(1)
 UIL.TextString = FromobjAttribs(2)
 
 ToobjAttribs = ToBlk.GetAttributes()
 DNode.TextString = ToobjAttribs(0)
 DGL.TextString = ToobjAttribs(1)
 DIL.TextString = ToobjAttribs(2)
 
 SizeobjAttribs = SizeBlk.GetAttributes()
 LnLen.TextString = SizeobjAttribs(0)
 Size.TextString = SizeobjAttribs(1)
 
 
 objAttribs = NodeBlk.GetAttributes()
 objAttribs(0).TextString = UNode
 objAttribs(1).TextString = UGL
 objAttribs(2).TextString = UIL
 objAttribs(3).TextString = DNode
 objAttribs(4).TextString = DGL
 objAttribs(5).TextString = DIL
 objAttribs(6).TextString = LnLen
 objAttribs(7).TextString = Size
 NodeBlk.Update
 
End Sub

Public Sub Merge_LnBLk()
 Dim ss As AcadSelectionSet
 Dim UNode As Variant 'AcadText
 Dim UGL As Variant 'AcadText
 Dim UIL As Variant 'AcadText
 Dim DNode As Variant 'AcadText
 Dim DGL As Variant 'AcadText
 Dim DIL As Variant 'AcadText
 Dim LnLen As Variant 'AcadText
 Dim Size As Variant 'AcadText
 Dim GetPt As Variant
 Dim BlkName As String
 
 Dim NodeBlk As AcadBlockReference
 Dim FromBlk As AcadBlockReference
 Dim ToBlk As AcadBlockReference
 Dim SizeBlk As AcadBlockReference
 
 Dim objAttribs As Variant
 Dim FromobjAttribs As Variant
 Dim ToobjAttribs As Variant
 Dim SizeobjAttribs As Variant
 
 On Error Resume Next
 ThisDrawing.SelectionSets("s").Delete
 On Error GoTo 0
 Set ss = ThisDrawing.SelectionSets.Add("s")
 ss.SelectOnScreen
 
 Set FromBlk = ss.Item(0)
 Set ToBlk = ss.Item(1)
 Set SizeBlk = ss.Item(2)
 GetPt = ActiveDocument.Utility.GetPoint(, "Pick where the block to be inserted")
 BlkName = "LNNode"
 Set NodeBlk = ActiveDocument.ModelSpace.InsertBlock(GetPt, BlkName, 1, 1, 1, 0)
 
 
 FromobjAttribs = FromBlk.GetAttributes()
 UNode = FromobjAttribs(0).TextString
 UGL = FromobjAttribs(1).TextString
 UIL = FromobjAttribs(2).TextString
 
 ToobjAttribs = ToBlk.GetAttributes()
 DNode = ToobjAttribs(0).TextString
 DGL = ToobjAttribs(1).TextString
 DIL = ToobjAttribs(2).TextString
 
 SizeobjAttribs = SizeBlk.GetAttributes()
 LnLen = SizeobjAttribs(0).TextString
 Size = SizeobjAttribs(1).TextString
 
 
 objAttribs = NodeBlk.GetAttributes()
 objAttribs(0).TextString = UNode
 objAttribs(1).TextString = UGL
 objAttribs(2).TextString = UIL
 objAttribs(3).TextString = DNode
 objAttribs(4).TextString = DGL
 objAttribs(5).TextString = DIL
 objAttribs(6).TextString = LnLen
 objAttribs(7).TextString = Size
 NodeBlk.Update
 
End Sub