为什么在以下情况不能够画线?请各位指教!
Private Sub ChOrDPath3_Click()<BR>Form1.HideOn Error Resume Next<BR>Dim objlayer As AcadLayer
If IsNull(ThisDrawing.Layers.Item("ExtrudePath")) Then<BR>Set objlayer = ThisDrawing.Layers.Add("ExtrudePath")<BR>ThisDrawing.ActiveLayer = objlayer
Else<BR>For Each objlayer In ThisDrawing.Layers<BR>If objlayer.Name = "ExtrudePath" Then<BR>ThisDrawing.ActiveLayer = objlayer<BR>Exit For<BR>End If<BR>Next<BR>End If
Dim sset As AcadSelectionSet<BR>Dim i As Integer<BR>i = ThisDrawing.SelectionSets.Count
While (i > 0)<BR>Set sset = ThisDrawing.SelectionSets.Item(i - 1)<BR>If sset.Name = "3dPLine" Then<BR>sset.Delete<BR>End If<BR>i = i - 1<BR>Wend<BR>Set sset = ThisDrawing.SelectionSets.Add("3dPLine")
Dim gpcode(1) As Integer<BR>Dim datavalue(1) As Variant<BR>gpcode(0) = 0<BR>datavalue(0) = "PolyLine"<BR>gpcode(1) = 8<BR>datavalue(1) = "ExtrudePath"
Dim objline As Acad3DPolyline
Dim topoint1(0 To 2) As Variant<BR>topoint1(0) = Val(Form2.XPoint.Text)<BR>topoint1(1) = Val(Form2.YPoint.Text)<BR>topoint1(2) = Val(Form2.ZPoint.Text)
sset.Select acSelectionSetAll, , , gpcode, datavalue<BR>If sset.Count > 1 Then<BR>MsgBox "满足条件的拉伸路径存在多条,请选择一条!"<BR>sset.Clear<BR>sset.SelectOnScreen gpcode, datavalue<BR>Set objline = sset.Item(0)
objline.Move objline.Coordinate(0), topoint1
<BR>Else<BR>If sset.Count = 1 Then<BR>Set objline = sset.Item(0)<BR>objline.Move objline.Coordinate(0), topoint1
<BR>Else<BR>For Each objlayer In ThisDrawing.Layers<BR>If objlayer.Name = "ExtrudePath" Then<BR>ThisDrawing.ActiveLayer = objlayer<BR>End If<BR>Exit For<BR>Next<BR>On Error GoTo ErrHandle<BR>Dim p2 As Variant<BR>p2 = ThisDrawing.Utility.GetPoint(, vbCr & "请输入下一点:")<BR>Dim pnt(5) As Double<BR>pnt(0) = Val(Form2.XPoint.Text): pnt(1) = Val(Form2.YPoint.Text): pnt(2) = Val(Form2.ZPoint.Text)<BR>pnt(3) = p2(0): pnt(4) = p2(1): pnt(5) = p2(2)
Set objline = ThisDrawing.ModelSpace.Add3DPoly(pnt)<BR>Do While True<BR>p2 = ThisDrawing.Utility.GetPoint(p2, vbCr & "请输入下一点:")<BR>objline.AppendVertex p2<BR>Loop<BR>ErrHandle:<BR>End If<BR>End If
(以上代码实现了“如果层ExtrudePath里面有超过一条3维多段线时,要求用户确定其中一条作为拉伸路径;如果恰好有条的话就自动作为拉伸路径;如果没有的话,就要求用户绘制一条3维多段线作为拉伸路径“。接下来的代码是为了获得当前三维多段线的相关参数,另外画一条三维多段线。可为什么运行的时候总是说过程无效?line1为空值)
Dim endpoint1(0 To 5) As Variant<BR>Dim coord1 As Variant<BR>Dim coord2 As Variant<BR>coord1 = objline.Coordinate(1)<BR>coord2 = objline.Coordinate(0)<BR>Dim line1 As Acad3DPolyline<BR>endpoint1(0) = 0: endpoint1(1) = coord1(1): endpoint1(2) = coord2(2)<BR>endpoint1(3) = coord1(0): endpoint1(4) = coord1(1): endpoint1(5) = coord1(2)<BR>Set line1 = ThisDrawing.ModelSpace.Add3DPoly(endpoint1)<BR>End Sub 把程序注释一下吧,让大家很快能明白你的意思。
整段代码没有一句注释,大家读起来就要费很多时间,所以说老实话,很难有人耐心看完你的代码。
页:
[1]