TheSwamp
Code Red => VB(A) => Topic started by: ML 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
-
what code do you have just now ?
I'm not sure what you mean by
to handle the duplicate record error message associated with duplicate layers
this is straight out of the acad help
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
-
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
-
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?
-
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
-
Let me see what i have
-
Something like this ?
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
-
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
-
Thanks Kerry,
Thanks CMD
Sorry, I didn't Log in the last few times so I was posting as a guest.
-
This may give you some ideas ,
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
-
Note that the DoesLayerExist() is slightly different to the prev' version.
-
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
-
Good job Kerry, I got busy and couldn't post til this morning, and you beat me to it.
-
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
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
-
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
-
What about using Select Case to determine the scale factor, and then running the layer code from there
-
Yes that is very possible, a matter of fact, probable.
I just don't know how to make it overlook the existing ones.
-
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.
-
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
-
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.
-
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.
-
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.
-
Man, this module is kicking my :shock:
-
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:
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
-
or this to test for all layers
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.
-
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:
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 :
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:
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
-
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
-
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
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
-
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.
-
Hey Jeff,
I am not completely sure I understand what you are refferring to in this part :
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
-
Mark, after reading your one mention above of why you are going to these measures of wanting the layer renamed:
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
-
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
-
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
-
Hey Seven,
While you are at it, can you post the answers I need?? :D
Thanks
Mark
-
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? :?
-
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
-
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
-
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
-
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
-
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!
-
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:
'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.
-
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:
^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 =
Select Case BlkRef.XScaleFactor
Case Is = 48#
Case BlkRef.name = ("Intercomm1")
'Add layer code
or
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
-
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
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