Author Topic: If Layer Exists Then:  (Read 9461 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
If Layer Exists Then:
« on: February 17, 2005, 01:08:44 PM »
I am working on a module but I need to write an Errorhandler to handle the duplicate record error message associated with duplicate layers.

Unfortunately after many tries, I can not write sufficient code that will check the layers collection to see if a layer already exists

Does anyone happen to have an example around that I can draw from?

Thank you


Mark

hendie

  • Guest
If Layer Exists Then:
« Reply #1 on: February 17, 2005, 01:31:51 PM »
what code do you have just now ?

I'm not sure what you mean by
Quote
to handle the duplicate record error message associated with duplicate layers


this is straight out of the acad help

Code: [Select]
Private Sub addlayer()

' This example creates a new layer called "New_Layer"
    Dim layerObj As AcadLayer
   
    ' Add the layer to the layers collection
    Set layerObj = ThisDrawing.Layers.Add("New_Layer")
   
    ' Make the new layer the active layer for the drawing
    ThisDrawing.ActiveLayer = layerObj
   
    ' Display the status of the new layer
     MsgBox layerObj.Name & " has been added." & vbCrLf & _
            "LayerOn Status: " & layerObj.LayerOn & vbCrLf & _
            "Freeze Status: " & layerObj.Freeze & vbCrLf & _
            "Lock Status: " & layerObj.Lock & vbCrLf & _
            "Color: " & layerObj.color, , "Add Example"

End Sub

you can run it as many times as you wish and it doesn't generate an error message

Anonymous

  • Guest
If Layer Exists Then:
« Reply #2 on: February 17, 2005, 01:35:24 PM »
Hey Hendie

Actually I don't have anything to post related to what I am asking for.

I can tell you what I am doing if you like, or if it will help?

I was hoping for a very generic piece of code that will delete a layer if it already exists in my new layer collection

Mark

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #3 on: February 17, 2005, 01:45:20 PM »
Quote from: Anonymous
I was hoping for a very generic piece of code that will delete a layer if it already exists in my new layer collection
Mark


Meaning if it exists in the drawing, dont try and recreate it?
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Anonymous

  • Guest
If Layer Exists Then:
« Reply #4 on: February 17, 2005, 02:02:50 PM »
Yes CmdrDuh

That is exactly what I am looking for
If the layer exists, then don't try to recreate it

I need code for that exactly

Mark

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #5 on: February 17, 2005, 02:25:46 PM »
Let me see what i have
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
If Layer Exists Then:
« Reply #6 on: February 17, 2005, 02:58:17 PM »
Something like this ?
Code: [Select]

Option Explicit

Public Sub test()
    Dim bResult        As Boolean
    bResult = DoesLayerExist("XXX_001")
    If bResult Then
        MsgBox "Layer XXX_001 exists"
    Else
        MsgBox "Not Today Mark"
    End If
End Sub

Public Function DoesLayerExist(sLayer As String) As Boolean
    Dim oLayers        As AcadLayers
    Dim oLayer         As AcadLayer
    On Error GoTo Skippy
    Set oLayers = ThisDrawing.Layers
    Set oLayer = oLayers.Item(sLayer)
    DoesLayerExist = True
    Exit Function
Skippy:
   
End Function
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Anonymous

  • Guest
If Layer Exists Then:
« Reply #7 on: February 17, 2005, 04:49:27 PM »
Hey Kerry

Can I use you above code to specify multiple layers?

There are about 8 - 10 layers in my drawing that I want VBA to check to see if they already exist.


Thank you

Mark

ML

  • Guest
If Layer Exists Then:
« Reply #8 on: February 17, 2005, 04:52:45 PM »
Thanks Kerry,

Thanks CMD

Sorry, I didn't Log in the last few times so I was posting as a guest.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
If Layer Exists Then:
« Reply #9 on: February 17, 2005, 06:04:35 PM »
This may give you some ideas ,
Code: [Select]

Public Sub test_01()
    Dim bResult        As Boolean
    Dim svLayerList(0 To 9) As String
    Dim cnt            As Integer
    Dim sLayName       As String

    svLayerList(0) = "Layer0"
    svLayerList(1) = "0"
    svLayerList(2) = "Layer2"
    svLayerList(3) = "NoWay"
    svLayerList(4) = "Layer4"
    svLayerList(5) = "Layer5"
    svLayerList(6) = "Layer6"
    svLayerList(7) = "Layer7"
    svLayerList(8) = "Layer8"
    svLayerList(9) = "Bogus"

    For cnt = 0 To UBound(svLayerList)
        sLayName = svLayerList(cnt)
        bResult = DoesLayerExist(sLayName)
       
        If bResult Then
            MsgBox "Layer : " & sLayName & vbCrLf & " exists"
        Else
            MsgBox "Layer : " & sLayName & vbCrLf & " does NOT exist"
        End If
    Next
End Sub


Public Function DoesLayerExist(sLayer As String) As Boolean
    Dim oLayers        As AcadLayers
    Dim oLayer         As AcadLayer
   
    On Error Resume Next
    Set oLayers = ThisDrawing.Layers
    Set oLayer = oLayers.Item(sLayer)
    DoesLayerExist = (Err.Number = 0)
    Err.Clear
End Function
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
If Layer Exists Then:
« Reply #10 on: February 17, 2005, 06:06:59 PM »
Note that the DoesLayerExist() is slightly different to the prev' version.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

ML

  • Guest
If Layer Exists Then:
« Reply #11 on: February 18, 2005, 08:24:29 AM »
That looks like it will do the trick
I really appreciate it.

Let me go give it a try.

I'll let you know how it works

Thank you

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #12 on: February 18, 2005, 08:55:36 AM »
Good job Kerry,  I got busy and couldn't post til this morning, and you beat me to it.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
In need of more help
« Reply #13 on: February 18, 2005, 11:36:32 AM »
Hey Guys,

I really appreciate your help thus far.
The above code works great but either I am not utilizing it exactly how I need to or may be one of you will have another suggestion.

Below is an example of the module I am developing

I am inserting a block, it is a legend for Intercomm symbols.

My menu macro allows you to choose what scale (out of 7 or so) you would like to insert the block into your drawing at.

The menu macro pauses for insertion, after the user inserts the block, the Vba Module is fired off.

The Below Code (For Each Loop)
is repeated  for each scale that the user can select from, it was just too much to paste in

On the first block inserted, all works well.
So, if you look at the For Each Loop below, I am saying if The Block Intercomm has an xscale factor of 48, then rename the layer Co-I-SYMB toCo-I-SYMB-48

Now, if I insert a second Intercomm at a different scale (for instance 96)
It seems to be going through all of the possible scale factors in the module, seeing 48 again, then I get the duplicate record error and the layer remains at Co-I-SYMB

I need to somehow have it see that there is a 48, overlook it then proceed to 96 and create Co-I-SYMB-96 layer and so on.


So, I was trying to filter by layer name.
If that layer exists, then move on, but I am still having no luck

I hope this makes sense?


Any help will be APPRECIATED


Thanks

Mark

   

Code: [Select]

Dim Co_Layers As AcadLayers
Dim Intercomm As AcadBlockReference
Dim BlockXScaleFactor As Double

Set Co_Layers = ThisDrawing.Layers
Set Intercomm = ThisDrawing.ModelSpace.Item(Intercomm1)

BlockXScaleFactor = Intercomm.XScaleFactor



If Intercomm.XScaleFactor = 48 Then
 For Each Layer In Co_Layers
  If Layer.Name = ("Co-I-SYMB") Then
     Layer.Name = ("Co-I-SYMB-48")
  End If
 Next
End If


Exit Sub

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #14 on: February 18, 2005, 11:52:37 AM »
i think your problem might be in the way you are pulling the scalefactor.  Is it possible you are going back to the first block and getting its scale factor not the new block factor?  Thus it sees the 48 again
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #15 on: February 18, 2005, 12:28:21 PM »
What about using Select Case to determine the scale factor, and then running the layer code from there
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
If Layer Exists Then:
« Reply #16 on: February 18, 2005, 12:52:00 PM »
Yes that is very possible, a matter of fact, probable.

I just don't know how to make it overlook the existing ones.

ML

  • Guest
If Layer Exists Then:
« Reply #17 on: February 18, 2005, 12:55:37 PM »
That would be a more efficient way to do it I'm sure but I think it would still give the same result.

I need a way to incorporate the layer code into my existing code to make this work, just not sure ( code wise) how to do it.

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #18 on: February 18, 2005, 01:37:03 PM »
Well, if you used Select to sort what scale you chose, then use the layer code to see if it exists.  BTW, whats the harm in recreating the layer if it exists?  That way it creates on the fly as needed
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
If Layer Exists Then:
« Reply #19 on: February 18, 2005, 04:05:18 PM »
Well, something weird is going on and I can only assume it is because it is seeing that something already exists, thus the duplicate record message and the layers and up all weird.

After I get the error, it breaks on the layername (in the module) of the duplicate layer and highlights it yellow.

So, I can only assume that it is the duplicate layername that is causing the problem.

ML

  • Guest
If Layer Exists Then:
« Reply #20 on: February 18, 2005, 04:10:23 PM »
Suppose I have a block (Intercomm) inserted at 24, then I go and insert another one at 48, it is still going to pass through the code and see that there is a blocked scaled to 24 as well.

So, may be I need a way for it to know to only look at blocks that were just inserted.

That would probably involve an event procedure and I am not sure there is one for inserting blocks.

It seems like this could be a lot easier.

ML

  • Guest
If Layer Exists Then:
« Reply #21 on: February 18, 2005, 04:43:00 PM »
As inefficient as it would be, I wonder if I wouldn't be better off having 13 different modules in this one project, one for each scale?

When I do it that way, there is really no conflict but it just seems like a cop out to me, plus I need the module to load and run every time I insert a block, that might be very slow as well.

Anonymous

  • Guest
If Layer Exists Then:
« Reply #22 on: February 18, 2005, 06:26:43 PM »
Man, this module is kicking my   :shock:

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #23 on: February 18, 2005, 06:30:04 PM »
PMFJI, but are you trying to complete a number of tasks by mixing lisp and vba? If so, it seems like you are making it hard on yourself.....

None-the-less, to get the last entity which in this case appears to be a block insert, why not just get the last entity in modelspace?

Dim entLast As AcadEntity
Set entLast = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)

Even after reading all of the questions and answers in this thread, I'm still not clear exactly what you are trying to accomplish.....but I still don't think that the '13 different modules' is the approach you need to take.

Instead of placing the blocks on a layer and then renaming the layer based on scale, why not just create the layer based on scale and then place the new block on that layer......

Or, to go with your OnEvent idea you could place something like this in the ObjectAdded event in the ThisDrawing module:
Code: [Select]

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
Dim oBlkRef As AcadBlockReference

If Object.ObjectName = "AcDbBlockReference" Then
    Set oBlkRef = Object
    If oBlkRef.Name = "Whatever your block name is" Then
    'or use If oBlkRef.Name Like "SYM*" 'for a wildcard match
        Select Case oBlkRef.XScaleFactor
            Case Is = 48#
                ThisDrawing.Layers.Add "Co-I-SYMB-48"
                oBlkRef.Layer = "Co-I-SYMB-48"
           
            Case Is = 96#
                ThisDrawing.Layers.Add "Co-I-SYMB-96"
                oBlkRef.Layer = "Co-I-SYMB-96"
            'Add all other cases.....
           
        End Select
    End If
End If

End Sub

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
If Layer Exists Then:
« Reply #24 on: February 19, 2005, 09:01:49 PM »
or this to test for all layers
Code: [Select]

Sub test()
Dim varLayers(0 To 5)
Dim booLay(0 To 5) As Boolean
Dim objlay As AcadLayer
Dim intCnt As Integer
Dim strLabel As Variant

varLayers(0) = "lay1": varLayers(1) = "lay2": varLayers(2) = "lay3"
varLayers(3) = "lay4": varLayers(4) = "lay5": varLayers(5) = "lay6"
For Each objlay In ThisDrawing.Layers
 For intCnt = 0 To UBound(varLayers)
   If StrComp(objlay.Name, varLayers(intCnt), vbTextCompare) = 0 Then
     booLay(intCnt) = True
   End If
 Next intCnt
Next objlay

For intCnt = 0 To UBound(booLay)
 If Not booLay(intCnt) Then
   If varLayers(intCnt) Like "lay1" Then
     Call Lay1
   ElseIf varLayers(intCnt) Like "lay2" Then
     Call Lay2
   'and more elseifs to fill it in
   End If
 End If
Next intCnt

End Sub

Sub Lay1()
Dim objlay As AcadLayer
Dim color As New AcadAcCmColor
color.ColorIndex = 5
Set objlay = ThisDrawing.Layers.Add("Lay1")
objlay.TrueColor = color
objlay.Linetype = "CONTINUOUS"
objlay.Lock = True
End Sub

Sub Lay2()
Dim objlay As AcadLayer
Dim color As New AcadAcCmColor
color.ColorIndex = 3
Set objlay = ThisDrawing.Layers.Add("Lay2")
objlay.TrueColor = color
objlay.Linetype = "HIDDEN"
objlay.Lock = True
End Sub

It will error if the linetypes aren't loaded as is.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
If Layer Exists Then:
« Reply #25 on: February 21, 2005, 10:48:52 AM »
Hi Jeff

I really like the code you posted for the event procedure Object Added, thank you.

I have been messing around with it for the last hour or so.

It is working very except for this part:
Code: [Select]

oBlkRef.Layer = "Co-I-SYMB-48


The other thing to consider is that the block will be inserted as a non-exploded block but the user will (more then likely) explode it eventually for other reasons.

After the block is exploded, it will then adopt its original layer which was:
Co-I-SYMB

This makes me wonder if my original method of renaming the block from
Co-I-SYMB to Co-I-SYMB-48 if the scale is 48 is a better approach? I do like this method better as well.

I modified your code to this :

Code: [Select]


Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)

Dim oBlkRef As AcadBlockReference
Dim layer As AcadLayer

If Object.ObjectName = "AcDbBlockReference" Then
    Set oBlkRef = Object
    Set layer = ThisDrawing.Layers.Item("CO-I-SYMB")
    If oBlkRef.Name = "Intercomm1" Then
    'or use If oBlkRef.Name Like "SYM*" 'for a wildcard match
        Select Case oBlkRef.XScaleFactor          
            Case Is = 48#, Is = ThisDrawing.Layers.Item("CO-I-SYMB")
            layer.Name = ("CO-I-SYMB-48")

            Case Is = 96#, Is = ThisDrawing.Layers.Item("CO-I-SYMB")
            layer.Name = ("CO-I-SYMB-96")
            'Add all other cases.....
      End Select
    End If
End If


End Sub



Like all of my prior code attemtps, the first inserted block works perfectly but the second inserted block does not.
With the above code, I inserted the Intercomm1 block at 48,
it remaned the layer and all.

After I inserted the second one at 96, It highlighted this line:
Code: [Select]

 Case Is = 48#, Is = ThisDrawing.Layers.Item("CO-I-SYMB")


and said object does not support this method.

Jeff, do you have any idea where the conflict could be?

I think what is happening is that after you insert the second block (scale 96), it still runs through the code that is addressing the scale 48 and there is a conflict.

I wonder if it has to do with the fact that they both share the original layer name CO-I-SYMB?

What do you think?

I hope you understand what I am explaining?

If not, I will clarify

I appreciate the help


Mark

ML

  • Guest
If Layer Exists Then:
« Reply #26 on: February 21, 2005, 11:15:02 AM »
Jeff,

I tried again and here is what I think is happening:

You have a block inserted at 48. Now, you insert the same block at 96.

Well after the module is ran, it is still going to see the block scaled at 48 in the drawing and attempt to create this layer again and that is where the error occurs.

Somehow the module needs to say,
If the block "Intercomm1" is already in the drawing at 48 then ignore it completely and go onto the one you are currently inserting.

I beleve that will solve the problem if only I knew how to address it

I think the event Object aded code that you posted was an attempt to do just that but as I stated in my prior post, the problem still occurs

Thank you again

Mark

ML

  • Guest
If Layer Exists Then:
« Reply #27 on: February 21, 2005, 11:21:06 AM »
Here is yet another one of my attempts.
I think this method is cool because it grabs the xscalefactor from the inserted block and uses it to suffix the layer name

Eve with this method,  the same problem occurs.

Mark

Code: [Select]

Sub LayerSuffixXScaleFactor()


Dim CO_Layers As AcadLayers
Dim Intercomm As AcadBlockReference

Dim BlockXScaleFactor As Double


Set CO_Layers = ThisDrawing.Layers
Set Intercomm = ThisDrawing.ModelSpace.Item(Intercomm1)
 
BlockXScaleFactor = Intercomm.XScaleFactor


If Intercomm.XScaleFactor = 48 Then
 For Each layer In CO_Layers
  If layer.Name = ("CO-I-SYMB") Then
     layer.Name = layer.Name & "-" & BlockXScaleFactor
  End If
 Next
End If

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #28 on: February 21, 2005, 11:40:42 AM »
Mark, the problem is that once the layer name is changed, it also affects the block definition....IOW, if the block entities are drawn on layer1, then you create the block, then you insert that block and change the layer name of layer1 to layer2, the block definition has no way of keeping layer1 as it's base.......

What you need to do is create a new BLOCK definition with the scale as a part of the name and change the layer of the entities within that block definition.

ML

  • Guest
If Layer Exists Then:
« Reply #29 on: February 21, 2005, 11:52:09 AM »
Hey Jeff,

I am not completely sure I understand what you are refferring to in this part :

Quote

What you need to do is create a new BLOCK definition with the scale as a part of the name and change the layer of the entities within that block definition.


Are you saying go to the base drawing, rename the block, wblock it out, then manipulate it through code?

If this is what you mean, wouldn't I still run into the same problem later?

Thanks
Mark

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #30 on: February 21, 2005, 02:26:37 PM »
Mark, after reading your one mention above of why you are going to these measures of wanting the layer renamed:
Quote
The other thing to consider is that the block will be inserted as a non-exploded block but the user will (more then likely) explode it eventually for other reasons.

After the block is exploded, it will then adopt its original layer which was:
Co-I-SYMB

I think that you'd be better served by just placing the block on the desired layer and either redefining the explode command to place the block's objects on the parent's layer or teach your users to use an "explode to layer" command, such as the one included with Express Tools.

I have played around with the ObjectAdded event to create a new block & layer based on the scale but I keep getting errors...."Object was open for read"... when I try to change the newly added object's layer and/or name.

Otherwise, I'm out of ideas. Good luck,
Jeff

ML

  • Guest
If Layer Exists Then:
« Reply #31 on: February 21, 2005, 02:33:11 PM »
Hi Jeff

Yes I was getting the same error, Object was Open for Read

I really appreciate your help.

Well, at least I know that I have tried several options.

This still doesn't explain why I successfully get the first on to work perfectly.

I am also out of ideas.

Thank you again

Mark

ML

  • Guest
If Layer Exists Then:
« Reply #32 on: February 23, 2005, 09:17:46 AM »
Jeff

If you get achance, read this thread at AutoDesk.
It adds insite into this Object was open for read.

THe problem may be that  we are trying to use Block Reference to put the Intercomm block onto a layer whereas it may be that we need reference it as an entity instead.

If I get a chance, I will look into it more later

Mark


http://discussion.autodesk.com/thread.jspa?messageID=418549

ML

  • Guest
If Layer Exists Then:
« Reply #33 on: February 23, 2005, 10:12:47 AM »
Hey Seven,

While you are at it, can you post the answers I need??   :D

Thanks

Mark

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #34 on: February 23, 2005, 05:16:43 PM »
Mark,
I'm not sure how that thread relates to this issue. We are not iterating a selection set, nor are we using r14.

I had tried setting the object to a variable dimensioned as a blockreference with the same result. I think the problem stems from the Event handler has the object open, so a global var would need to be set, checked, then acted upon after the event handler is done. I just don't have the time to play with it at the moment.....maybe over the weekend I'll get some time.

On another note......your last post was directed at Se7en, I haven't seen him post in this thread.....are you seeing things I'm not?  :?

ML

  • Guest
If Layer Exists Then:
« Reply #35 on: February 24, 2005, 03:30:02 PM »
LOL

No, he had a test post on here and said sorry about the post, we will delete it.

So, I said, while you are here, may be you can help :)

Hey Jeff,
Someone directed me to that thread so I thought it might be useful to read. I wasn't sure if it was specifically relevant though the error was the same.

Please don't spend your time off trying to figure out something for me, I will get it.

The things you have posted have already been a big help

ML

  • Guest
If Layer Exists Then:
« Reply #36 on: February 24, 2005, 04:38:56 PM »
Hey Jeff,

I'm sorry,
I accidentally sent you a thread that I was reading but here is the one I meant to send you.

There are 19 posts on Object Open for Read.


http://discussion.autodesk.com/search!execute.jspa?numResults=25&source=forumlist%7C8&q=%22Object+was+open+for+read%22&objID=c8&search=Search

Take it easy

Mark

ML

  • Guest
If Layer Exists Then:
« Reply #37 on: February 24, 2005, 05:32:03 PM »
Ok,

Jeff, I believe I have solved it.
With all of your help and my persistence, this seems to be working real well. Along with The Sset, I used a For, Each Loop and it seems to be working real well.

It looks for the blockreference based on the scale, creates the layer, grabs the block and places it on the newly created layer.

So after the user inserts the block, they need to launch the macro immediately after. That is exactly what I was looking to do.

If you get a chance, get it a shot and let me know what you think

Thanks again

Mark

-------------------------------------

Sub Scaledblockonlayer()

Dim BlkRef As AcadBlockReference
Dim Sset As AcadSelectionSet

Set Sset = ThisDrawing.PickfirstSelectionSet
Sset.Select acSelectionSetLast

 For Each BlkRef In Sset
   Select Case BlkRef.XScaleFactor
    Case Is = 48#
     ThisDrawing.layers.Add ("CO-I-SYMB-48")
     Sset.Item(0).Layer = ("CO-I-SYMB-48")
    Case Is = 96#
     ThisDrawing.layers.Add ("CO-I-SYMB-96")
     Sset.Item(0).Layer = ("CO-I-SYMB-96")
   End Select
 Next
 
 
End Sub

ML

  • Guest
If Layer Exists Then:
« Reply #38 on: February 24, 2005, 05:32:59 PM »
Ok,

Jeff, I believe I have solved it.
With all of your help and my persistence, this seems to be working real well. Along with The Sset, I used a For, Each Loop and it seems to be working real well.

It looks for the blockreference based on the scale, creates the layer, grabs the block and places it on the newly created layer.

So after the user inserts the block, they need to launch the macro immediately after. That is exactly what I was looking to do.

If you get a chance, get it a shot and let me know what you think

Thanks again

Mark

-------------------------------------
Code: [Select]

Sub Scaledblockonlayer()

Dim BlkRef As AcadBlockReference
Dim Sset As AcadSelectionSet

Set Sset = ThisDrawing.PickfirstSelectionSet
Sset.Select acSelectionSetLast

 For Each BlkRef In Sset
   Select Case BlkRef.XScaleFactor
    Case Is = 48#
     ThisDrawing.layers.Add ("CO-I-SYMB-48")
     Sset.Item(0).Layer = ("CO-I-SYMB-48")
    Case Is = 96#
     ThisDrawing.layers.Add ("CO-I-SYMB-96")
     Sset.Item(0).Layer = ("CO-I-SYMB-96")
   End Select
 Next
 
 
End Sub

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #39 on: February 24, 2005, 07:48:24 PM »
The only thing I see right off the top of my head is that if this is run without the intended blockref visible it may select another block that IS visible. But if this is run immedaitely after visibly inserting a block then that shoudln't be a problem.

I'm glad you got something working though!

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
If Layer Exists Then:
« Reply #40 on: February 24, 2005, 09:13:18 PM »
Well, Mark, I seem to have found another solution for you. Rather than have the user launch another application (who's to say they will always remember to), you said that the block is being insert with a lisp routine, correct? Since VBA has a "EndLisp" event, why not place your code in there?

For instance, your user runs the lisp routine that inserts the block "intercomm1" at 48 scale, once done the event handler will be alerted and this code could run:
Code: [Select]

 'placed in the ThisDrawing module of either the Acad.dvb file or any other dvb that is loaded
Private Sub AcadDocument_EndLisp()
Dim oEnt As AcadEntity
Dim oBlk As AcadBlockReference

With ThisDrawing
    If .GetVariable("cvport") = 1 Then
        Set oEnt = .PaperSpace.Item(.PaperSpace.Count - 1)
    Else
        Set oEnt = .ModelSpace.Item(.ModelSpace.Count - 1)
    End If
    If TypeOf oEnt Is AcadBlockReference Then
        Set oBlk = oEnt
        'you could add a check for block.name here if desired
        Select Case oBlk.XScaleFactor
            Case Is = 48#
            .Layers.Add ("CO-I-SYMB-48")
            oBlk.Layer = ("CO-I-SYMB-48")
           
            Case Is = 96#
            .Layers.Add ("CO-I-SYMB-96")
            oBlk.Layer = ("CO-I-SYMB-96")
               
        End Select
    End If
End With
End Sub


And since I have tested this to work, I'm convinced that the ObjectAdded event failed due to the event itself had the object open for read.

ML

  • Guest
If Layer Exists Then:
« Reply #41 on: February 25, 2005, 07:26:24 AM »
Hey Jeff

I really appreciate it.
Actually I am not using LISP, I am better at and prefer VBA.
I actually use a series of menu macros that are accessed from a company pulldown menu that I created.

Here is an example of the block being inserted at 48:
Code: [Select]

^C^C-insert;Intercomm1;s;48;\;^C^C-vbaload;"C:/Documents and Settings/Mark/Desktop/CO_Legend_Layers1.dvb";-vbarun;CO_LegendLayers;


 The User is prompted for an insertion point on screen, then The VBA Project loads, macro runs, then in the vba module, I use UnloadDVB at the end so that the user or whoever can use it again without having to worry about read-only problems. Also, this guarantees that the macro is fired up "directly" after block insert


As far as my previous post, I am real happy with the results of the code I worked out , but you do raise a good point.

We could set a reference to the specific block or I could also add a line
using  BlkRef.name =

Code: [Select]

 Select Case BlkRef.XScaleFactor
 Case Is = 48#
 Case  BlkRef.name = ("Intercomm1")
 'Add layer code


or

Code: [Select]

 Select Case BlkRef.name = ("Intercomm1")
 Case  BlkRef.XScaleFactor = 48
'Add layer code


I think either method would work to validate the name as well but I need to try it. What do you think?

I will definetely need to add code for that purpose as we will be inserting other blocks as well.

I need to see exactly which way I need to go with this before I get too crazy but this is a great start.

Mark

ML

  • Guest
If Layer Exists Then:
« Reply #42 on: March 01, 2005, 04:41:29 PM »
OK,

Now the code looks for the block reference name first, then scale.
If it finds the name and scale, it then creates the layer and places the block on that layer and makes the layer the necessary color

If the user selects a scale that we don't want to use, then they are notified that it is not a used scale.

I show only scale factor 48 here but the actual module has 14 possible scale factors that the block can be inserted at.

Mark

Code: [Select]

Sub LegendLayers()

Dim BlkRef As AcadBlockReference
Dim Sset As AcadSelectionSet

Set Sset = ThisDrawing.PickfirstSelectionSet
Sset.Select acSelectionSetLast

                 
For Each BlkRef In Sset
  If BlkRef.Name = "Intercomm" Then
    Select Case BlkRef.XScaleFactor
      Case Is = 48#
        ThisDrawing.Layers.Add ("CO-I-SYMB-48")
        Sset.Item(0).Layer = ("CO-I-SYMB-48")
        ThisDrawing.Layers("CO-I-SYMB-48").color = acCyan
      Case Else
       MsgBox "This scale is not used"
     End Select
  End If
             
  If BlkRef.Name = "Fire_Alarm" Then
    Select Case BlkRef.XScaleFactor
      Case Is = 48#
        ThisDrawing.Layers.Add ("CO-FA-SYMB-48")
        Sset.Item(0).Layer = ("CO-FA-SYMB-48")
        ThisDrawing.Layers("CO-FA-SYMB-48").color = acRed
      Case Else
       MsgBox "This scale is not used"
     End Select
  End If
Next


Sset.Delete


ThisDrawing.SendCommand "vbaunload" & vbCr & "CO_Legends" & vbCr


End Sub