Option ExplicitDim objent As AcadEntityDim objent1 As AcadEntityDim axislayer As StringDim mainbeamlayer As StringDim beamlayer As StringDim Distance As IntegerDim beamline As AcadLineDim element As AcadEntity
Dim objent As AcadEntity
Dim objent1 As AcadEntity
Dim axislayer As String
Dim mainbeamlayer As String
Dim beamlayer As String
Dim Distance As Integer
Dim beamline As AcadLine
Dim element As AcadEntity
Private Sub CommandButton1_Click()
draw_beam.Hide
'获得主梁的图层
Dim ptbase As Variant
ThisDrawing.Utility.GetEntity objent1, ptbase, "选择目标图层中的实体"
mainbeamlayer = objent1.Layer
draw_beam.Show
End Sub
Private Sub CommandButton2_Click()
draw_beam.Hide
'获得次梁的图层
Dim ptbase As Variant
ThisDrawing.Utility.GetEntity objent, ptbase, "选择目标图层中的实体"
beamlayer = objent.Layer
draw_beam.Show
End Sub
Private Sub CommandButton3_Click()
draw_beam.Hide
'获得轴线的图层
Dim ptbase As Variant
ThisDrawing.Utility.GetEntity objent, ptbase, "选择目标图层中的实体"
axislayer = objent.Layer
draw_beam.Show
End Sub
Private Sub CommandButton9_Click()
Unload Me
End Sub
Private Sub draw_Click()
'安全创造选择集,并选中要绘制梁中间的轴线
draw_beam.Hide
On Error Resume Next
Dim sset As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("example")) Then
Set sset = ThisDrawing.SelectionSets.Item("example")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("example")
Dim FilterType(0 To 1) As Integer
Dim FilterData(0 To 1) As Variant
FilterType(0) = 0
FilterData(0) = "line"
FilterType(1) = 8
FilterData(1) = axislayer
sset.SelectOnScreen FilterType, FilterData
'偏移轴线形成梁边线
For Each element In sset
Set beamline = element.Offset(leftwidth.Value)
beamline.Layer = mainbeamlayer
beamline.Update
beamline = element.Offset(-rightwidth.Value)
beamline.Layer = mainbeamlayer
beamline.Update
Next
Unload Me
End Sub