登录
记住用户名密码
Option Explicit Function TotLen(oSset As AcadSelectionSet) As Double Dim oEnt As AcadEntity For Each oEnt In oSset If TypeOf oEnt Is AcadPolyline Or _ TypeOf oEnt Is AcadLWPolyline Or _ TypeOf oEnt Is AcadLine Then TotLen = TotLen + oEnt.Length ElseIf TypeOf oEnt Is AcadArc Then TotLen = TotLen + oEnt.ArcLength ElseIf TypeOf oEnt Is AcadCircle Then TotLen = TotLen + oEnt.Circumference ElseIf TypeOf oEnt Is AcadSpline Then TotLen = TotLen + GetCurveLength(oEnt) ElseIf TypeOf oEnt Is AcadEllipse Then TotLen = TotLen + GetCurveLength(oEnt) End If Next oEnt End Function Function GetCurveLength(oEnt As AcadEntity) As Double Dim sVar sVar = 0 Dim strCom As String With ThisDrawing .SetVariable "USERR1", sVar .SendCommand "(vl-load-com)" & vbCr strCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")))))" & vbCr .SendCommand strCom GetCurveLength = .GetVariable("USERR1") End With End Function Sub TryIt() Dim oSset As AcadSelectionSet Dim oEnt Dim fcode(0) As Integer Dim fData(0) As Variant Dim dxfCode, dxfdata Dim i As Integer Dim SetName As String ' create filter fcode(0) = 0 ' include the following entity types: ' LINE, LWPOLYLINE, POLYLINE, SPLINE, ARC, CIRCLE, ELLIPSE: fData(0) = "*LINE,ARC,CIRCLE,ELLIPSE" ' dxfCode = fcode dxfdata = fData ' SetName = "$Total$" ' delete all selection sets to make sure that named selection does not exist With ThisDrawing.SelectionSets While .Count > 0 .Item(0).Delete Wend End With ' add empty selection into selectionsets collection Set oSset = ThisDrawing.SelectionSets.Add(SetName) ' select on screen oSset.SelectOnScreen dxfCode, dxfdata ' display result If oSset.Count > 0 Then MsgBox CStr(Round(TotLen(oSset), 3)), vbInformation, "Total Length" Else MsgBox "0 selected, try again" End If End Sub
目前有 0 条留言 其中:访客:0 条, 博主:0 条