how to find the length of curve in vba?

how to find the length of curve in vba?

Anonymous
Not applicable
4,283 Views
5 Replies
Message 1 of 6

how to find the length of curve in vba?

Anonymous
Not applicable

Capture.PNGHi , I am try to create a function that compute the length of a line such as the picture shows on top.

The code I have now only getting the straight line distance. It's there a way to compute the curve distance?

 

0 Likes
4,284 Views
5 Replies
Replies (5)
Message 2 of 6

Hallex
Advisor
Advisor

Try this solution, load lisp code to your acaddoc.lsp,

then try attached .bas file, see for more how to add

lisp routine to your acaddoc.lsp

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 3 of 6

Anonymous
Not applicable
thanks for reply, I will try see if it work.
0 Likes
Message 4 of 6

Anonymous
Not applicable

Hello,

 

Sub LengthCurves()
Dim oEntity As AcadEntity
Dim P1 As Variant
Dim strMessage As String

On Error GoTo Err_LengthCurves

    ThisDrawing.Utility.GetEntity oEntity, P1, vbCrLf & "Select a line, an arc, a circle or a polyline (2D or 3D)"
    
    Select Case oEntity.ObjectName
        Case "AcDbCircle"
            strMessage = "Circle : " & oEntity.Circumference
            
        Case "AcDbArc"
            strMessage = "Arc : " & oEntity.ArcLength
            
        Case "AcDbLine"
            strMessage = "Line : " & oEntity.Length
        
        Case "AcDbPolyline"
            strMessage = "Polyline : " & oEntity.Length
            
        Case "AcDb3dPolyline"
            strMessage = "Polyline 3D : " & oEntity.Length
        
        Case Else
            strMessage = "Error ! The selected entity is not a line, an arc, a circle or a polyline."
    End Select
    

Exit_LengthCurves:
    ThisDrawing.Utility.Prompt strMessage
    Set oEntity = Nothing
    Exit Sub
    
Err_LengthCurves:
    If Err.Number <> -2147352567 Then
        strMessage = "Error : " & Err.Description
    End If
    GoTo Exit_LengthCurves
End Sub

 

Message 5 of 6

Anonymous
Not applicable

Hi,

 

How can I find only curve or arc lenght in polyline that have lines and arcs?

 

I try to find lenght with polyline.coordinates. but polyline incluce arc, I can not find arc lenght.

 

For i = 0 To Sinir - 2 Step 2
            
                xyKoor(0) = PCizgi.Coordinates(i)       'X1
                xyKoor(1) = PCizgi.Coordinates(i + 1)   'Y1
                xyKoor(2) = PCizgi.Coordinates(i + 2)   'X2
                xyKoor(3) = PCizgi.Coordinates(i + 3)   'Y2
                If xyKoor(2) - xyKoor(0) = 0 Then       ' açı hesaplanırken xyKoor(2) - xyKoor(0)=0 ise açı 90 derecesir kodlaması
                    PCizgiAci = PI / 2
                Else
                    PCizgiAci = Atn((xyKoor(3) - xyKoor(1)) / (xyKoor(2) - xyKoor(0))) '* 180 / PI
                End If
                oYaziMesafeY = oYaziMesafe * Cos(PCizgiAci)
                oYaziMesafeX = oYaziMesafe * Sin(PCizgiAci)
                xyKoorMid(0) = (xyKoor(0) + xyKoor(2)) / 2 - oYaziMesafeX
                xyKoorMid(1) = (xyKoor(1) + xyKoor(3)) / 2 + oYaziMesafeY
                
                
                PCizgiUzunluk = 100 * ((xyKoor(0) - xyKoor(2)) ^ 2 + (xyKoor(1) - xyKoor(3)) ^ 2) ^ 0.5
                                
                Set oYazi = ThisDrawing.ModelSpace.AddText("" & Round(PCizgiUzunluk, 0), xyKoorMid, oYaziYuksekligi)
                oYazi.Rotation = PCizgiAci '* PI / 180
                oYazi.Layer = "N-makro-Boy-Parca"
            Next i

2019-03-07_154928.jpg

 

 

0 Likes
Message 6 of 6

Norman_Yuan
Mentor
Mentor

The easiest way to know the length of each segment between 2 vertices in a polyline is to call Explode() method, which would break down the polyline/LWPolyline at its vertices and return a set entities of either AcadLine, or AcadArc. Then you can get the length of each of them. Do not forget to erase them after calling Explode(), when necessary.

 

Norman Yuan

Drive CAD With Code

EESignature