丹雪 发表于 2005-5-12 12:43:00

为什么在以下情况不能够画线?请各位指教!

Private Sub ChOrDPath3_Click()<BR>Form1.Hide


On 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 &gt; 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 &gt; 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 &amp; "请输入下一点:")<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 &amp; "请输入下一点:")<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

zfbj 发表于 2005-5-12 14:16:00

把程序注释一下吧,让大家很快能明白你的意思。


整段代码没有一句注释,大家读起来就要费很多时间,所以说老实话,很难有人耐心看完你的代码。
页: [1]
查看完整版本: 为什么在以下情况不能够画线?请各位指教!