---

Servus
nachdem ich endlich mit meinem VBA Tool und ACAD 2007 weitergekommen bin, gibt es einen herben Rückschlag. Es gibt User mit ACAD 2002 :-(

So einfach mit ACAD 2007 und dem Polylinien Objekt , .lenght so ratlos stehe ich nun.
Wie erhalte ich die Länge von der Plinie? Ich hatte es zuerst mit Objekt.lenght die Länge ermittelt.

mit ACAD 2002 habe ich es nur nur ACAD Line entdeckt :-(

Hat da jemad einen Rat?
Danke
Tom

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

so, habe dieses Gefunden und scheint zu gehen. Blicke da noch nicht durch und muss dieses weiter testen. Vielleicht kennt es ja jemand schon. Bin gespannt, was noch alles in 2002 nicht funktioniert :-(

Code:

---

Public Function PlineLenEX(objPline As AcadLWPolyline) As Double
Dim intVCnt As Integer
Dim varCords As Variant
Dim varVert As Variant
Dim varCord As Variant
Dim varNext As Variant
Dim intCrdCnt As Integer
Dim dblTemp As Double
Dim dblArc As Double
Dim dblAng As Double
Dim dblChord As Double
Dim dblInclAng As Double
Dim dblRad As Double
varCords = objPline.Coordinates
For Each varVert In varCords
intVCnt = intVCnt + 1
Next
For intCrdCnt = 0 To intVCnt / 2 - 1
If intCrdCnt < intVCnt / 2 - 1 Then
If objPline.GetBulge(intCrdCnt) = 0 Then
varCord = objPline.Coordinate(intCrdCnt)
varNext = objPline.Coordinate(intCrdCnt + 1)
'computes a simple Pythagorean length
dblTemp = dblTemp + Sqr((Sqr(((varCord(0) - varNext(0)) ^ 2) + _
((varCord(1) - varNext(1)) ^ 2)) ^ 2))
Else
'If there is a bulge we need to get an arc length
varCord = objPline.Coordinate(intCrdCnt)
varNext = objPline.Coordinate(intCrdCnt + 1)
dblChord = Sqr((Sqr(((varCord(0) - varNext(0)) ^ 2) + _
((varCord(1) - varNext(1)) ^ 2)) ^ 2))
'Bulge is the tangent of 1/4 of the included angle between
'vertices. So we reverse the process to get the included angle
dblInclAng = Atn(Abs(objPline.GetBulge(intCrdCnt))) * 4
dblAng = (dblInclAng / 2) - ((Atn(1) * 4) / 2)
dblRad = (dblChord / 2) / (Cos(dblAng))
dblArc = dblInclAng * dblRad
dblTemp = dblTemp + dblArc
End If
End If
Next
PlineLenEX = dblTemp
End Function

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP