将块与属性合并
大家好，我喜欢将三个块属性合并为一个具有属性的块。我不擅长VBA。我希望有人为我更正以下代码。谢谢
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
此处修订代码：
必须将存储在Textstring数组属性中的属性值赋给变量，然后将新块属性值赋给变量。
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 @彼得·潘9720நன்றிகள் பல 非常感谢你，兄弟。它成功了。
页:
[1]