为什么我用vba时,偏移对象后改变不了偏移出来的直线的图层?
lency_1984
lency_1984 Lv.5
2011年04月17日 16:12:59
只看楼主

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

Option Explicit

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
lency_1984
2011年04月17日 16:13:45
2楼
最后面改图层的时候始终改不了,还是原先偏移对象的图层
回复
lency_1984
2011年04月18日 10:42:15
3楼
回复
wuzhm21
2013年01月01日 12:23:42
4楼
Set beamline = element.Offset(leftwidth.Value)有误,beamline应设为变体
回复

相关推荐

APP内打开