Thursday, February 03, 2005

I hate CAD standards. Part 2

Platform: AutoCAD 2004
Download: IHateCADStandards.zip

Continuing from Part 1, we'll start by setting our units.


Public Function setUnits() As Boolean
' Set base drawing units
On Error GoTo ErrorHandler
' Set system variables
With ThisDrawing
.SetVariable "LUNITS", 2 ' Sets linear units to Decimal
.SetVariable "LUPREC", 3 ' Sets the # of decimal places displayed for all read-only linear units

.SetVariable "AUNITS", 0 ' Sets units for angles to Decimal degrees
.SetVariable "AUPREC", 3 ' Sets the number of decimal places for all read-only angular units

.SetVariable "MEASUREMENT", 0 'Sets units as imperial or metric for the current drawing only

.SetVariable "ANGDIR", 0 'Sets the direction of positive angles. Set to Counterclockwise

.SetVariable "ANGBASE", 0# ' Sets the base angle to 0 with respect to the current UCS.

.SetVariable "INSUNITS", 1 ' Specifies units for drag & dropped blocks or images. Set to Inches
End With

setUnits = True

Exit Function
ErrorHandler:
' Insert error handler here
End Function



No real magic here, we're just setting a few system variables. Call the above routine with the following line:


If Not setUnits Then GoTo ErrorHandler



Now we can focus on layer modification. Layers can get a bit tricky so we have to be careful what we do. I found out the hard way that you can set a layer's colour to black and it will be invisible if your workspace background is black. Note to self: make a routine that loops through all layers and sets their colours to black to annoy coworkers. We'll also create a few helper routines to set a layer current, check if a layer already exists and if it is locked.


Public Function CreateLayer(strLay As String, _
strLineType As String, _
Optional setColor As Boolean = False, _
Optional lngRed As Long, _
Optional lngGreen As Long, _
Optional lngBlue As Long, _
Optional lyrLineWeight As ACAD_LWEIGHT = acLnWtByLayer, _
Optional booPlottable As Boolean = True, _
Optional booLock As Boolean = False, _
Optional booFreeze As Boolean = False, _
Optional booLayerOn As Boolean = True) As Boolean
On Error GoTo ErrorHandler
Dim newLayer As AcadLayer
Dim objLineType As AcadLineType
Dim objColor As AcadAcCmColor
Dim booFound As Boolean

Set newLayer = ThisDrawing.Layers.Add(strLay)

With newLayer
If setColor Then
Set objColor = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")

If (lngRed = 0 And lngGreen = 0 And lngBlue = 0) Or _
(lngRed = 255 And lngGreen = 255 And lngBlue = 255) Then
objColor.ColorIndex = acWhite
Else
Call objColor.SetRGB(lngRed, lngGreen, lngBlue)
End If

.TrueColor = objColor
End If

.Lineweight = lyrLineWeight
.Plottable = booPlottable
.Lock = booLock
If Not StrComp(ThisDrawing.ActiveLayer.Name, strLay, vbTextCompare) = 0 Then .Freeze = booFreeze
.LayerOn = booLayerOn

For Each objLineType In ThisDrawing.Linetypes
If StrComp(objLineType.Name, strLineType, vbTextCompare) = 0 Then
booFound = True
Exit For
End If
Next

If Not booFound Then ThisDrawing.Linetypes.Load strLineType, "acadiso.lin"

.Linetype = strLineType
End With

Set newLayer = Nothing
Set objLineType = Nothing
If setColor Then Set objColor = Nothing

CreateLayer = True

Exit Function
ErrorHandler:
Set newLayer = Nothing
Set objLineType = Nothing
If setColor Then Set objColor = Nothing
End Function



It seems more complicated than it should be (and it might be) but it works well. If you only use the base 16 or 255 colours, you can rip out the entire "setColor" section and just pass the routine a colour code. Call the above routine with the following line:


If Not CreateLayer("Building-Columns", _
"Continuous", _
True, _
255, 191, 0, _
acLnWtByLwDefault, _
True, False, False, True) Then GoTo ErrorHandler

If Not CreateLayer("Building", _
"Continuous", _
True, _
204, 51, 0, _
acLnWtByLwDefault, _
True, False, False, True) Then GoTo ErrorHandler

If Not CreateLayer("Building-Columns", _
"Continuous", _
True, _
255, 191, 0, _
acLnWtByLwDefault, _
True, False, False, True) Then GoTo ErrorHandler

If Not CreateLayer("Building-Column-Lines", _
"Continuous", _
True, _
102, 204, 0, _
acLnWtByLwDefault, _
True, False, False, True) Then GoTo ErrorHandler

If Not CreateLayer("Building-Drains", _
"Continuous", _
True, _
132, 132, 132, _
acLnWtByLwDefault, _
True, False, False, True) Then GoTo ErrorHandler



Be sure to use the helper routines I mentioned earlier whenever you need to create or modify a layer.


Public Function LayerExists(strLay As String) As Boolean
On Error GoTo ErrorHandler
Dim oLayers As AcadLayers
Dim oLayer As AcadLayer

Set oLayers = ThisDrawing.Layers

For Each oLayer In oLayers
If StrComp(oLayer.Name, strLay, vbTextCompare) = 0 Then
LayerExists = True
Exit For
End If
Next

Set oLayers = Nothing
Set oLayer = Nothing

Exit Function
ErrorHandler:
Set oLayers = Nothing
Set oLayer = Nothing
End Function

Public Function LayerLocked(strLay As String) As Boolean
On Error GoTo ErrorHandler
Dim oLayers As AcadLayers
Dim oLayer As AcadLayer

Set oLayers = ThisDrawing.Layers

For Each oLayer In oLayers
If StrComp(oLayer.Name, strLay, vbTextCompare) = 0 Then
If oLayer.Lock = True Then LayerLocked = True
Exit For
End If
Next

Set oLayers = Nothing
Set oLayer = Nothing

Exit Function
ErrorHandler:
Set oLayers = Nothing
Set oLayer = Nothing
End Function



One final pitfall to watch out for, don't try to lock or delete the current layer.

Comments:
No need to iterate thru the layer collection in your helper functions. Just attempt to set a reference to the layer you are checking for and then check for an error

Public Function LayerExists(strLay As String) As Boolean
Dim oLayer As AcadLayer
On Error Resume Next
Set oLayer = ThisDrawing.Layers.Item(strLay)
If Err <> 0 Then
LayerExists = False
Else
LayerExists = True
End If
End Function
 
I was looking for some AutoCAD training and found this new site for
auto cad 2002 training along with your site. Have you seen this one yet?
 
Post a Comment

<< Home

This page is powered by Blogger. Isn't yours?

vba, acad vba, cad vba, cad, visual basic, visual basic for applications, autocad vba, acad vba, training, vba training, cad training, acad training, autocad training, autocad vba training, bom, bill of material, meta-data, meta data, metadata, property data, data, inventor properties, document management, document, management,technical support resource for users of Autodesk Mechanical CAD Software including Autodesk Inventor & Mechanical Desktop inventor, autodeskinventor, inventor 2, inventor 3, inventor 4, inventor 5, inventor 6, inventor7, inventor 8, inventor 9, inventor 10, autodesk inventor, autodesk inventor2, autodesk inventor 3, autodesk inventor 4, autodesk inventor 5, autodeskinventor 6, autodesk inventor 7, autodesk inventor 8, autodesk inventor9, autodesk inventor 10, inventor r, inventor r2, inventor r3, inventor r4, inventor r5, inventor r6, inventor r7, inventor r8, inventor r9, inventorr10, autodesk inventor, autodesk inventor r2, autodesk inventor r3, autodeskinventor r4, autodesk inventor r5, autodesk inventor r6, autodesk inventorr7, autodesk inventor r8, autodesk inventor r9, autodesk inventor r10,inventor series, autodesk inventor series, inventor series 5, inventorseries R5, autodesk inventor series 5, autodesk inventor series r5, inventorseries 6, inventor series R6, autodesk inventor series 6, autodesk inventorseries r6, inventor autodesk, autodesk inventor download, autodesk inventortutorial, autodesk inventor help, autodesk inventor faq, autodesk inventortips, autodesk inventor routines, autodesk inventor support, autodesk inventor, inventor download, inventor tutorial, inventor help, inventorfaq, inventor tips, inventor routines, inventor support, inventor, inventor help line, help for inventor, inventortraining, autodesk inventor training, mdt, mdt 4, mdt 5,mdt 6, mdt 7, mdt 8, mdt4, mdt5, mdt6, mdt7, mdt8, mdt 2000, mdt 2002,mdt r4, mdt r5, mdt r6, mdt r2000, mdt r2002, mechanical desktop, mechanicaldesktop 4, mechanical desktop 5, mechanical desktop 6, mechanical desktop7, mechanical desktop 2000, mechanical desktop 2002, autodesk, autodesk auto cad, autodesk inc,training, education, auto cad support, autocad support, mcad, autocad mechanical,mechanical, autocad mechanical 6, autocad mechanical 7, autocad mechanical8, autocad mechanical 9, autocad mechanical r6, autocad mechanical r7,autocad mechanical r8, autocad mechanical r9, support, help, tips, routines, reseller, mech, cad, acad, technical, ontario, canada, f.a.q.,faq, answers, resource, barrie, autolisp, auto lisp, autocad, auto cad, autocad desktop, auto cad desktop, autocad inventor, auto cadinventor, powerpack, MAI, desktop, cad software, autocad lt, auto cad lt,cad cam, cad design, cad job, job cad, autocad lisp, auto cad lisp, 3dcad software, 3d cad, free, free cad software, service pack, render, system, computer, aided, drafting, design, manufacturing, modeling, solidmodeling, solid modelling