Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

83 lines (64 sloc) 2.395 kb
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ConvertTextToGeometry.rvb -- September 2008
' 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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Convert text objects to geometry
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ConvertTextToGeometry
' Declare local variables
Dim obj_list, obj, saved_plane, cmd
Dim font, height, plane, style, text, bold, italic
' Select annotation objects
obj_list = Rhino.GetObjects("Select text to convert to geometry", 512, True, True)
If Not IsArray(obj_list) Then Exit Sub
' For speed, turn of screen redrawing
Call Rhino.EnableRedraw(False)
' Save the current construction plane
saved_plane = Rhino.ViewCPlane()
' Process each selected object
For Each obj In obj_list
' Weed out just the text objects
If Rhino.IsText(obj) Then
' Acquire the text parameters
font = Rhino.TextObjectFont(obj)
height = Rhino.TextObjectHeight(obj)
plane = Rhino.TextObjectPlane(obj)
style = Rhino.TextObjectStyle(obj)
text = Rhino.TextObjectText(obj)
If (style And 1) Then
bold = "_Yes"
Else
bold = "_No"
End If
If (style And 2) Then
italic = "_Yes"
Else
italic = "_No"
End If
' Set the current construction plane
Call Rhino.ViewCPlane(, plane)
' Add a new text object (geometry)
cmd = "_-TextObject "
cmd = cmd & "_GroupOutput=_Yes "
cmd = cmd & "_FontName=" & font & " "
cmd = cmd & "_Italic=" & italic & " "
cmd = cmd & "_Bold=" & bold & " "
cmd = cmd & "_Height=" & CStr(height) & " "
cmd = cmd & "_Output=_Curves "
cmd = cmd & "_AllowOpenCurves=_Yes "
cmd = cmd & Chr(34) & text & Chr(34) & " "
cmd = cmd & "0"
Call Rhino.Command(cmd, 0)
' Delete the original object
Call Rhino.DeleteObject(obj)
End If
Next
' Restore the saved construction plane
Call Rhino.ViewCPlane(, saved_plane)
' Enable screen redrawing
Call Rhino.EnableRedraw(True)
End Sub
Jump to Line
Something went wrong with that request. Please try again.