Message 1 of 6
Draw All Linetypes

Not applicable
07-01-2004
10:03 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I wrote this little sub in an effort to straighten out the linetypes we're
using and thought it may be useful to someone else.
If not, please ignore.
Sub DrawEachLType()
Dim vPnt As Variant, vFPt(2) As Double, vTPt(2) As Double
Dim oLTyps As AcadLineTypes, oLTyp As AcadLineType
Dim oLin As AcadLine, oTxt As AcadText
vPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "From point: ")
vFPt(0) = vPnt(0): vFPt(1) = vPnt(1): vFPt(2) = 0#
vTPt(0) = vPnt(0) + 5#: vTPt(1) = vPnt(1): vTPt(2) = 0#
Set oLTyps = ThisDrawing.Linetypes
For Each oLTyp In oLTyps
vFPt(1) = vFPt(1) + 0.25
vTPt(1) = vTPt(1) + 0.25
Set oLin = ThisDrawing.ModelSpace.AddLine(vFPt, vTPt)
oLin.Linetype = oLTyp.Name
oLin.Update: Set oLin = Nothing
Set oTxt = ThisDrawing.ModelSpace.AddText(" " & oLTyp.Name, vTPt, 0.1)
oTxt.Alignment = acAlignmentMiddleLeft: oTxt.TextAlignmentPoint = vTPt
oTxt.Update: Set oTxt = Nothing
Next oLTyp
Set oLTyps = Nothing
End Sub