Jump to content

Merging Blocks with Attributes


Recommended Posts

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 by vasanthsv84
Link to post
Share on other sites
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

image.thumb.png.b44448999827e40ae9ab08c46579528e.png

 

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 by PeterPan9720
Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...