TheSwamp

Code Red => VB(A) => Topic started by: hardwired on October 11, 2010, 06:33:45 AM

Title: Does Layer Exist?
Post by: hardwired on October 11, 2010, 06:33:45 AM

Hi,

Hope you're all ok..

This is no doubt a very simple question but i can't seem to find all the answers i need..

I'm trying to check if a layer exists, and if it does, use it for a block insert and if it doesn't, create it and use it..


Here is my function (amended from one i found on here i think):

Code: [Select]

Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text
      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
      RMlayer = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
      RMlayer.Plottable = False
End Function
Firstly, is this function ok? and secondly, how do i use it in other subs within the program?

This is an extract of part of the main code and what i'm using:

Code: [Select]

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = RMlayer

Any ideas?

Title: Re: Does Layer Exist?
Post by: Arizona on October 11, 2010, 06:49:11 AM

Once you know the layer exists you need to set it as the active layer, if you want your block inserted on that layer. Or the alternative would be to change the block to the layer after insertion.

Title: Re: Does Layer Exist?
Post by: hardwired on October 11, 2010, 10:16:39 AM

Hi Arizona,

My current code does change the layer of the block after its been inserted but something's awry with my function or something else i've overlooked..

Any ideas?

Title: Re: Does Layer Exist?
Post by: Bob Wahr on October 11, 2010, 10:19:55 AM

You're note setting a value for RMlayer if the layer exists.  Try this.

Code: [Select]

Private Function DoesLayerExist(ByRef LayerName As String) As Boolean
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text
      Dim objLayer As AcadLayer
      For Each objLayer In ThisDrawing.Layers
            If UCase(objLayer.Name) = UCase(LayerName) Then
                  DoesLayerExist = True
                  RMlayer = objLayer
                  Exit Function
            End If
      Next objLayer
      DoesLayerExist = False
      RMlayer = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
      RMlayer.Plottable = False
End Function

Title: Re: Does Layer Exist?
Post by: hardwired on October 11, 2010, 10:52:03 AM

Hi Eric,

Ok tried that but still nothing. If i use the floowing code after the function.....

Code: [Select]

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = RMlayer

....how does all this tie in with each other? How do i call the return of the function within my code for inserting the block?

Title: Re: Does Layer Exist?
Post by: Bob Wahr on October 11, 2010, 11:10:02 AM

it doesn't.  rusty+not fully awake+no coffee yet = bad answer

try

Code: [Select]

Private Function DoesLayerExist(ByRef LayerName As String) As acadlayer
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text
      Dim objLayer As AcadLayer
      For Each objLayer In ThisDrawing.Layers
            If UCase(objLayer.Name) = UCase(LayerName) Then
                  DoesLayerExist = objLayer
                  Exit Function
            End If
      Next objLayer
      DoesLayerExist = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
      RMlayer.Plottable = False
End Function

Code: [Select]

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = DoesLayerExist
FYI, still haven't filled my cup up although the coffee is made now.  Haven't done any VBA for awhile and don't have it loaded so I can't test, so I'm just plugging blind.

Title: Re: Does Layer Exist?
Post by: hardwired on October 11, 2010, 11:36:00 AM

Hi Eric,

Hope you're coffee was nice..

I tired putting...

Code: [Select]

RMblock.Layer = DoesLayerExist

...but it breaks and says 'Argument Not Optional'

Title: Re: Does Layer Exist?
Post by: Bob Wahr on October 11, 2010, 11:44:45 AM

RMblock.Layer = DoesLayerExist(put the string you are passing to LayerName here)

coffee are gud

Title: Re: Does Layer Exist?
Post by: hardwired on October 11, 2010, 12:09:19 PM

Hi Eric,

I've tried various:

Code: [Select]

RMblock.Layer = DoesLayerExist("LSC-REVISIONS_" & revnumCOMBO.Text)
...but this didn't do anything.....

Code: [Select]

RMblock.Layer = DoesLayerExist(LayerName)
...but it said the variable was not defined (even though it is in the function).....

Code: [Select]

RMblock.Layer = DoesLayerExist(RMLayer)
...but it said 'ByRef argument type mismatch'.....

Title: Re: Does Layer Exist?
Post by: Bob Wahr on October 11, 2010, 02:25:41 PM

Quote from: hardwired on October 11, 2010, 12:09:19 PM

Hi Eric,

I've tried various:

Code: [Select]

RMblock.Layer = DoesLayerExist("LSC-REVISIONS_" & revnumCOMBO.Text)
...but this didn't do anything.....

Code: [Select]

RMblock.Layer = DoesLayerExist(LayerName)
...but it said the variable was not defined (even though it is in the function).....

Code: [Select]

RMblock.Layer = DoesLayerExist(RMLayer)
...but it said 'ByRef argument type mismatch'.....

Try

Code: [Select]

RMblock.Layer = DoesLayerExist(RMLayer.name)

or

Code: [Select]

Private Function DoesLayerExist() As acadlayer
dim LayerName as string
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text
      Dim objLayer As AcadLayer
      For Each objLayer In ThisDrawing.Layers
            If UCase(objLayer.Name) = UCase(LayerName) Then
                  DoesLayerExist = objLayer
                  Exit Function
            End If
      Next objLayer
      DoesLayerExist = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
      RMlayer.Plottable = False
End Function

Code: [Select]

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = DoesLayerExist
Sorry, that's about as much good as I'm going to be able to do without being able to play with it first hand.

Title: Re: Does Layer Exist?
Post by: Bryco on October 11, 2010, 07:04:47 PM

RMblock.Layer = DoesLayerExist(RMLayer.name)
DoesLayerExist needs to return a string (Layername not the acadlayer itself)

Title: Re: Does Layer Exist?
Post by: hardwired on October 13, 2010, 05:34:49 AM

Hi Eric / Bryco,

I have tried both your suggestions but it just doesn't change the layer of the block..

Just so i have it right in my head, where do i put the function? I'm taking it that it goes before the sub of the main command button or procedure inserting the block, so it calculates the function first. I have it this way but i can't get it to work..

If i post my whole code below (i can't post the userform to go with it but i'm sure you guys can imagine it lol) - oh and excuse any crudeness of coding, i'm pretty much self-taught so any pointers on clean code would be greatly appreciated if you have time:

Code: [Select]

Option Explicit
Dim response As Integer  'Yes/No..
Dim BlockPoint As Variant 'First Insertion point..
Dim RMblock As AcadBlockReference 'Inserted Revision Marker block..
Dim AttribZ As Variant
Dim CountX As Integer 'Counter..
Dim RMlayer As AcadLayer




' FINISHED..
Private Sub FINISHEDbtn_Click()
Unload Me
End Sub

' HELP..
Private Sub HELPbtn_Click()
'Dim retval
'retval = Shell("C:\Program Files\Internet Explorer\IExplore.exe ""X:\CAD_Tools\Help\RM_help.html""", vbMaximizedFocus)
End Sub


Private Function DoesLayerExist() As AcadLayer
Dim LayerName As String
Dim objLayer As AcadLayer
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text
     
      For Each objLayer In ThisDrawing.Layers
            If UCase(objLayer.Name) = UCase(LayerName) Then
                  DoesLayerExist = True
                  RMlayer = objLayer
                  MsgBox "Layer Does Exist: " & objLayer
                  Exit Function
            End If
      Next objLayer
     
      DoesLayerExist = False
      MsgBox "Layer Does Not Exist: " & objLayer
      RMlayer = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
      RMlayer.Plottable = False
End Function



'********************************************
'******** INSERT MARKERS ***********
'********************************************
Private Sub AddMArkersBTN_Click()
revmarkform.Hide

' Check if input is present..
If revnumCOMBO.Text = "" Then
    MsgBox "Please enter or select the Revision Number..", vbExclamation, "Revision Markers.."
    Exit Sub
End If
If revdateTXT.Text = "" Then
    MsgBox "Please enter or select the revision date..", vbExclamation, "Revision Markers.."
    Exit Sub
End If

'Get pick point..
'Error Test for GetPoint method..
On Error Resume Next
TryAgain:
BlockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the first insertion point for the Revision Marker..")

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = DoesLayerExist(objLayer.Name)

AttribZ = RMblock.GetAttributes ' Get Block attributes..
               
For CountX = LBound(AttribZ) To UBound(AttribZ)
    Select Case AttribZ(CountX).TagString
    Case "REV_NUM_INDICATOR"
        AttribZ(CountX).TextString = UCase(revnumCOMBO.Text)
    Case "COMMENTS_DATE"
        AttribZ(CountX).TextString = revdateTXT.Text
    End Select
Next CountX


ErrHndlr:
    If Err.Number <> 0 Then
        If Err.Number = -2145320928 Then
            GoTo END_DO
        End If
        Err.Clear
        GoTo TryAgain
    End If
    On Error GoTo ErrHndlr

'*******************************
'** Start the point pick loop **
'*******************************
Do
CountX = CountX + 1  'Add 1 to the counter..

' Error Test for GetPoint method..
'On Error Resume Next
TryAgain2:
BlockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the insertion point for the next Revision Marker..")

'Insert block..
    Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
    RMblock.Layer = DoesLayerExist(objLayer.Name)

AttribZ = RMblock.GetAttributes ' Get Block attributes..
               
For CountX = LBound(AttribZ) To UBound(AttribZ)
    Select Case AttribZ(CountX).TagString
    Case "REV_NUM_INDICATOR"
        AttribZ(CountX).TextString = UCase(revnumCOMBO.Text)
    Case "COMMENTS_DATE"
        AttribZ(CountX).TextString = revdateTXT.Text
    End Select
Next CountX

ErrHndlr2:
    If Err.Number <> 0 Then
        If Err.Number = -2145320928 Then
            GoTo END_DO
        End If
        Err.Clear
        GoTo TryAgain2
    End If
    'On Error GoTo ErrHndlr2
    On Error GoTo END_DO 'Exit the loop if ENTER or another key is hit (basically an error)..
   
Loop
'*******************************
'******** End the loop *********
'*******************************

END_DO:

revmarkform.Show
End Sub
'********************************************
'******** INSERT MARKERS ***********
'********************************************


Private Sub revdateTXT_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
revdateTXT.Text = Format(Date, "DD/MM/YYYY")
End Sub


'********************************************
'*************** FORM LOAD ******************
'********************************************
Private Sub UserForm_Initialize()

ThisDrawing.ActiveSpace = acPaperSpace

With revnumCOMBO
    .AddItem ("P2")
    .AddItem ("P3")
    .AddItem ("P4")
    .AddItem ("P5")
    .AddItem ("P6")
    .AddItem ("P7")
    .AddItem ("P8")
    .AddItem ("P9")
    .AddItem ("P10")
    .AddItem ("C1")
    .AddItem ("C2")
    .AddItem ("C3")
    .AddItem ("C4")
    .AddItem ("C5")
    .AddItem ("C6")
    .AddItem ("C7")
    .AddItem ("C8")
    .AddItem ("C9")
    .AddItem ("C10")
    .AddItem ("AB")
End With
End Sub
'********************************************
'*************** FORM LOAD ******************
'********************************************

'********************************************
'*************** FORM UNLOAD ****************
'********************************************
Private Sub UserForm_QueryClose(Cancel As Integer, closemode As Integer)
response = MsgBox("Are you sure you've finished with the 'Revision Markers'?..", vbQuestion + vbYesNo, "End the Program..")
    If response = vbNo Then
    Cancel = 1
    End If
    If response = vbYes Then
        Unload Me
    End If
End Sub
'********************************************
'*************** FORM UNLOAD ****************
'********************************************



Title: Re: Does Layer Exist?
Post by: Bryco on October 13, 2010, 08:32:36 AM

Private Function DoesLayerExist() As string

this function must return the string layername

Title: Re: Does Layer Exist?
Post by: hardwired on October 13, 2010, 09:06:23 AM

Hi Bryco,

I tried that (changed no other code than the line you showed) but it came back saying the objLayer variable was not set, even though its set in the function. Any Ideas?

Title: Re: Does Layer Exist?
Post by: Bob Wahr on October 13, 2010, 10:23:58 AM

This is going off of some vague memory, so I'll let you decide it's worth or worthlessness but it might be worth trying.  If I remember right, makinjg the layer with VBA doesn't hurt anything if the layer already exists, so you might try eliminating the check function and just make the layer every time.  Barring that, you could do the check in your main sub instead of breaking it out into a function. 

Title: Re: Does Layer Exist?
Post by: hardwired on October 13, 2010, 11:07:09 AM

Hey Eric,

Props to that man, i deleted the function and just added the addlayer code in my sub and it works..

Thanks to you and to Bryco and Arizona of course for your help..

Good skills..

Title: Re: Does Layer Exist?
Post by: wjbzone on January 03, 2011, 01:50:36 PM

Not vba code, but

Autocad has a method of checking if a layer exists and if so, make it current...

Use the Autocad layer command:

(command "._layer" "_M" "layername" "")

The "m" (make) command creates the layer if it does not exist.

Title: Re: Does Layer Exist?
Post by: Matt__W on January 03, 2011, 01:59:22 PM

That doesn't check if the layer exists.... that simply makes a new layer.

Look into TBLSEARCH for checking if a layer exists.

Title: Re: Does Layer Exist?
Post by: wjbzone on January 12, 2011, 04:21:20 PM

I think it does what the OP wanted:

"I'm trying to check if a layer exists, and if it does, use it for a block insert and if it doesn't, create it and use it.."

Title: Re: Does Layer Exist?
Post by: ChuckHardin on March 24, 2011, 08:54:08 AM

Here is my Block adder it uses the error code from layer not found traps the error and then adds the layer before continuing. Using Error Handlers is always a good idea even if it only has a case else that gives a msgbox or debug.print.

Code: [Select]

Public Function AddBlocks(varInsPnt As Variant, strLayerName As String, _
                     strBlock As String, Optional strAttValue As String = "") As String
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim intLoop As Integer
Dim varAtts As Variant
Dim strHandle As String
On Error GoTo Err_Control
 
 Set objBlkRef = ThisDrawing.ModelSpace.InsertBlock(varInsPnt, strBlock, 1, 1, 1, 0)
 strHandle = objBlkRef.Handle
 objBlkRef.Layer = strLayerName
 
 If strAttValue <> "" Then
      If objBlkRef.HasAttributes Then
           varAtts = objBlkRef.GetAttributes
           For intLoop = LBound(varAtts) To UBound(varAtts)
                Set objAttRef = varAtts(intLoop)
                objAttRef.TextString = strAttValue
           Next intLoop
      End If
 End If
 Autocad.Update
Exit_Here:
 AddBlocks = strHandle
 Exit Function

Err_Control:
 Select Case Err.Number
      Case -2145386476    'Layer Name not Found
           Err.Clear
           'Skip Layer Change or Create Layer
           ThisDrawing.Layers.Add (strLayerName)
           Resume
      Case Else
           'LogError Err.Number, Err.Description & "; " & strAttValue & ", " & strBucket, "AddBlocks", "modACAD.bas"
           'MsgBox Err.Number & ": " & Err.Description
           Resume Exit_Here
 End Select
End Function


Title: Re: Does Layer Exist?
Post by: Daniel Eiszele on March 25, 2011, 09:20:15 PM

Even though you have a workable answer you may find that these snippets would fix your previous attempts.

Code: [Select]

'THis is the name of the layer we are testing for existence
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text

'Function to tell if a layer exists or not
Private Function DoesLayerExist(LayerName as String) As Boolean

Dim objLayer As AcadLayer

DoesLayerExist = False

For Each objLayer In ThisDrawing.Layers
If UCase(objLayer.Name) = UCase(LayerName) Then
DoesLayerExist = True
RMlayer = objLayer
Exit Function
End If
Next objLayer

End Function


'This is the test part of the code
If DoesLayerExist(LayerName) = False Then
RMlayer = ThisDrawing.Layers.Add(LayerName)
  RMlayer.Plottable = False
End If

'Now Set the block Layer
RMblock.Layer = LayerName
The main problem I found with the previous attempts were you were giving a function a return type and then telling it the return type was something else.  Ie "acadlayer" but setting it to "True". 

Also you can put the function anywhere within the same module and vb will find it!

Regards,