如何用VB6实现自动拾取计算CAD图形中线的长度
<font color="#f70968" size="6">如何用VB6编程实现自动拾取计算CAD图形中线的长度,并将其值返回列表框?</font> 望哪位高手能不吝赐教,给编个源码,说明一下 <p>你先在VBA中理解清楚</p><p>dim ll as acadline</p><p>debug.pring ll.length 就是你要的线段长度。</p><p>转到VB6.0很简单，关键是你有没有这方面的基础。在这里找一下有实例。</p> VBA中是否要导入vlax.cls类?怎样实施,如果采用VB6又如何实施呢?我是一个新手,劳烦版主能举例讲详细一点好吗?再次谢谢!!!!!!! <font color="#f73809">哪位高手能给个VB6的实例吗,给个有源码实例的链接也行</font> 本帖最后由 作者 于 2008-7-5 0:07:36 编辑 <br /><br /> <p>能否将以下的VBA拾取计算CAD线段长度代码,转换成VB6代码?望哪位指点.在此感谢!!!</p><p>'Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long<br/>Private Type POINTAPI<br/>x As Long<br/>Y As Long<br/>End Type</p><p><br/>Public Function CreateSelectionSet(Optional ssName As String = "SS3") As AcadSelectionSet<br/> '返回一个空白选择集<br/> Dim SS3 As AcadSelectionSet<br/> On Error Resume Next<br/> Set SS3 = ThisDrawing.SelectionSets(ssName)<br/> If Err Then Set SS3 = ThisDrawing.SelectionSets.Add(ssName)<br/> SS3.Clear<br/> Set CreateSelectionSet = SS3<br/>End Function</p><p> <br/>Function Long_OverFlow_To_Double(ByVal longVal As Long) As Double<br/> '将大于2147483647的数值longVal 转换为double类型<br/> Dim ret_val As Double<br/> Dim over_long As Double '2的32次方<br/> 'N(真值)=4294967296#(2的32次方)-补码<br/> over_long = 4294967296#<br/> If longVal < 0 Then<br/> ret_val = over_long + (longVal)<br/> End If<br/>Long_OverFlow_To_Double = ret_val<br/>End Function</p><p>Public Function Round(ByVal nValue, Optional nPlaces As Integer = 2) As Double<br/>Dim tmp As Integer<br/>nValue = CDbl(nValue)<br/>tmp = Fix(nValue)<br/>nValue = CInt((nValue - tmp) * 10 ^ nPlaces)<br/>Round = tmp + nValue / 10 ^ nPlaces<br/>End Function<br/>Public Function Roundl(ByVal nValue, Optional nPlaces As Integer = 2) As Double<br/>Dim tmp As Long<br/>nValue = CDbl(nValue)<br/>tmp = Fix(nValue)<br/>nValue = CInt((nValue - tmp) * 10 ^ nPlaces)<br/>Roundl = tmp + nValue / 10 ^ nPlaces<br/>End Function<br/>Public Function Roundd(ByVal nValue, Optional nPlaces As Integer = 2) As Double<br/>Dim tmp As Double<br/>nValue = CDbl(nValue)<br/>tmp = Fix(nValue)<br/>nValue = CInt((nValue - tmp) * 10 ^ nPlaces)<br/>Roundd = tmp + nValue / 10 ^ nPlaces<br/>End Function<br/>Function Distance(Point1, Point2) As Double<br/> Dim dist As Double<br/> On Error Resume Next<br/> For i = LBound(Point1) To UBound(Point1)<br/> dist = dist + ((Point1(i) - Point2(i)) ^ 2)<br/> If Err Then Exit For<br/> Next<br/> Distance = Sqr(dist)<br/>End Function<br/>Function existtext(plineObj As Object) As Boolean<br/> On Error Resume Next<br/> Dim textObj As AcadText<br/> Dim ent As Object<br/> Dim DataType(0 To 1) As Integer<br/> Dim Data(0 To 1) As Variant<br/> Dim ss As AcadSelectionSet<br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "text"<br/> Dim groupCode As Variant, dataCode As Variant<br/> groupCode = FilterType<br/> dataCode = FilterData</p><p> ThisDrawing.SelectionSets("Test").Delete<br/> Set ss = ThisDrawing.SelectionSets.Add("Test")<br/> <br/> Dim InsertionPoint(0 To 2) As Double<br/> InsertionPoint(0) = plineObj.Coordinate(0)(0): InsertionPoint(1) = plineObj.Coordinate(0)(1): InsertionPoint(2) = 0<br/> <br/> Dim corner1(0 To 2) As Double<br/> Dim corner2(0 To 2) As Double<br/> <br/> corner1(0) = plineObj.Coordinate(0)(0) - 20: corner1(1) = plineObj.Coordinate(0)(1) - 20: corner1(2) = 0<br/> corner2(0) = plineObj.Coordinate(0)(0) + 20: corner2(1) = plineObj.Coordinate(0)(1) + 20: corner2(2) = 0<br/> <br/> ss.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode<br/> <br/> If ss.Count = 0 Then<br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "qd"<br/> Set textObj = ThisDrawing.ModelSpace.AddText("起点", InsertionPoint, 500)<br/> textObj.SetXData DataType, Data<br/> End If<br/> <br/> If ss.Count > 0 Then<br/> For Each ent In ss<br/> <br/> If ent.TextString = "起点" Then<br/> Else<br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "qd"<br/> Set textObj = ThisDrawing.ModelSpace.AddText("起点", InsertionPoint, 500)<br/> textObj.SetXData DataType, Data<br/> End If<br/> Next<br/> End If<br/>ThisDrawing.SelectionSets("Test").Delete<br/>End Function<br/>Function Drawcircle(intpoints As Variant)<br/> On Error Resume Next<br/> Dim circleObj As AcadCircle<br/> Dim DataType(0 To 1) As Integer<br/> Dim Data(0 To 1) As Variant<br/> Dim ss As AcadSelectionSet<br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "Circle"<br/> Dim groupCode As Variant, dataCode As Variant<br/> groupCode = FilterType<br/> dataCode = FilterData</p><p> ThisDrawing.SelectionSets("cir").Delete<br/> Set ss = ThisDrawing.SelectionSets.Add("cir")<br/> <br/> Dim corner1(0 To 2) As Double<br/> Dim corner2(0 To 2) As Double<br/> <br/> corner1(0) = intpoints(0) - 6: corner1(1) = intpoints(1) - 6: corner1(2) = 0<br/> corner2(0) = intpoints(0) + 6: corner2(1) = intpoints(1) + 6: corner2(2) = 0<br/> <br/> ss.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode<br/> <br/> If ss.Count = 0 Then<br/> Set circleObj = ThisDrawing.ModelSpace.AddCircle(intpoints, 5)<br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "cir"<br/> circleObj.SetXData DataType, Data '<br/> <br/> End If<br/>ThisDrawing.SelectionSets("cir").Delete<br/>End Function<br/>Function qj(ent As AcadEntity, removeObjects() As AcadEntity, numbera) As Double<br/> Dim intpoints As Variant<br/> Dim d1, d2, d3 As Double<br/> Dim qjx As Double<br/> qjx = 0<br/> For m = 0 To numbera<br/> intpoints = ent.IntersectWith(removeObjects(m), acExtendNone)<br/> If UBound(intpoints) > -1 Then Exit For<br/> Next<br/> <br/> If UBound(intpoints) > -1 Then<br/> <br/> For jds = (UBound(removeObjects(m).Coordinates) + 1) / 2 - 1 To 1 Step -1<br/> <br/> d3 = Roundd(Distance(removeObjects(m).Coordinate(jds), removeObjects(m).Coordinate(jds - 1)), 2)<br/> d2 = Roundd(Distance(removeObjects(m).Coordinate(jds), intpoints), 2)<br/> d1 = Roundd(Distance(removeObjects(m).Coordinate(jds - 1), intpoints), 2)<br/> <br/> If d1 + d2 - 0.03 < d3 And d3 < d1 + d2 + 0.03 Then<br/> <br/> If jds > 1 Then<br/> For n = jds - 1 To 1 Step -1<br/> qjx = Distance(removeObjects(m).Coordinate(n), removeObjects(m).Coordinate(n - 1)) + qjx<br/> Next<br/> End If<br/> <br/> qjx = d1 + qjx<br/> Drawcircle intpoints<br/> Exit For<br/> <br/> End If<br/> Next<br/> <br/> End If<br/> qj = qjx<br/> End Function<br/>Function ybg(sset As AcadSelectionSet) As Boolean<br/> On Error Resume Next<br/> Dim ent As AcadEntity<br/> Dim PStartpoint, PEndpoint As Variant<br/> For Each ent In sset<br/> If ent.ObjectName = "AcDbLine" Then<br/> PStartpoint = ent.StartPoint<br/> PStartpoint(2) = 0<br/> ent.StartPoint = PStartpoint<br/> PEndpoint = ent.EndPoint<br/> PEndpoint(2) = 0<br/> ent.EndPoint = PEndpoint<br/> ent.Update<br/> End If<br/> If ent.ObjectName = "AcDbPolyline" Then<br/> ent.Elevation = 0<br/> ent.Update<br/> End If<br/> Next<br/>End Function</p><p>Private Sub CommandButton1_Click()<br/>On Error Resume Next<br/>Dim sset As AcadSelectionSet<br/>Set sset = CreateSelectionSet("SS3")<br/> Dim xdataOut As Variant<br/> Dim xtypeOut As Variant</p><p> ListBox1.Clear</p><p> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "LWPolyline"<br/> sset.SelectOnScreen FilterType, FilterData<br/> <br/> Dim ent As Object</p><p> For Each ent In sset<br/> ent.GetXData "", xtypeOut, xdataOut<br/> If VarType(xdataOut) = 8204 Then<br/> <br/> If xdataOut(1) = "MR" Then<br/> existtext ent<br/> ListBox1.AddItem "坐标 X= " & Roundd(ent.Coordinate(0)(0), 0) & " Y= " & Roundd(ent.Coordinate(0)(1), 0)<br/> <br/> End If<br/> <br/> End If<br/> Next<br/> ThisDrawing.SelectionSets.Item("SS3").Delete</p><p>End Sub</p><p>Private Sub CommandButton2_Click()<br/>If Me.CommandButton2.Caption = "设定MR" Then<br/>UserForm1.CommandButton4.Enabled = False<br/>Me.CommandButton2.Caption = "隐藏"<br/>UserForm1.Width = 210<br/>UserForm1.Height = 145<br/>Else<br/>Me.CommandButton2.Caption = "设定MR"<br/>UserForm1.CommandButton4.Enabled = True<br/>UserForm1.Width = 90<br/>UserForm1.Height = 130<br/>End If<br/>End Sub</p><p>Private Sub CommandButton3_Click()</p><p>On Error Resume Next<br/> Dim sset As AcadSelectionSet<br/> ThisDrawing.SelectionSets("SS2").Delete<br/> Set sset = ThisDrawing.SelectionSets.Add("SS2")<br/> <br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "LWPolyline,line"<br/> sset.SelectOnScreen FilterType, FilterData<br/> <br/> Dim ent As Object<br/> For Each ent In sset<br/> Dim plineObj As AcadLWPolyline<br/> <br/> If ent.ObjectName = "AcDbLine" Then<br/> Dim PStartpoint As Variant<br/> Dim PEndpoint As Variant<br/> <br/> PStartpoint = ent.StartPoint<br/> PEndpoint = ent.EndPoint</p><p> Dim newVertex(0 To 3) As Double<br/> newVertex(0) = PStartpoint(0): newVertex(1) = PStartpoint(1)<br/> newVertex(2) = PEndpoint(0): newVertex(3) = PEndpoint(1)<br/> Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(newVertex)<br/> ent.Delete<br/> <br/> Else<br/> <br/> Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ent.Coordinates)<br/> <br/> ent.Delete<br/> End If<br/> <br/> Dim DataType(0 To 1) As Integer<br/> Dim Data(0 To 1) As Variant<br/> <br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "MR"<br/> <br/> <br/> plineObj.SetXData DataType, Data ' 在直线上附着扩展数据<br/> Dim color As AcadAcCmColor<br/> Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")<br/> Call color.SetRGB(254, 0, 0)<br/> plineObj.TrueColor = color<br/> <br/> existtext plineObj<br/> <br/> <br/> Next<br/>ThisDrawing.SelectionSets.Item("SS2").Delete</p><p><br/>'retCoord = plineObj.Coordinates<br/>'For Number = LBound(retCoord) To UBound(retCoord)<br/>'a = a & retCoord(Number) & Chr(13)<br/>'Next<br/>End Sub</p><p>Private Sub CommandButton4_Click()<br/>Static bRun As Boolean<br/>bRun = Not bRun</p><p>If bRun Then<br/>'CommandButton4.Caption = "停止计算"<br/>'UserForm1.CommandButton2.Enabled = False<br/> 'While bRun<br/> If UserForm1.ComboBox1.ListIndex = 0 Then Call qzx<br/> 'If UserForm1.ComboBox1.ListIndex = 1 Then Call qd<br/> DoEvents<br/> ' Wend<br/> Else<br/> CommandButton4.Caption = "开始计算"<br/> UserForm1.CommandButton2.Enabled = True<br/> Exit Sub<br/>End If</p><p>End Sub</p><p>Private Sub CommandButton5_Click()<br/>On Error Resume Next<br/> Dim sset As AcadSelectionSet<br/> ThisDrawing.SelectionSets("SS4").Delete<br/> Set sset = ThisDrawing.SelectionSets.Add("SS4")<br/> <br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "text"<br/> sset.SelectOnScreen FilterType, FilterData<br/> Dim xdataOut As Variant<br/> Dim xtypeOut As Variant<br/> Dim ent As Object<br/> <br/> For Each ent In sset<br/> ent.GetXData "", xtypeOut, xdataOut<br/> If VarType(xdataOut) = 8204 Then ent.Delete<br/> Next<br/> <br/> ThisDrawing.SelectionSets.Item("SS4").Delete<br/>End Sub</p><p>Private Sub CommandButton6_Click()</p><p>On Error Resume Next<br/> Dim sset As AcadSelectionSet<br/> ThisDrawing.SelectionSets("SS111").Delete<br/> Set sset = ThisDrawing.SelectionSets.Add("SS111")<br/> <br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "circle"<br/> sset.SelectOnScreen FilterType, FilterData<br/> sset.Highlight True<br/> Dim xdataOut As Variant<br/> Dim xtypeOut As Variant<br/> Dim ent As Object<br/> <br/> For Each ent In sset<br/> ent.GetXData "", xtypeOut, xdataOut<br/> If VarType(xdataOut) = 8204 Then ent.Delete<br/> Next<br/> <br/> ThisDrawing.SelectionSets.Item("SS111").Delete<br/>End Sub</p><p>Private Sub CommandButton7_Click()<br/>Dim a, m, n As Integer<br/>a = 0<br/>Dim temp() As Double<br/>Dim sset As AcadSelectionSet<br/>Set sset = CreateSelectionSet("SS22")<br/> Dim xdataOut As Variant<br/> Dim xtypeOut As Variant</p><p> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "LWPolyline"<br/> sset.SelectOnScreen FilterType, FilterData<br/> <br/> Dim ent As Object<br/> <br/> For Each ent In sset<br/> ent.GetXData "", xtypeOut, xdataOut<br/> If VarType(xdataOut) = 8204 Then<br/> If xdataOut(1) = "MR" Then<br/> a = 1<br/> n = (UBound(ent.Coordinates) + 1) / 2 - 1<br/> <br/> ' Dim tempobj As Variant<br/> ' Dim objCollection(0 To 0) As Object<br/> ' Set objCollection(0) = ent<br/> ' tempobj = ThisDrawing.CopyObjects(objCollection)<br/> <br/> Dim tempobj As AcadLWPolyline<br/> Set tempobj = ent.Copy()<br/> For m = 0 To n<br/> ent.Coordinate(m) = tempobj.Coordinate(n - m)<br/> Next<br/> tempobj.Delete<br/> existtext ent<br/> End If<br/> <br/> End If<br/> Next<br/> ThisDrawing.SelectionSets.Item("SS22").Delete<br/>If a = 0 Then MsgBox "找不到桥架"<br/>End Sub</p><p> </p><p>Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)<br/> <br/> On Error Resume Next<br/> <br/> Dim zcenter(0 To 2) As Double<br/> Dim magnification As Double<br/> zcenter(0) = Split(ListBox1.List(ListBox1.ListIndex), " ")(2)<br/> zcenter(1) = Split(ListBox1.List(ListBox1.ListIndex), " ")(4): zcenter(2) = 0<br/> magnification = ThisDrawing.GetVariable("VIEWSIZE")<br/> ZoomCenter zcenter, magnification</p><p><br/> Dim textObj As AcadText<br/> Dim ent As Object<br/> Dim DataType(0 To 1) As Integer<br/> Dim Data(0 To 1) As Variant<br/> Dim ss As AcadSelectionSet<br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "text"<br/> <br/> Dim groupCode As Variant, dataCode As Variant<br/> groupCode = FilterType<br/> dataCode = FilterData</p><p> ThisDrawing.SelectionSets("Test").Delete<br/> Set ss = ThisDrawing.SelectionSets.Add("Test")<br/> <br/> <br/> Dim corner1(0 To 2) As Double<br/> Dim corner2(0 To 2) As Double<br/> <br/> corner1(0) = zcenter(0) - 30: corner1(1) = zcenter(1) - 30: corner1(2) = 0<br/> corner2(0) = zcenter(0) + 30: corner2(1) = zcenter(1) + 30: corner2(2) = 0<br/> <br/> ss.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode<br/> <br/> If ss.Count = 0 Then<br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "qd"<br/> Set textObj = ThisDrawing.ModelSpace.AddText("起点", zcenter, 500)<br/> textObj.SetXData DataType, Data<br/> End If<br/> <br/> If ss.Count > 0 Then<br/> For Each ent In ss<br/> <br/> If ent.TextString = "起点" Then<br/> Else<br/> DataType(0) = 1001: Data(0) = "MRApplication"<br/> DataType(1) = 1000: Data(1) = "qd"<br/> Set textObj = ThisDrawing.ModelSpace.AddText("起点", zcenter, 500)<br/> textObj.SetXData DataType, Data<br/> End If<br/> Next<br/> End If<br/>ThisDrawing.SelectionSets("Test").Delete</p><p>End Sub</p><p>Private Sub UserForm_Initialize()<br/>ComboBox1.AddItem "取直线"<br/>ComboBox1.AddItem "取点"<br/>ComboBox1.ListIndex = 0<br/>End Sub</p><p>Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)<br/>On Error Resume Next<br/>ThisDrawing.SelectionSets.Item("SS1").Delete<br/>ThisDrawing.SelectionSets.Item("SS2").Delete<br/>ThisDrawing.SelectionSets.Item("SS3").Delete<br/>ThisDrawing.SendCommand Chr(3) & Chr(3) & Chr(3) & vbCrLf & Chr(3)<br/>End Sub<br/>Sub qzx()<br/> On Error Resume Next<br/> <br/> ThisDrawing.Utility.Prompt (vbCrLf & "取直线计算")<br/> Dim sset As AcadSelectionSet<br/> ThisDrawing.SelectionSets("SS1").Delete<br/> Set sset = ThisDrawing.SelectionSets.Add("SS1")<br/> <br/> Dim FilterType(0) As Integer<br/> Dim FilterData(0) As Variant<br/> FilterType(0) = 0<br/> FilterData(0) = "LWPolyline,line"<br/> <br/> sset.SelectOnScreen FilterType, FilterData<br/> If UserForm1.Visible = False Then Exit Sub<br/> Call ybg(sset)<br/> Dim ent As AcadEntity<br/> Dim removeObjects(0 To 30) As AcadEntity<br/> <br/> Dim intpoints As Variant<br/> Dim numbera, jds, js1, js2 As Integer: Dim qjx, gz, temp As Double<br/> numbera = 0: jds = 0<br/> gz = 0: qjx = 0: js1 = 0: js2 = 0<br/> <br/> <br/> <br/> For Each ent In sset<br/> ent.GetXData "", xtypeOut, xdataOut<br/> If VarType(xdataOut) = 8204 Then<br/> Set removeObjects(numbera) = ent<br/> numbera = numbera + 1<br/> End If<br/> Next<br/> <br/> If numbera > 0 Then<br/> sset.RemoveItems removeObjects<br/> End If<br/> <br/> If numbera = 0 Then<br/> For Each ent In sset<br/> gz = ent.Length + gz<br/> js1 = js1 + 1<br/> Next<br/> End If<br/> <br/> If numbera > 0 Then<br/> For Each ent In sset<br/> qjx = qj(ent, removeObjects, numbera - 1) + qjx<br/> If temp <> qjx Then js2 = js2 + 1<br/> temp = qjx<br/> gz = ent.Length + gz<br/> js1 = js1 + 1<br/> Next<br/> End If<br/> <br/> ThisDrawing.SelectionSets.Item("SS1").Delete<br/> gz = Round(gz / 1000, 2)<br/> qjx = Round(qjx / 1000, 2)<br/> MsgBox js1 & "对象穿管长度:" & gz & "米" & Chr(13) & js2 & "对象穿桥架长:" & qjx & "米"<br/> <br/>End Sub</p><p>Sub qd()<br/> On Error GoTo Err_Control<br/> <br/> ThisDrawing.Utility.Prompt (vbCrLf & "取点计算")<br/> Dim lineObj(20) As AcadLine<br/> Dim strArr(20) As Variant<br/> Dim p1, p2 As Variant<br/> Dim m As Double<br/> Dim k, j As Integer<br/> <br/> k = 1<br/> strArr(0) = ThisDrawing.Utility.GetPoint(, "获取第" & k & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "第" & k & "点" & "x=" & strArr(0)(0) & " y=" & strArr(0)(1) & vbCrLf)<br/> For j = 1 To 20<br/> k = k + 1<br/> strArr(j) = ThisDrawing.Utility.GetPoint(strArr(j - 1), "获取第" & k & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "第" & k & "点" & "x=" & strArr(j)(0) & " y=" & strArr(j)(1) & vbCrLf)<br/> Set lineObj(j - 1) = ThisDrawing.ModelSpace.AddLine(strArr(j - 1), strArr(j))<br/> Next<br/> <br/>Err_Control:<br/> Select Case Err.Number<br/> Case -2145320928#<br/> <br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> ThisDrawing.Utility.Prompt (vbCrLf & "共获取" & k - 1 & "点")<br/> <br/> For j = 0 To k - 1<br/> p1 = strArr(j)<br/> p2 = strArr(j + 1)<br/> m = m + Distance(p1, p2)<br/> Next<br/> <br/> m = Round(m / 1000, 2)<br/> If UserForm1.Visible = False Then GoTo del<br/> <br/> MsgBox k - 1 & "个点距离之:" & m & "米"<br/> <br/> <br/> For j = 0 To k - 3<br/> lineObj(j).Delete<br/> Next<br/> <br/> Case -2147352567#<br/>del: For j = 0 To k - 3<br/> lineObj(j).Delete<br/> Next<br/> 'ThisDrawing.SendCommand Chr(3) & Chr(3)<br/> Case Else<br/> ' MsgBox Err.Number & Err.Description<br/> End Select</p><p>End Sub<br/>望各位高手不吝赐教,谢谢!!!!!</p><p> </p>
页:
[1]