Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
88 lines (72 sloc) 2.39 KB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ModifyTangentRadius.rvb -- January 2009
' If this code works, it was written by Dale Fugier.
' If not, I don't know who wrote it.
' Works with Rhino 4.0.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ModifyTangentRadius
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ModifyTangentRadius
' Declare variables
Dim old_arc, old_pt, old_rad
Dim new_arc, new_pt, new_rad
Dim cen, line, ccx
Dim old_os, old_mode
Dim bArc
' Get the arc/circle to modify
old_arc = Rhino.GetObject("Select arc or circle to modify", 4)
If IsNull(old_arc) Then Exit Sub
If Rhino.IsArc(old_arc) Then
bArc = True
ElseIf Rhino.IsCircle(old_arc) Then
bArc = False
Else
Rhino.Print("Curve is neither an arc nor a circle.")
Exit Sub
End If
' Get the tangent point
old_os = Rhino.Osnap(True)
old_mode = Rhino.OsnapMode(64)
old_pt = Rhino.GetPointOnCurve(old_arc, "Tangent location")
Call Rhino.Osnap(old_os)
Call Rhino.OsnapMode(old_mode)
If IsNull(old_pt) Then Exit Sub
' Get the new arc radius
If (bArc = True) Then
old_rad = Rhino.ArcRadius(old_arc)
Else
old_rad = Rhino.CircleRadius(old_arc)
End If
new_rad = Rhino.GetReal("New radius", old_rad)
If IsNull(new_rad) Then Exit Sub
If (new_rad = old_rad) Then Exit Sub
If (new_rad < 0.0) Then Exit Sub
Call Rhino.EnableRedraw(False)
' Add the new arc/circle
If (bArc = True) Then
new_arc = Rhino.AddArc(Rhino.CurvePlane(old_arc), new_rad, Rhino.ArcAngle(old_arc))
Else
new_arc = Rhino.AddCircle(Rhino.CurvePlane(old_arc), new_rad)
End If
Call Rhino.MatchObjectAttributes(new_arc, old_arc)
' Move the new arc to the tangent point
If (bArc = True) Then
cen = Rhino.ArcCenterPoint(old_arc)
Else
cen = Rhino.CircleCenterPoint(old_arc)
End If
If (new_rad > old_rad) Then
new_pt = Rhino.PointAdd(old_pt, Rhino.VectorCreate(old_pt, cen))
Else
new_pt = old_pt
End If
line = Rhino.AddLine(cen, new_pt)
ccx = Rhino.CurveCurveIntersection(new_arc, line)
Call Rhino.MoveObject(new_arc, ccx(0,1), old_pt)
' Clean up
Call DeleteObject(old_arc)
Call DeleteObject(line)
Call Rhino.EnableRedraw(True)
End Sub