TheSwamp
Code Red => VB(A) => Topic started by: robplatt on March 18, 2007, 01:02:35 AM
-
Hi,
I think this is mainly a maths problem, but I'm posting it here because I need a VBA solution.
One property of a Polyline is .GetBulge, which is used to describe an arc segment. The online manual describes .GetBulge as being equal to: "...the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline's vertex list..."
I need to establish the radius and centerpoint of the arc segment from this information. I thought my trig. was reasonable, but I've tried everything I can think of and just can't see how to do it.
DXF codes are no help because they also only list the bulge factor.
It is obviously possible because if I "list" the polyline up comes all the information I need.
Any help in translating this will be very gratefully received.
Thanks.
-
A better description of a bulge is the tangent of the arc's rise/1/2 the segment length
Function RadiusFromBulge(Bulge As Double, pt1, pt2) As Double
Dim Dist As Double, Rad As Double
Dist = 0.5 * Length(pt1, pt2)
RadiusFromBulge = Abs(Dist / Sin(Atn(Bulge) * 2))
End Function
Public Function CenterFromBulge(P1, P2, Bulge As Double)
If UBound(P1) = 1 Then
ReDim Preserve P1(2)
End If
If UBound(P2) = 1 Then
ReDim Preserve P2(2)
End If
Dim Ang As Double, CenPt(2) As Double
Dim Rad As Double, Dist As Double
Dist = Length(P1, P2) 'Use your length function
Rad = Abs(0.5 * Dist / Sin(Atn(Bulge) * 2))
Ang = ThisDrawing.Utility.AngleFromXAxis(P1, P2)
If Bulge > 0 Then
Ang = Ang + ((0.5 * pi) - (Atn(Bulge) * 2))
Else
Ang = Ang - ((0.5 * pi) + (Atn(Bulge) * 2))
End If
CenPt(0) = P1(0) + Cos(Ang) * Rad
CenPt(1) = P1(1) + Sin(Ang) * Rad
CenPt(2) = 0
CenterFromBulge = CenPt
End Function
This looks long winded but it's optimised for x,y points(pline coordinates) or x,y,z points
Kerry asked the question "Is it better to multiply or use ^2.
It goes faster using multiplication.
Public Function Length(StartPoint As Variant, EndPoint As Variant) As Double
Dim Stx As Double, Sty As Double, Stz As Double
Dim Enx As Double, Eny As Double, Enz As Double
Dim dX As Double, dY As Double, Dz As Double
Dim i As Integer
If IsEmpty(StartPoint) Then Err.Raise 13
i = UBound(StartPoint)
If UBound(EndPoint) = i Then
If i > 0 Then
Stx = StartPoint(0): Sty = StartPoint(1)
Enx = EndPoint(0): Eny = EndPoint(1)
dX = Stx - Enx
dY = Sty - Eny
If i = 1 Then
Length = Sqr(dX * dX + dY * dY)
Else
Stz = StartPoint(2): Enz = EndPoint(2)
Dz = Stz - Enz
Length = Sqr((dX * dX) + (dY * dY) + (Dz * Dz))
End If
Else
Exit Function
End If
Else
Exit Function
End If
End Function
-
Better code above while typing...
-
Thanks Bryco, suddenly life seems a whole lot brighter!
-
Nice. These are useful functions.
CenPt(0) = P1(0) + Cos(Ang) * Rad
CenPt(1) = P1(1) + Sin(Ang) * Rad
CenPt(2) = 0
CenterFromBulge = CenPt
End Function
They appear optimized for WCS. Is the notion that translation to and from OCS is the responsibility of a separate routine?
-
Good point, it needs to be rewritten for 3d
-
3d version
Public Function CenterFromBulge(oPline As AcadLWPolyline, index As Integer) As Variant
If oPline Is Nothing Then Exit Function
If (UBound(oPline.Coordinates) - 1) / 2 < index + 1 Then Exit Function
Dim P1, P2
Dim Ang As Double, BulgeAng As Double
Dim CenPt(2) As Double
Dim Rad As Double, Dist As Double
Dim Bulge As Double
P1 = oPline.Coordinate(index)
P2 = oPline.Coordinate(index + 1)
Bulge = oPline.GetBulge(index)
If Bulge = 0 Or Bulge = 1 Or Bulge = -1 Then
CenPt(0) = (P1(0) + P2(0)) / 2
CenPt(1) = (P1(1) + P2(1)) / 2
GoTo Skip
End If
BulgeAng = Atn(Bulge) * 2
Dist = Length(P1, P2) 'Use your length function
Rad = Abs(0.5 * Dist / Sin(BulgeAng))
Ang = AngFromX(P1, P2)
Debug.Print Ang, BulgeAng, (0.5 * pi) - (pi - BulgeAng)
Debug.Print 0.5 * pi, pi - Abs(BulgeAng)
If Bulge > 0 Then
If Bulge > 1 Then
Ang = Ang - ((0.5 * pi) - (pi - BulgeAng))
Else
Ang = Ang + ((0.5 * pi) - BulgeAng)
End If
Else
If Bulge < -1 Then
Ang = Ang + ((0.5 * pi) - (pi + BulgeAng))
Else
Ang = Ang - ((0.5 * pi) + BulgeAng) 'bulgeang is negative
End If
End If
CenPt(0) = P1(0) + Cos(Ang) * Rad
CenPt(1) = P1(1) + Sin(Ang) * Rad
Skip:
CenPt(2) = oPline.Elevation
CenterFromBulge = ThisDrawing.Utility.TranslateCoordinates(CenPt, acOCS, acWorld, 0, oPline.Normal)
End Function
Function
Public Function AngFromX(P1, P2) As Double
'If Not PointCheck(p1, p2) Then Exit Function
Dim dX As Double, dY As Double
Dim dAng As Double
dY = P2(1) - P1(1): dX = P2(0) - P1(0)
If Rd(dY, 0) Then 'Line is horizontal
If Rd(dX, 0) Then Exit Function
If dX > 0 Then
dAng = 0
Else
dAng = pi '180
End If
ElseIf Rd(dX, 0) Then 'Line is vertical
If dY > 0 Then
dAng = 0.5 * pi '90
Else
dAng = 1.5 * pi '270
End If
Else
dAng = Atn(dY / dX)
If dAng < 0 Then '90->270
If dX < 0 Then '90->270
dAng = pi + dAng '90->180
Else '270->360
dAng = 2 * pi + dAng
End If
Else
If dX < 0 And dY < 0 Then '180->270
dAng = pi + dAng
End If
End If
End If
AngFromX = dAng
End Function
Function Rd(num1 As Variant, num2 As Variant) As Boolean
Dim dRet As Double
dRet = num1 - num2
If Abs(dRet) < 0.00000001 Then Rd = True
End Function
-
This 3D update works nicely and will be even more useful.
On quick note, this updated code includes a Constant - PI - and a function - Rd() - not present. It's not a big deal but may discourage others from using the code.
-
Fixed.
I've almost given up posting code having to include the the same functions time and time again.
-
I'm familiar with the effort required for a successful "Pack 'n Go" of a routine from local DVB to forum post (i.e., http://discussion.autodesk.com/thread.jspa?messageID=17866) Actually, that example post had issues that needed to be addressed.
What is the best method to minimize the effort? Would the posting of, and subsequent reference to, a library file (SEANTLib.bas) to the Lilly Pond be the recommended?
-
That sounds pretty good.
I get sick of making a new project just to check.
It is probably possible to debug.print all the functions used in a sub.