AutoCAD中获得曲线长度的VBA代码

全屏阅读

2012-03-14 21:03:43 作者: 所属分类:程序设计 阅读:5554 评论:0

标签:

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

顶一下
(8)
100%
订阅 回复
踩一下
(0)
0%
» 郑重声明:本文由不吃醋的猫发布,所有内容仅代表个人观点。版权归懒猫窝窝不吃醋的猫共有,欢迎转载, 但未经作者同意必须保留此段声明,并给出文章连接,否则保留追究法律责任的权利! 如果本文侵犯了您的权益,请留言。
  • 目前有 0 条留言 其中:访客:0 条, 博主:0 条

    给我留言