TheSwamp
Code Red => VB(A) => Topic started by: David Hall on July 12, 2005, 03:07:07 PM
-
Ok, Lets load some layers. Any idea how to load 2 layers, not worrying about color and linetype just yet? I'll start us off with
Public Sub LLayer()
End Sub
Its going to use the ThisDrawing methods again, so lets see what people come up with.
Extra Credit:Create a function that checks to see if the Layer exists, therefore not re-creating it. This will be important when we begin assiging color and linetypes to layers.
-
Layer names should be 'Yellow' and 'White' for now.
-
For now ...
Public Sub LLayer()
Dim Ylayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Yellow")
Dim Wlayer As AcadLayer
Set Wlayer = ThisDrawing.Layers.Add("White")
End Sub
-
Excellent, now how about assigning the respective colors to the layers. Any ideas?
-
I am interested in what you think should be done to assign the colors. If you try something, post what you tried. Even if it doesn't work, post it so others can see what has been tried.
-
Just a note: Anytime you use 'Set' you should set it to Nothing at the end of the sub.
-
Anytime you use 'Set' you should set it to Nothing at the end of the sub.
Tim makes an excellent point, so lets add that
Public Sub LLayer()
Dim Ylayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Yellow")
Set Ylayer = Nothing
Dim Wlayer As AcadLayer
Set Wlayer = ThisDrawing.Layers.Add("White")
Set Wlayer = Nothing
End Sub
-
IMHO you should have an On Error Goto ErrorH statment and that should set everything to nothing. That way regardless of the situation the sub cleans itself.
-
Im thinking Tim means something like this
Public Sub LLayer()
On Error GoTo Error_Handler
Dim Ylayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Yellow")
Set Ylayer = Nothing
Dim Wlayer As AcadLayer
Set Wlayer = ThisDrawing.Layers.Add("White")
Set Wlayer = Nothing
Exit Sub
Error_Handler:
Err.Clear
Set Wlayer = Nothing
Set Ylayer = Nothing
End Sub
Now we still need to change the colors of those newly created layers. Any ideas?
-
I'm messing with this:
Public Sub LLayer()
On Error GoTo Error_Handler
Dim Ylayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Yellow")
Dim Ycolor As ACAD_COLOR
Set Object.Ycolor = ThisDrawing.Layers.TrueColor("Yellow")
Set Ylayer = Nothing
Dim Wlayer As AcadLayer
Set Wlayer = ThisDrawing.Layers.Add("White")
Set Object.Wcolor = ThisDrawing.Layers.TrueColor("White")
Set Wlayer = Nothing
Exit Sub
Error_Handler:
Err.Clear
Set Wlayer = Nothing
Set Ylayer = Nothing
End Sub
But it ain't working. <shooting blanks in the dark here, Huh?>
-
Birdy, How about something like this ??
Remember, you can Use the Locals window to see variable values when Stepping through <F8> code.
ps: I'm not a VB'er, so this may not be 100%
Option Explicit
'
' Test Routine for Demo Only.
'
Public Sub CLLayer()
On Error GoTo CLLayer_Error
Dim Ylayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Yellow")
Dim ColorProperty As Integer
ColorProperty = acYellow
Ylayer.color = ColorProperty
' Could have used :
' Ylayer.color = acYellow
' to save the declaration and assignment
'
' Next Option
'
Dim Glayer As AcadLayer
Dim TrueColor As New AcadAcCmColor
Call TrueColor.SetRGB(0, 255, 0)
Set Glayer = ThisDrawing.Layers.Add("Green")
Glayer.TrueColor = TrueColor
'
'
' Next Option
'
Dim Newlayer As AcadLayer
Set Newlayer = ThisDrawing.Layers.Add("FourtyOne")
Newlayer.color = 41
'
' Added for fun
'
Dim aacColor As AcadAcCmColor
Set aacColor = Newlayer.TrueColor
Dim strColor As String
strColor = "Red = " & aacColor.Red & vbCrLf & _
"Green = " & aacColor.Green & vbCrLf & _
"Blue = " & aacColor.Blue
MsgBox strColor
On Error GoTo 0
GoTo Set_To_Nothing
CLLayer_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure CLLayer of Module TestLayer"
Set_To_Nothing:
Set Glayer = Nothing
Set Ylayer = Nothing
Set Newlayer = Nothing
Set aacColor = Nothing
End Sub
-
Excellent example KWB! This example has multiple ways to color a layer. Did everyone look at the different ways to do this? Most people (Myself included) will probable only think of acad colors as 1-255, but there are other colors you might need.
-
Question - Is everyone familiar with the concept of passing a Sub/Function an Argument? I ask because I want us to reduce the amount of typing that went into our code.
-
^ Need a show of hands to move on.
-
Getting there
-
Question - Is everyone familiar with the concept of passing a Sub/Function an Argument? I ask because I want us to reduce the amount of typing that went into our code.
I am.
-
Please Sir
I am now (I think!)
-
Consider the following snippet:
Public Sub LayerTestExtraTyping()
Dim Ylayer As AcadLayer
Dim Wlayer As AcadLayer
Set Ylayer = ThisDrawing.Layers.Add("Layer1")
Ylayer.color = acYellow
Set Wlayer = ThisDrawing.Layers.Add("Layer2")
Wlayer.color = acGreen
End Sub
If you look close, you see that we typed the exact same thing twice for the creation of 2 layers. We declared 2 objects, we set both objects, and we set the color of the objects. For just 2 layers, you can see the duplicate effort already. What we need is a function/sub that would take a list of arguments (Name, Color, & Linetype) and process the list so we do not have to retype the exact same code over and over. Looking at this snippet, you will see variable names that Im passing in from another sub.
Public Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
OK, so how does this work? Well, we have to CALL the sub and pass the arguments to it. From the help file...
Syntax [Call] name [argumentlist]
You are not required to use the Call keyword when calling a procedure. However, if you use the Call keyword to call a procedure that requires arguments, argumentlist must be enclosed in parentheses. If you omit the Call keyword, you also must omit the parentheses around argumentlist. If you use either Call syntax to call any intrinsic or user-defined function, the function's return value is discarded.
^This will be very important to us in a few minutes.^
ArgumentList - Optional. Comma-delimited list of variables, arrays, or expressions to pass to the procedure. Components of argumentlist may include the keywords ByVal or ByRef to describe how the arguments are treated by the called procedure. However, ByVal and ByRef can be used with Call only when calling a DLL procedure.
ByVal Optional. Indicates that the argument is passed by value.
ByRef Optional. Indicates that the argument is passed by reference. ByRef is the default in Visual Basic.
by value
A way of passing the value of an argument to a procedure instead of passing the address. This allows the procedure to access a copy of the variable. As a result, the variable's actual value can't be changed by the procedure to which it is passed.
by reference
A way of passing the address of an argument to a procedure instead of passing the value. This allows the procedure to access the actual variable. As a result, the variable's actual value can be changed by the procedure to which it is passed. Unless otherwise specified, arguments are passed by reference.
So, we need another sub to call the layer creation sub.
Public Sub test()
Call LLayer("Layer1", acWhite, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
-
I assume that LLayer sub can be called from a separate file, like you can with lisp?
-
yes and no. If its in the same module, it can be called as is (the way I typed it) If its in a different module, you have to call it by its full name (file.module.procedure name)
-
Once everyone gets their heads wrapped around this, we will move on to the next step, Checking to see if the layer exists....
-
^ Need a show of hands to move on.
<out of breath> <raises hand>
gnarly week... gotta play catchup this weekend.
oh, thank you Kerry.
-
yes and no. If its in the same module, it can be called as is (the way I typed it) If its in a different module, you have to call it by its full name (file.module.procedure name)
That's what I was wondering. So, there's nothing like (load "somecode.lsp") for vba? You have to type where it comes from, huh? That could be useful incase you have more than one sub with the same name.
-
..... Got code ready for monday
-
Ok.. starting to add up.
I like this:
Dim ColorProperty As Integer
Ylayer.color = acYellow
Question: acYellow doesn't LOOK like an integer to me. Is that because it is an enumerated value?
From the help file:You can also use Integer variables to represent enumerated values. An enumerated value can contain a finite set of unique whole numbers, each of which has special meaning in the context in which it is used. Enumerated values provide a convenient way to select among a known number of choices, for example, black = 0, white = 1, and so on.
This make sense to me too, and seems rather simple:
Dim Newlayer As AcadLayer
Set Newlayer = ThisDrawing.Layers.Add("FourtyOne")
Newlayer.color = 41
Thanks Kerry
-
Hi Birdy,
acYellow is a Constant actually ..
(http://www.theswamp.org/screens/kerry/acYellow.png)
-
Thanks. That clears it up even more.
-
So, there's nothing like (load "somecode.lsp") for vba?
Guru's correct me, but off the top of my head, I can not think of how to load another DVB from within VBA. (I have never done it, so it may be possible)
I typically write all the code I need for a particular Function/program in one or more modules (depending on what im doing). I do have some utility code I CALL from other modules (Files) but the utility code is already loaded. I just had a thought, I seem to remember a snippet somewhere to UNLOAD a dvb, so there must be a way to load a dvb.
-
Ok ... there is some fact and some fiction in that....
You cannot reference anything that is not part of the project, for example:
-> Project2 code
Project1.MyModule.MyProc()
However .....
Look into the "AddFromFile" method ...you may find it somewhat helpful ...
Or you can use
AcadApplication.LoadDVB
AcadApplication.UnloadDVB
AcadApplication.RunMacro
Each one with it's specific purpose ...
-
I have never used those, but it sounds like I should look into it.
-
Thanks for answering that Keith. I have always found vba to be somewhat limiting in that respect. I guess it has to do with keeping things structured.
-
Everybody ready to move on?
-
I think so.
-
OK, before we do a function for if the layer exists, I wanted to talk about OverLoading. VBA does not Overload like C#, (which is where I got this from), but it does allow us to kinda-not really-sorta-maybe maybe not overload a function. I know that none of that made any sense. Thats OK, humor me. I'm sure someone will correct me, but thats ok too.
Public Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End SubWhat if you knew the name and color, but not the linetype? Name and Linetype, but not color? What happens if you leave out a value that the function is expecting? Where I'm going with this is we could have 3-5 versions of this code to accomplish each version we could think of.
Public Sub LLayer(ByRef Lname As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
Set objLayer = Nothing
Exit Sub
End SubPublic Sub LLayer(ByRef Lname As String, Lcolor As Integer)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
Set objLayer = Nothing
Exit Sub
End SubPublic Sub LLayer(ByRef Lname As String, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End SubPublic Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
-
Does everybody understand the 4 versions I loaded? What if we could do the same thing with ONLY 1 version of the code?
-
The main difference I see (quick glance) is the
Public Sub LLayer(ByRef...)
line. Am I on the right track?
-
Are you saying you need optional arguments or default to what's current?
-
heh David.
must admit my ears pricked up when I saw VBA and overloading in the same sentence
.. for a bit anyway.
-
Here is a bit of code that uses the Keyword Optional.
Private Sub LLayer(ByRef Lname As String, Optional Lcolor As Integer, Optional Ltype As String)
Dim objLayer As AcadLayer
On Error GoTo ErrorHandler
If DoesLayerExist(Lname) = False Then
Set objLayer = ThisDrawing.Layers.Add(Lname)
'SHOW 2 WAYS TO ERROR TRAP THIS
' If Lcolor <> 0 Then
objLayer.color = Lcolor
' End If
' If Ltype <> "" Then
objLayer.Linetype = Ltype
' End If
End If
GoTo Clean_Up
ErrorHandler:
Select Case Err
Case -2145320939:
Err.Clear
MsgBox "Invalid Color call"
Resume Next
Case -2145386493:
Err.Clear
MsgBox "Invalid Linetype call"
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
Clean_Up:
Set objLayer = Nothing
Lcolor = 0
Lname = ""
Ltype = ""
Exit Sub
End Sub
When we CALL this code, we can pass our arguments normally, but now if we do not know one of them or we do not wish to change from the default, we do not have too.
Here is 4 examples of code using the optional argumentsPublic Sub SetupDwgWithLayersAndLinetypes()
LLINE
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2")
Call LLayer("Layer3", acBlue)
Call LLayer("Layer4", , "DASHED")
End Sub
Each of the arguments must be separated by commas (,).
For Layer1, we are using all 3 arguments. Layer2 is just the name. Layer3 uses Name and Color. and Layer4 is Name and Linetype.
Notice in Layer4, we added a comma (,) to show that color was blank.
-
heh David.
must admit my ears pricked up when I saw VBA and overloading in the same sentence
.. for a bit anyway.
Please correct me where I'm wrong. Im hoping you and MickD steer me straight on this. I know the terminology is wrong, but its what I know.
-
btw, I'm trying to combine the layers and linetypes by doing this:
Public Sub LLINE()
On Error GoTo ErrorHandler
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "DASHED", "ACAD.LIN"
Exit Sub
ErrorHandler:
Select Case Err
Case -2145386405:
Err.Clear
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Public Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
Public Sub test()
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
but it seems that I have to alt+f8 two seperate times (that is.. two seperate files?) to get it to work as I'd expect. Am I missing something in how I'm saving and/or loading these? (will re-review the primers this evening, DOH!)
One minute I feel like a dope with this, the next like a bright and shiny light bulb.... and then like a dope again. :oops:
-
btw, I'm trying to combine the layers and linetypes by doing this:
Public Sub LLINE()
On Error GoTo ErrorHandler
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "DASHED", "ACAD.LIN"
Exit Sub
ErrorHandler:
Select Case Err
Case -2145386405:
Err.Clear
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Public Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
Public Sub test()
Call LLine ' Cmdrduh Added this to load Linetypes before creating layers
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
but it seems that I have to alt+f8 two seperate times (that is.. two seperate files?) to get it to work as I'd expect. Am I missing something in how I'm saving and/or loading these? (will re-review the primers this evening, DOH!)
One minute I feel like a dope with this, the next like a bright and shiny light bulb.... and then like a dope again. :oops:
Look at the code for the sub TEST. I added one line to load your linetypes just before you create your layers. You should only have to run Test 1 time to get what you want.
-
:)
-
btw, I'm trying to combine the layers and linetypes by doing this:... ..... .....
One minute I feel like a dope with this, the next like a bright and shiny light bulb.... and then like a dope again. :oops:
You guys are getting this and making good progress, its just that your moving faster than I can type. (Which is not a bad thing) I just hadn't gotten to the part where we create 1 function to do all the code. I was creating small modules to teach the concept, and we would put them all together later.
-
Overloading is the correct term David.
essentially having multiple method definitions, with the same name, but each with its own unique signature < Type and order of parameters >
C# does not support optional method arguments.
-
Are you saying you need optional arguments or default to what's current?
Please re-phrase that, as I dont quite get it.
Im saying that if you wanted name and color, you could do 1 of 2 things:
1- code 4 version for each possibility: name color/ name linetype/ name color linetype/ name only
or 2- write one that accepts optional arguments and pass them the ones you know.
Does that make sense?
-
That's what I thought and was trying to ask. I just wasn't sure if you needed to make sure that the current values didn't change by forcing them as default. I do know that vba accepts optional arguments.
-
I also have 2 types of error checking in this function. As it is writen right now, the error handler takes care of the error. to utilize the other method, the ' needs to be removed in fron of IF and END IF
Private Sub LLayer(ByRef Lname As String, Optional Lcolor As Integer, Optional Ltype As String)
Dim objLayer As AcadLayer
On Error GoTo ErrorHandler
If DoesLayerExist(Lname) = False Then
Set objLayer = ThisDrawing.Layers.Add(Lname)
'SHOW 2 WAYS TO ERROR TRAP THIS
' If Lcolor <> 0 Then
objLayer.color = Lcolor
' End If
' If Ltype <> "" Then
objLayer.Linetype = Ltype
' End If
End If
GoTo Clean_Up
ErrorHandler:
Select Case Err
Case -2145320939:
Err.Clear
MsgBox "Invalid Color call"
Resume Next
Case -2145386493:
Err.Clear
MsgBox "Invalid Linetype call"
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
Clean_Up:
Set objLayer = Nothing
Lcolor = 0
Lname = ""
Ltype = ""
Exit Sub
End SubNotice the commented out lines (the lines beginning with an ')
There are 2 ways to error check this function, and I'm not sure I should show this, but it might inspire somebody to great things.
One way should be very obvious: On Error GoTo ErrorHandler.
The second way uses If..Then statements to test the values of the Arguments passed in to check their values. When we do not pass in an integer, Lcolor defaults to 0 (Zero). A layer can not have a color of 0, agreed? So, we can trap this 2 ways.
1- Let the ErrorHandler handle the error created when objLayer.color=0 is called or
2- Check to see IF Lcolor <> (is not equal to) 0 and if its not, THEN set objLayer.color = ArgumentColor
Does everyone understand this?
-
<shifting back to remedial mode>:)
btw, I'm trying to combine the layers and linetypes by doing this:... ..... .....
One minute I feel like a dope with this, the next like a bright and shiny light bulb.... and then like a dope again. :oops:
You guys are getting this and making good progress, its just that your moving faster than I can type. (Which is not a bad thing) I just hadn't gotten to the part where we create 1 function to do all the code. I was creating small modules to teach the concept, and we would put them all together later.
Dunno bout the progress...but...
My vbamanager(edit: uh, that's MACRO dialog, sorry) looks like this:
(http://www.theswamp.org/screens/birdy/vbaman.gif)
and I have to run both LLINE and test, and then they work.
(maybe I'm getting ahead of myself combining these subs into one...?)
-
One thing I might add to this thread when dealing with optional parameters is to use the IsMissing function to see if the value is missing ...
If Not (IsMissing(Lcolor)) Then
objLayer.Color = Lcolor
End If
If Not (IsMissing(Ltype)) Then
objLayer.Linetype = Ltype
End If
-
<Sylvania Moment>
I did notice that if I run the Macro 'test' first, it all works as expected.
One change I made was to put the sub 'test' at the top;
Public Sub test()
Call LLINE
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
Public Sub LLINE()
On Error GoTo ErrorHandler
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "DASHED", "ACAD.LIN"
Exit Sub
ErrorHandler:
Select Case Err
Case -2145386405:
Err.Clear
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Public Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
Does that make a difference?
-
<Sylvania Moment>
I did notice that if I run the Macro 'test' first, it all works as expected.
One change I made was to put the sub 'test' at the top....
Does that make a difference?
Technically, NO, does it help you see whats happening, YES , so at the top is good. Some people like to put the main code at the top, others at the bottem. It makes no difference to ACAD.
Back to your question about the Macro dialog box showing 2 macros: Re-read Public vs Private. Eventually, we will make LLayer and LLine Private, and they wont show up in that list. More on this later
-
Public Sub test()
Call LLINE
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
Private Sub LLINE()
On Error GoTo ErrorHandler
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "DASHED", "ACAD.LIN"
Exit Sub
ErrorHandler:
Select Case Err
Case -2145386405:
Err.Clear
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Private Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
Notice I changed the Public subs to Private subs for LLINE and LLAYER. This does 2 (or more) things
for us. 1 it removes the macros from the list of available macros you can run from ACAD.
2 More importantly, it changes the SCOPE of the variables and functions within our project module.
By declaring the subs Private, all variables inside those subs are private as well. In a nutshell
this means they are NOT available outside the sub they are contained within.
-
Public Sub test()
Call LLINE
Call LLayer("Layer1", acRed, "HIDDEN")
Call LLayer("Layer2", acGreen, "DASHED")
End Sub
Private Sub LLINE()
On Error GoTo ErrorHandler
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "DASHED", "ACAD.LIN"
Exit Sub
ErrorHandler:
Select Case Err
Case -2145386405:
Err.Clear
Resume Next
Case Else:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Private Sub LLayer(ByRef Lname As String, Lcolor As Integer, Ltype As String)
Dim objLayer As AcadLayer
Set objLayer = ThisDrawing.Layers.Add(Lname)
objLayer.color = Lcolor
objLayer.Linetype = Ltype
Set objLayer = Nothing
Exit Sub
End Sub
Notice I changed the Public subs to Private subs for LLINE and LLAYER. This does 2 (or more) things
for us. 1 it removes the macros from the list of available macros you can run from ACAD.
2 More importantly, it changes the SCOPE of the variables and functions within our project module.
By declaring the subs Private, all variables inside those subs are private as well. In a nutshell
this means they are NOT available outside the sub they are contained within.
-
wow. That makes things pretty clear(er).
Thanks. This is starting to gel a little bit.
"...miles to go before I sleep."
-
Everyone still following along? I just about ready to move to checking to see if the layer exists.
-
One thing I might add to this thread when dealing with optional parameters is to use the IsMissing function to see if the value is missing ...
If Not (IsMissing(Lcolor)) Then
objLayer.Color = Lcolor
End If
If Not (IsMissing(Ltype)) Then
objLayer.Linetype = Ltype
End If
I have never used this, but it looks promising. Is it easier to error trap than blank values (Duh its missing. Im typing this before I go test it)
-
Ok, I tried to use IsMissing, and it didnt work. Are the Not s needed?
-
Well, actually I penned that rather hastily ... IsMissing returns True or False ..
If an optional argument of a function is missing, it returns True, otherwise it returns False .. so you would need to check for True or False condition
-
i'll keep messing with this...
-
i have updated our document location with this (http://www.theswamp.org/~vbac/Load%20Linetypes%20and%20Layers.pdf) PDF. It shows the Sub up to where we are now.
-
Moving on to DoesLayerExist()
Any ideas what we need to do?
Pseudo code or actual code ideas...
-
Sub or Function and why...
also, Public or Private, and what effect will it have.
-
Function,
so that :
True or false can be returned < or the objectID >
-
Yes, Function is what we need. And True or False is what we are looking for as an answer. Now, any idea what method we can use for the test?
-
OK, we know we need a function so that we can get a result. True or False, does the layer exist? How can we search each layer? We need to iterate through the layer collection to check to see what layers exist in the drawing. A For Each loop will allow us to search every layer.
-
There are a bunch of different ways to write this, but this is what I put together
Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.name) = UCase(LayerName) Then
DoesLayerExist = True
Exit Function
End If
Next objLayer
DoesLayerExist = False
End Function
A few things to notice on this function are the argument I'm passing in, by ref, and the fact that I declared the function as Boolean. This is a hint that Im looking for True or False. Follow this through and see if it all makes sense.
-
OK, has everyone had a chance to digest that function, does anybody have an idea how to call this routine, from within an 'IF' statement so that our True or False result can be used to our advantage.
-
Sir, yes sir!
Edit: Se7en
Sorry Bob, i needed to try and edit a post to test permissions on this forum. Sorry for the intrusion.
-
Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.name) = UCase(LayerName) Then
DoesLayerExist = True
Exit Function
End If
Next objLayer <=== you lost me here
DoesLayerExist = False
End Function
This *seems* to work but that line 'Next objlayer' has got me confused.
Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.Name) = UCase(LayerName) Then
DoesLayerExist = True
'Exit Function
Else:
DoesLayerExist = False
End If
Next objLayer
End Function
-
Mark, the 'Next objLayer' line tells the function to continue the loop with the next layer.
For Each objLayer in ThisDrawing.Layers
tells the function that it's going to iterate through every layer in the drawing to do something
Next objLayer
tells the function that you are through with that layer and ready for the next
For Each objLayer in ThisDrawing.Layers
' some stuff
Next
Works just as well. 'Next objLayer' primarily helps you, and anyone else looking at your code, which for loop you are nexting.
-
Hi David,
Another Method could be to apply an exception based test
ie ;
Put this in an error trap. If it Spits the dummy, the Layer doesn't exist.
Dim layerObj As AcadLayer
Set layerObj = ThisDrawing.Layers.Item("TestLayerName")
:edit:
.. but that may be jumping the gun a little ..
-
Thanks Bob. A big "DUH" for me.
-
Kerry, having never tried that, would you be trapping the failure to set? If is cant set it, then create it?
-
David,
.. essentially yes .. ..
If the .Item on the LayersCollection fails an error is thrown. .. so if no error, the Layer exists, and you could pass back either the LayerObject or the true/false , depending on design.
This may be suitable when attempting to identify one particular item from the Collection.
As I said, this is probably getting ahead of ourselves, and diverts attention from the Collection iteration you were demonstrating.
Regards
Kerry
-
'Next objLayer' primarily helps you, and anyone else looking at your code, see which FOR loop you are nexting.
Well Said! I usually just use Next, but I was trying to code it so it made a little more sense.
-
I imagine Something like this ;
Option Explicit
Sub Test()
Dim blnResult As Boolean
blnResult = Testhelper("0")
MsgBox blnResult
'
'
blnResult = Testhelper("SpuriousLayerName")
MsgBox blnResult
End Sub
Function Testhelper(LayerName As String) As Boolean
Dim layerObj As AcadLayer
On Error GoTo Test_Error
Set layerObj = ThisDrawing.Layers.Item(LayerName)
MsgBox layerObj.ObjectID
Testhelper = True
On Error GoTo 0
Exit Function
Test_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Testhelper of Module Module1"
Testhelper = False
End Function
-
The two ways I see to use the function in an If...Then Statement is to check if it's true or check if it's false. Basically, if it exists, do something to it, or if it doesn't exist, make it, then do something to it, is what you would do for a true test. If you just wanted to ensure that the layer exists in the drawing, testing for false would be easier.
For these, I am simply going with a layer name as type in on the command line.Sub Test1()
'this sub will test for true and do things accordingly
Dim strLayName as String
strLayName = ThisDrawing.Utility.Getstring(1,"Type layer name to check: ")
'on the above line, the 1 in the first field in parenthesis tells the GetString method to allow spaces
if DoesLayerExist(strLayName) = True then
'Do things to the layer if it exists
Else
'The layer doesn't exist. Make the layer, then do things to it
End if
end sub
I went the long way with my If. DoesLayerExist(DLE) is a Boolean. That means that that it has two states. True/False is one way to think of it, the other way is that it either is or it isn't. Think of a light in your house as a boolean. If the light is on (True) there is light. If the light is off(false) there is no light. So there either is light or there isn't light. The following code works exactly the same way but instead of checking to see if DLE is true, I am just checking to see if DLE is.
Sub Test2()
'this sub will test for true and do things accordingly
Dim strLayName as String
strLayName = ThisDrawing.Utility.Getstring(1,"Type layer name to check: ")
'on the above line, the 1 in the first field in parenthesis tells the GetString method to allow spaces
[b]if DoesLayerExist(strLayName) then[/b]
'Do things to the layer if it exists
Else
'The layer doesn't exist. Make the layer, then do things to it
End if
end sub
Now if all we want to do is make sure that the layer exists, and if it doesn't, make it, then we really don't care about the true case. We could do
Sub Test3()
Dim strLayName as String
strLayName = ThisDrawing.Utility.Getstring(1,"Type layer name to check: ")
if DoesLayerExist(strLayName) then
'Nothing here because we aren't doing anything to an existing layer
Else
thisDrawing.Layers.Add(strLayName)
End if
end sub
But the whole wasted true field just takes up space, memory, and time. Instead I'm going to check to see if DLE is false which I could do with "If DoesLayerExist(strLayName)=False Then" but prefer to do it by just checking to see if DLE is like this
Sub Test4()
Dim strLayName as String
strLayName = ThisDrawing.Utility.Getstring(1,"Type layer name to check: ")
If [b]Not[/b] DoesLayerExist(strLayName) Then
ThisDrawing.Layers.Add(strLayName)
End if
End Sub
I tried to explain my methods and my thought process so Duh wouldn't have to but as I have a tough time following my thought processes most times, myself, if you don't understand what I am saying or doing, ask.
-
Took me three tries to get past the "someone posted while your slow butt was typing" messages.
-
Unless I'm mistaken,
If you just want to make sure the layer is there ;
Set layerObj = ThisDrawing.Layers.Add("New_Layer")will do the job, and wont complain if the Layer already exists.
The layerObj will hold < either > the Existing or New Layer Object.
The TestForExisting would be required if you wanted to determine <say> its Color or lineType et al ..
-
Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.Name) = UCase(LayerName) Then
DoesLayerExist = True
'Exit Function
Else:
DoesLayerExist = False
End If
Next objLayer
End Function
Mark, just curious why you commented out the Exit Function? Did it run better without that piece?
-
*shrug* I can't remember David. I do know it shouldn't be though.
-
The reason I had that in there was so when the Function returned true, it would stop and return the value. I think that without that, the function will always return false UNLESS the layer you are checking for happens to be the last one. Guru's can correct me on that, but logically that seems correct.
-
Also, to explain a little more, the Next objLayer would continue even though the test came up True. We need to end the Function so the result is returned. Does that make more sense?
-
DoesLayerExist is false until set to true. Since it is private, it won't retain it's value and will always start as false so we could leave the else out. We should still IMO have the Exit Function though. Think of it this way Mark. Say there are 2000 layers in the drawing and it takes the program 5 seconds to check through them all (yes, a bit of exaggeration) If the function finds the layer it is looking for first, what's the point of iterating through the other 1999? Let's just bug out and return the result.
Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.Name) = UCase(LayerName) Then
DoesLayerExist = True
Exit Function
End If
Next objLayer
End Function
-
Also, to explain a little more, the Next objLayer would continue even though the test came up True. We need to end the Function so the result is returned. Does that make more sense?
Yes it does.
Good explanation there Bob . . .