TheSwamp
Code Red => VB(A) => Topic started by: ML on March 14, 2005, 05:56:50 PM
-
I was wondering if anyone had an example (assuming it is possible) that could rename a block on insert if it sees that the name already exists?
So, the drawing has a block called block1, the user inserts block1 again, the codes sees that block1 already exists and renames the one being inserted to -2 and so on.
Is this possible and does anyone have any examples that I can draw from?
Thank you
Mark
-
Why in the world would you want to do that? Use invisible attributes in the block if you're using it for some sort of counting function. It would make everyones life easier.
-
Mark, I've got to agree with Tim.
The whole purpose of having a block is so it can be inserted many times but only take up the space to define it once. By 'renaming' each insert, you would need to copy the block in the block table as the new named block and insert that......do that 50 times and you've got the exact same block defined 50 times in the block table...the only difference being in the names.
Now what if one thing needs to change in the master block? Yep, you gotta go change each one of those blocks with a different name, too.
-
Hey guys
I can see why that would seem silly at first.
Jeff, you will recall because you helped me work through the code in the previous attempts:
I am inserting a block (at a speciific scale), I want to rename its layers for very specific reason but not necessarily explode it.
I then may want to use the same block again but at a different scale and then rename its layers as well, please don't ask why :shock:
As it stands, after I insert the second block, I am asked to redefine the block, after I redefine the block, there becomes a sharing problem with the layers, then layer control becomes impossible.
I inserted the block earlier at 48, ran my macro, it renamed the layers accordingly, I then copied the block, inserted it in, ran my macro and it worked perfectly.
So, without a longer explanation, I will ask again, can this be done?
Thanks again
Mark
-
....., I will ask again, can this be done?
Thanks again
Mark
Mark, even though I helped in your previous attempts I never was clear on exactly what you were trying to do. I think I may now have a clue :D
You have BlockA whose entities were created on a specific layer "Layer1".
You now want to have sepearte block definitions based on the block's scale factor with the block's entites to be on the matching layer name, such as BlockA-48 & "Layer1-48".
When you insert this block at 48 scale you first need to see if it exists, if not you need to create the new block by copying the data from the main block, BlockA, while also creating the associated layer(s).
You DON'T want to actually rename the block everytime it's inserted....we already covered that this is not possible.(Not yet anyway, have a look at the specs for R2006......it looks like dynamic blocks may be what you are looking for).
So, to start coding we need to get from the user, or calling function or whereever, the block name to insert and the scale:
'NOTE that this is just sample coding that lacks any style, formatting, error checking or correctness.
'It is merely for the ideas...
bname = utility.getstring(vbcr & "Block to insert: ")
bscale = utility.getreal(vbcr & "Value to scale the block: ")
'Now check whether the block has already been placed:
dim oBlock as AcadBlock
On error reume next
Set oBlock = thisdrawing.blocks.item(bname & "-" & bscale)
If Err then
set oBlock = ThisDrawing.Blocks.Add(bname & "-" & bscale)
err.clear
Set oLayer = ThisDrawing.Layers.Add(the desired new layer....)
'Use the copyobjects method to copy all of the entities from the main block to the new one and change all the entities' layers in the new block to match the new layer(s)
End If
'Now insert the new block as desired on the layer desired.
Is THAT somewhat close to what you are thinking of?
-
Hey Jeff
I thought that I had e-mailed you my code with an explanation via PM?
I'm sorry I never explained but you are very close.
OK,
THe Block is actually 4 Legends. On each legend are multiple symbols which are also blocks.
Each Block with all of its symbols are on one layer.
Lets say BA-SYMB.
So, I insert the block at 48, I want BA-SYMB to become BA-SYMB-48. It is very simple.
Suppose I insert another one at 96, I then want those layers to be suffixed BA-SYMB-96.
I have the code working real well after the first one is inserted, the problem is after the second one is inserted, all layers are renamed accordingly but because the block has been redefined, all blocks will be controlled by The BA-SYMB-96 layer because that was the last inserted.
I need to be able to freeze blocks on BA-SYMB-48 and on BA-SYMB-96 individually.
The only solutions that come to mind are to either explode on insert or rename the second block which was the reason for this post.
Does this make sense?
Check out the below code
Thanks
Mark
Sub LegendLayers()
Dim BlkRef As AcadBlockReference
Dim layer As AcadLayer
Dim layers As AcadLayers
Set layers = ThisDrawing.Layers
On Error Resume Next
For Each BlkRef In ThisDrawing.ModelSpace
'Use the scale factor of the inserted block to suffix the existing layer names
'Legend Blocks Layers
For Each layer In layers
Select Case layer.Name
Case Is = ("BA-SYMB")
layer.Name = ("BA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("CA-SYMB")
layer.Name = ("ADT-CA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("D-SYMB")
layer.Name = ("D-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("FA-SYMB")
layer.Name = ("FA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("I-SYMB")
layer.Name = ("I-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("TV-SYMB")
layer.Name = ("TV-SYMB") & "-" & BlkRef.XScaleFactor
'Text Layers
Case Is = ("BA-SYMB-TEXT")
layer.Name = ("BA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("CA-SYMB-TEXT")
layer.Name = ("CA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("D-SYMB-TEXT")
layer.Name = ("D-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("FA-SYMB-TEXT")
layer.Name = ("FA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("I-SYMB-TEXT")
layer.Name = ("I-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("TV-SYMB-TEXT")
layer.Name = ("TV-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
End Select
Next
Next
End Sub
-
You want to rename your layers, insert your blocks as xrefs, change the name and insert it again. Each layer will have a different name.
-
No, that won't work Daron.
The symbols in the legend will be attributed at a later time so I will need to keep them as blocks.
The above code I put together works real well, I just have the feeling i will need to insert as exploded blocks
Thanks
Mark
-
Actually, that will not work either.
If it is exploded, then the code will fail as it is looking for a blockreference.
This takes me back to the very first question
How can I rename a block upon insertion?
Thank you
Mark
-
(command "rename" oldname newname)
sendcommand rename etc.
Then insert the block again and rename again.
would either of those work?
-
Hey Jeff
I thought that I had e-mailed you my code with an explanation via PM?
I'm sorry I never explained but you are very close. You did, but I have a hard time following my own train of thought....imagine how it is for me to follow yours :?
OK,
THe Block is actually 4 Legends. On each legend are multiple symbols which are also blocks. Right
Each Block with all of its symbols are on one layer.
Lets say BA-SYMB. Check, I'm still with you
So, I insert the block at 48, I want BA-SYMB to become BA-SYMB-48. It is very simple. Heh, if it was very simple your code would be done and working..... :D
Suppose I insert another one at 96, I then want those layers to be suffixed BA-SYMB-96. Check, again
I have the code working real well after the first one is inserted, the problem is after the second one is inserted, all layers are renamed accordingly but because the block has been redefined, all blocks will be controlled by The BA-SYMB-96 layer because that was the last inserted.
OK, this is where you keep losing me..... :idea: I think I finally see a solution......see below, after the quote..
I need to be able to freeze blocks on BA-SYMB-48 and on BA-SYMB-96 individually. Check, again
The only solutions that come to mind are to either explode on insert or rename the second block which was the reason for this post.
Does this make sense? Yes and No......
Check out the below code
Thanks
Mark
OK, so the problem is that you are renaming a block in the drawing and then trying to insert THAT block at another scale...therein lies your problem. You need to:
1. Save your base block BA-SYMB to disk
2. When you go to insert it, get the scale and check if the block BA-SYMB- & SCALE is in the drawing.
3. If not, insert the block from the disk file, NOT ANY VERSION ALREADY IN THE DRAWING. If it already exists skip to 5
4. Run the block & layer rename routine. Now you will won't have the BA-SYMB in your drawing again, so the next time you insert from the FILE, your code to rename will work just fine.
5. Insert the block as desired.......
So if all goes well, and you've inserted your block at both 48 & 96 scales, your block table would show: "BA-SYMB-48" & "BA-SYMB-96" but there would be NO "BA-SYMB"
Does that makes sense?
Jeff
-
Hey Jeff
Thanks again
I am not sure if you are following me exactly but almost.
If you look at the code that I posted, I think it pretty much explains it.
OK,
Insert block at 48, the layer names in that block become layernames-48
Insert that block again at 96, those layers become layernames-96
Now, I want to be able to freeze, turn off etc each layer without effecting other layers but that isn't happening.
I beleive it is due to the fact that after the second block is inserted, you need to redefine it, therefore all layers take the side of the last block insert.
Does that make better sense?
Thanks again
Mark
-
Jeff,
I am trying this approach: User inserts first block to scale, let's say 48,
Macro is ran. The layers get made accordingly,all is working well.
The problem is when we insert another one, so I try moving the firsrt one into place and exploding it, then I insert the second one, run the macro. The layers (the way I want them) are not created.
If I delete the first block that is exploded, then the layers for the second one will be created (layername-xscalefactor) which is no good, I need both to work.
So, my conclusion is that there is objects in the exploded block that were exposed after the block was exploded that my code doesn't like
I've since added a condition:
If blkref.objectname = "acblockreference" Then
continue
Still, I am getting a type mismatch error.
Any ideas on that as well?
Thank you
Mark
-
Daron
That rename command may just do the trick!
Thank you
Mark
-
Hey Jeff
Thanks again Sure Thing!
I am not sure if you are following me exactly but almost. Nope, I'm sure I'm following you now.....
If you look at the code that I posted, I think it pretty much explains it. If that's the case then you aren't understanding the problem.....
OK,
Insert block at 48, the layer names in that block become layernames-48 Yes, I know
Insert that block again at 96, those layers become layernames-96 Which is exactly how I explained it....
Now, I want to be able to freeze, turn off etc each layer without effecting other layers but that isn't happening. If you followed my example they would....
I beleive it is due to the fact that after the second block is inserted, you need to redefine it, therefore all layers take the side of the last block insert. No, you need to insert and rename from FILE, OR have your base block in the drawing but use CopyObjects tor create a new block.
Does that make better sense? Nope, I had it last time. If you want to have only one block definition for multiple blocks that have different characteristics, it CANNOT be done...although, as I said before, R2006 looks like it might be possible.
Thanks again You're welcome......you know, upon further reflection, you would be better off to have your different blocks saved to file and insert those, rather than have this convoluted layer & block rename deal.....
Mark
-
Jeff
Check this bit of code out
I wanted to thank Daron for the rename suggestion
Thanks Daron!
'Rename Block References
For Each BlkRef In ThisDrawing.ModelSpace
Select Case BlkRef.Name
Case Is = "LEGEND KIT-Test"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test" & vbCr & "LEGEND KIT-Test-1" & vbCr
Case Is = "LEGEND KIT-Test-1"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test-1" & vbCr & "LEGEND KIT-Test-2" & vbCr
Case Is = "LEGEND KIT-Test-2"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test-2" & vbCr & "LEGEND KIT-Test-3" & vbCr
Case Is = "LEGEND KIT-Test-3"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test-3" & vbCr & "LEGEND KIT-Test-4" & vbCr
Case Is = "LEGEND KIT-Test-4"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test-4" & vbCr & "LEGEND KIT-Test-5" & vbCr
Case Is = "LEGEND KIT-Test-5"
ThisDrawing.SendCommand "-rename" & vbCr & "Block" & vbCr & _
"LEGEND KIT-Test-5" & vbCr & "LEGEND KIT-Test-6" & vbCr
End Select
Jeff,
This part goes first and it now works like a charm
If BlockrefA is in drawing, rename to BlockrefB, If BlockrefB, rename to BlockrefC and so
By renaming the blocks first, there is no conflict between blockreference names and all seems to be working fine.
There is still one thing though:
If I explode a blockreference, then insert another one, the macro will then fail.
Any ideas?
Thanks again
Mark
-
Mark,
I fail to see how this helps you.....just because you rename it does not change the block.... The name of the block is the same as the block definition. A block reference cannot have a different name than the block definition...
Did you think about the solution I mentioned? I mean the "save multiple Wblocks of the same block with the desired layers for the different scales....that, to me, is by far your best scenario.
IOW, take your base block; change the layers to match what they'd be for a 48 scale insert; SaveAs BA-SYMB-48; now change the layers to -96 and SaveAs BA-SYMB-96 and so on. Then have your code insert the proper block based on the scale.....then change the layer of the insert to the matching scale layer.....too easy, no having to rename blocks and layers, or check if the layers exist....the only thing I'd check for is if the block is already in the drawing, if it is just insert it, if not then grab the one on disk. This should also fix your exploding problem, too.
-
Hey Jeff,
Of course I had thought about that but the person running the show here does not want multiple blocks of the same type on the server and I really don't blame him.
I am surprised that you don't see how renaming the blockreference after inserted has helped?
I wonder if you are still misunderstanding me but it is working very well.
Mark
-
Ithink but I could be wrong, that the main problem was that there were duplicate blockreferences.
Now that each one has a unique name, it seems to be fine.
When I look at it, it does seems logical that I would have to do this but it is working.
THe problem may alos be that I am not setting a reference to the block reference.
Mark
-
Ithink but I could be wrong, that the main problem was that there were duplicate blockreferences.
Now that each one has a unique name, it seems to be fine.
Mark
:shock: Ding*Ding*Ding We have a winner! :D
Mark, this is what I've been saying all along......except now you've gone further than need be.
And I just went back and saw the post that showed how you are inserting the block(s)......I'd forgotten that you were doing it via a menu macro.
I'll be right back with my recommendation for a working version for you......One quick question, though. The menu macro calls for a block INTERCONN1, or whatever, does it get inserted from a file if it's not in the drawing?
-
Mark,
I think that this covers what you want to do.
Option Explicit
Sub LegendLayers()
Dim Ent As AcadEntity
Dim BlkDef As AcadBlock
Dim BlkRef As AcadBlockReference
Dim layer As AcadLayer
Dim layers As AcadLayers
Dim blkName As String
Dim space As AcadObject
If ThisDrawing.GetVariable("cvport") = 1 Then
Set space = ThisDrawing.PaperSpace
Else
Set space = ThisDrawing.ModelSpace
End If
Set Ent = space.Item(space.Count - 1)
If TypeOf Ent Is AcadBlockReference Then
Set BlkRef = Ent
blkName = BlkRef.Name & "-" & BlkRef.XScaleFactor
On Error Resume Next
Set BlkDef = ThisDrawing.Blocks.Item(blkName)
If Err Then 'this will tell if the block has been inserted at this scale _
already and will only run the block & layer rename if it is the first one
Set BlkDef = ThisDrawing.Blocks.Item(BlkRef.Name)
BlkDef.Name = blkName
Set layers = ThisDrawing.layers
'Use the scale factor of the inserted block to suffix the existing layer names
'Legend Blocks Layers
For Each layer In layers
Select Case layer.Name
Case Is = ("BA-SYMB")
layer.Name = ("BA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("CA-SYMB")
layer.Name = ("ADT-CA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("D-SYMB")
layer.Name = ("D-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("FA-SYMB")
layer.Name = ("FA-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("I-SYMB")
layer.Name = ("I-SYMB") & "-" & BlkRef.XScaleFactor
Case Is = ("TV-SYMB")
layer.Name = ("TV-SYMB") & "-" & BlkRef.XScaleFactor
'Text Layers
Case Is = ("BA-SYMB-TEXT")
layer.Name = ("BA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("CA-SYMB-TEXT")
layer.Name = ("CA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("D-SYMB-TEXT")
layer.Name = ("D-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("FA-SYMB-TEXT")
layer.Name = ("FA-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("I-SYMB-TEXT")
layer.Name = ("I-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
Case Is = ("TV-SYMB-TEXT")
layer.Name = ("TV-SYMB-TEXT") & "-" & BlkRef.XScaleFactor
End Select
Next
BlkRef.layer = BlkDef.Item(0).layer 'put the insert on the same layer defined in the block
Else 'just rename the insert to match the name & scale
BlkRef.Name = blkName
BlkRef.layer = BlkDef.Item(0).layer 'put the insert on the same layer defined in the block
End If
End If
End Sub
-
Hey Jeff
I really appreciate your help man!
I have tried your code and it seems to be working perfectly now!
I need to look at the code closely and see where exactly I was going wrong.
Below is one of about 12 menu macros that we will use to pull the block into the drawing. When I was using Intercomm, we were bringing 4 legends in individually, now we built the whole kit in one drawing.
The below code will load and run the macro, at the end of the macro I will enter a line for unloading (UnloadDVD) the macro after the block is inserted
Thanks again.
Hope I can assist you one of these days
Mark
^C^C-insert;LEGEND-KIT;s;48;\;^C^C-vbaload;K:/"path to block";^C^C-vbarun;LegendLayers
-
OK Jeff,
It seems to working great, thanks again.
I added a few more things,
I created a variable X for XScalefactor and put in my UnloadDVD command at the end, Variable File
Now, it is precisely what I wanted
Now I can move onto the next headache, I mean challenge :lol:
Mark
Sub LegendLayers()
Dim Ent As AcadEntity
Dim BlkDef As AcadBlock
Dim BlkRef As AcadBlockReference
Dim Layer As AcadLayer
Dim Layers As AcadLayers
Dim BlkName As String
Dim Space As AcadObject
Dim File As String
Dim X As Double
File = "Path\Legends.dvb" '<-- Path to VBA Project
If ThisDrawing.GetVariable("cvport") = 1 Then
Set Space = ThisDrawing.PaperSpace
Else
Set Space = ThisDrawing.ModelSpace
End If
Set Ent = Space.Item(Space.Count - 1)
If TypeOf Ent Is AcadBlockReference Then
Set BlkRef = Ent
X = BlkRef.XScaleFactor
BlkName = BlkRef.Name & "-" & X
On Error Resume Next
Set BlkDef = ThisDrawing.Blocks.Item(BlkName)
If Err Then
Set BlkDef = ThisDrawing.Blocks.Item(BlkRef.Name)
BlkDef.Name = BlkName
Set Layers = ThisDrawing.Layers
'Use the scale factor of the inserted block to suffix the existing layer names
'Legend Blocks Layers
For Each Layer In Layers
Select Case Layer.Name
Case Is = ("BA-SYMB")
Layer.Name = ("BA-SYMB") & "-" & X
Case Is = ("CA-SYMB")
Layer.Name = ("CA-SYMB") & "-" & X
Case Is = ("D-SYMB")
Layer.Name = ("D-SYMB") & "-" & X
Case Is = ("FA-SYMB")
Layer.Name = ("FA-SYMB") & "-" & X
Case Is = ("I-SYMB")
Layer.Name = ("I-SYMB") & "-" & X
Case Is = ("TV-SYMB")
Layer.Name = ("TV-SYMB") & "-" & X
'Text Layers
Case Is = ("BA-SYMB-T")
Layer.Name = ("BA-SYMB-T") & "-" & X
Case Is = ("CA-SYMB-T")
Layer.Name = ("CA-SYMB-T") & "-" & X
Case Is = ("D-SYMB-T")
Layer.Name = ("D-SYMB-T") & "-" & X
Case Is = ("FA-SYMB-T")
Layer.Name = ("FA-SYMB-T") & "-" & X
Case Is = ("I-SYMB-T")
Layer.Name = ("I-SYMB-T") & "-" & X
Case Is = ("TV-SYMB-T")
Layer.Name = ("TV-SYMB-T") & "-" & X
End Select
Next
Else
'just rename the insert to match the name & scale
BlkRef.Name = BlkName
End If
End If
'UnloadDVB File
End Sub