Merging Blocks with Attributes

[vasanthsv84]

Good day everyone,

 

 I like to merge three blocks attributes to one block with attributes. I'm not good at VBA. I hope someone correct the below code for me. Thanks

 

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

 

TestBlocks.dwg

Edited February 2, 2021 by vasanthsv84

[PeterPan9720]

On 2/2/2021 at 12:25 PM, vasanthsv84 said:

Good day everyone,

 

 I like to merge three blocks attributes to one block with attributes. I'm not good at VBA. I hope someone correct the below code for me. Thanks

 

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

 

TestBlocks.dwg 136.63 kB · 0 downloads

 

Here the code revised: 

You have to assign the Attribute Value stored into the Textstring Array property into a Variable and then assign the newblock attribute value as the variable.

 

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

 

Edited February 3, 2021 by PeterPan9720

[vasanthsv84]

@PeterPan9720 நன்றிகள் பல Thank you so much bro. It worked.