PDA

View Full Version : AutoCAD layers setup using VBA



masoud
03-21-2006, 04:21 PM
Hi all,
I am new to this forum and to VBA, though i have used AutoCAD for long time. Using VBA i managed to make A new layer, in the process it also checks if layer already exists.
how can i alter this code to make more than one layer (set of floor plan layers or ceiling plan layer) at the same time checking if layers already exist. is there a way to read layer name, color and line type from a database? or is there an easier way. all help is appreciated. thank you

my code for making new layer


Public Sub AddLayer()
Dim strLayerName As String
Dim objLayer As AcadLayer
strLayerName = InputBox("Name of Layer to add: ")
If "" = strLayerName Then Exit Sub ' exit if no name entered
On Error Resume Next ' handle exceptions inline
'check to see if layer already exists
Set objLayer = ThisDrawing.Layers(strLayerName)
If objLayer Is Nothing Then
Set objLayer = ThisDrawing.Layers.Add(strLayerName)
If objLayer Is Nothing Then ' check if obj has been set
MsgBox "Unable to Add '" & strLayerName & "'"
Else
MsgBox "Added Layer '" & objLayer.Name & "'"
End If
Else
MsgBox "Layer already existed"
End If
End Sub

EDIT: I added the VBA tags - Tommy

Tommy
03-21-2006, 05:33 PM
Hi masoud, :hi:

Welcome to VBAexpress :thumb

IMHO the way you are doing this can be done from the menu, easier, but the code you have will work. The code I have posted below is used for setting up a drawing the way I want it, from scratch. I just like to know what I start with each time.:yes
It adds layers, or changes the layers if they already exist. It sets the linetype, color, and lineweight.


Sub SetLayerAndLineType()
LoadLineType
GenLayers "Primary"
GenLayers "Dimension", , acGreen, acLnWt000
GenLayers "Label", , acMagenta, acLnWt005
GenLayers "Text", , acBlue, acLnWt005
GenLayers "Center", "Center", acRed, acLnWt005
GenLayers "Hidden", "Hidden", acYellow, acLnWt005
GenLayers "Steel", , acRed, acLnWt009
End Sub
Public Sub LoadLineType()
'turn on error checking
'if the linetype is not there needs to loaded by hand to find
On Error Resume Next
ThisDrawing.Linetypes.Load "CENTER", "ACAD.LIN"
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "PHANTOM", "ACAD.LIN"
Err.Clear
On Error GoTo 0
End Sub
Public Sub GenLayers(iLyrNm As String, Optional iLnTyp = _
"Continuous", Optional iClr = acBlue, Optional iLnWght _
= acLnWt015)
Dim mTmpLyer As AcadLayer
'this sub generates the layers required
'create laer
Set mTmpLyer = MakeALayer(iLyrNm)
'give it a color
mTmpLyer.Color = iClr
' set the linetype
mTmpLyer.Linetype = iLnTyp
' make sure it is on
mTmpLyer.LayerOn = True
'assign a lineweight
mTmpLyer.Lineweight = iLnWght
Set mTmpLyer = Nothing
End Sub
Function MakeALayer(LayerName As String) As AcadLayer
Dim mLyrNm As AcadLayer
On Error Resume Next
Set mLyrNm = ThisDrawing.Layers.Add(LayerName)
If Err.Number <> 0 Then
'if for some strange reason the layer exist - return it
Set mLyrNm = ThisDrawing.Layers(LayerName)
End If
Err.Clear
On Error GoTo 0
Set MakeALayer = mLyrNm
Set mLyrNm = Nothing
End Function


If you have any more questions don't hesitate to ask :)

lucas
03-22-2006, 08:33 AM
I like it Tommy, is it possible to modify your dim style too?

Tommy
03-22-2006, 09:03 AM
Hey Steve :hi:

Yes but all a dimension style does is reset the active dimensioning variables. They are called document overides in the help file, FWIW. I don't have anything here to help you with because "they" draw dimensions on a line by line basis :wot . You could set a sub to run to setup defaults for dimensioning as in:

Sub SetDimStuff()
ThisDrawing.SetVariable "DIMSCALE", 96
ThisDrawing.SetVariable "DIMASZ", 0.0625
ThisDrawing.SetVariable "DIMBLK", "ArchTick"
ThisDrawing.SetVariable "DIMTXT", 0.125
ThisDrawing.SetVariable "LTSCALE", (96 / 2)
End Sub

Which sets the scale of the drawing to 1/8"=1'-0 Arrow size to 1/16" use a tick instead of an arrow and the text height is 1/8". These are "plotted" sizes BTW, for the actual drawing everything in the dims are multiplied by the dimscale facter to make it look right. Which means the text height in the drawing is 12". Have I confused you yet? :devil2: :rofl:

lucas
03-22-2006, 09:11 AM
Yes a little, I don't understand the relationship between plotted sizes and the text height in the drawing? :confused4

masoud
03-22-2006, 10:56 AM
Thank you so much Tommy, this is exactly what i was looking for, now to take this a step further i can make custom menu so that from menu i can call what kind of layers i want to make (menu name: DWG Setup, menu items: floor,ceiling,site,structural) this would popup a list box and by puting your code under "Case" selection each time i can make the proper layers.
is this a correct train of thought?

Tommy
03-22-2006, 11:33 AM
Yes your train of thought IMHO is correct.

I have a lisp file that sets all my drawing parameters, Layers, colors, linetypes, page size, title block, border, text size, and scale. The selections are displayed in a dialog box. When I first wrote it it was a menu and people didn't like it, put it in a dialog box and they wondered how they ever did without it LOL, same information, same picks go figure.

masoud
03-22-2006, 03:35 PM
Dialog boxes are more intuitive i guess!! I'll try to code my version of the same scenario and i'll make sure to post it for your comments. thank you.

Tommy
03-22-2006, 06:11 PM
Steve,

The plotted text vs drawing text ex. a beam is 12'-0 long, you are plotting it on 24x36 paper, and of course it will not fit when drawn to a scale of 1:1, so you scale it to 1 1/2" = 1'-0. to make everything look real nice a rule of thumb is set the dimscale to 12 / 1.5 for 1 1/2:12 12/0.125 for 1/8:12 this will make 0.125 * dimscale = 1'-0 for an 1/8" scale drawing. What this means is when you use acad's dim feature the text will be large enough on the printed output to read easy. Sorry the printed text height is normally 0.125". This is not a hard fast rule it is just a rule of thumb, differs from company to company.

masoud,
I was working on a page set-up routine for drawing to scale in model space. It was origanly supposed to be for plot configurations, but I will be changing it to a page set-up, want to compare? :) Could be fun :)

lucas
03-22-2006, 08:25 PM
Yes, I understand now. I knew that but wasn't following you earlier. I'll be following this thread.

masoud
03-23-2006, 08:55 AM
Tommy,
that would be awsome, this weekend i'll do my best to wrap up the code and then we cn compare. thanks!

Tommy
03-25-2006, 12:08 PM
Here ya go let me know what you think.

lucas
03-25-2006, 01:39 PM
Tommy this is really cool. I get a subscript out of range if my scale is too big for my drawing size which is to be expected. I can't get it to set the drawing units to architectural, always defaults to decimal no matter which radio button I select.

My personal preference would be not to have it draw dim line between extension lines.

I'll be looking to see if I can make the necessary changes but I really like it. masaud has his work cut out for him.

Tommy
03-26-2006, 07:33 AM
Hey Steve,
THis will fix the subscript out of range. I am using 2000i so I can't fix the units thing unless you want to step through it cut and paste the text and send the file :)

Public Function MakeItFit&(ilen$)
'MakeItFit = Int(iLen / 29)
'this will only work for imperial dimensions
Dim b() As String
Dim c() As String
b = Split(LBreakIt(ilen, "="), "/")
If InStr(1, b(0), " ") = 0 Then
If UBound(b) = 0 Then
MakeItFit = 12 / Val(b(0))
Else
MakeItFit = 12 / (Val(b(0)) / Val(b(1)))
End If
Else
c = Split(b(0), " ")
MakeItFit = 12 / (Val(c(0)) + Val(c(1)) / Val(b(1)))
End If
End Function

Tommy
03-26-2006, 08:48 AM
LOL I used some dimension var from doing sheeting and trim for acad 10. Here are the ones for 2000i steel, at least the way I do it.:devil2:

lucas
03-26-2006, 12:03 PM
Has anyone patted you on the back lately? This is fantastico
The last one you posted does everything I want it to do Tommy. Thanks for sharing it. You should submit it to the kb.