Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
67 lines (49 sloc) 1.92 KB
' DimScaleText.rvb -- July 2007
' 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
' Scales all text objects by the document's dimension scale
Sub DimScaleText
' Dim local variables
Dim arrObjects, strObject, arrPlane, dblScale
' Get document's dimension scale
dblScale = Rhino.DimScale
If dblScale = 1.0 Then
Rhino.Print "Dimension scale set to 1.0."
Exit Sub
End If
' Get ids of all annotation objects
arrObjects = Rhino.ObjectsByType(512)
If Not IsArray(arrObjects) Then
Rhino.Print "No text objects to scale."
Exit Sub
End If
' Turn off viewport redrawing (faster)
Rhino.EnableRedraw vbFalse
' Save current view's construction plane
arrPlane = Rhino.ViewCPlane(Rhino.CurrentView)
' Process each object
For Each strObject In arrObjects
' Verify object is a text object
If Rhino.IsText(strObject) And Rhino.IsObjectSelectable(strObject) Then
' Set the current view's construction plane to plane
' that defines the position and orientatio of the text
Rhino.ViewCPlane Rhino.CurrentView, Rhino.TextObjectPlane(strObject)
' Select the object
Rhino.SelectObject strObject
' Scale the object by the dimension scale
Rhino.Command "_-Scale 0,0,0 " & CStr(dblScale), False
' Unselect the object
Rhino.UnselectObject strObject
End If
' Restore current view's construction plane
Rhino.ViewCPlane Rhino.CurrentView, arrPlane
' Turn on viewport drawing
Rhino.EnableRedraw vbTrue
End Sub