TheSwamp
Code Red => VB(A) => Topic started by: Vince on September 20, 2006, 08:01:01 AM
-
Hi Swamp Members:
I have inherited a mess of drawings where I need to perform a lot of cleanup and reorganizing to get the blocks on the drawings standardized to company format and in usable shape.
I am relatively new to VBA and have been trying to develop a routine that could be used on a selected group of drawings and provide buttons with the following options:
1) Rename blocks on the drawings
2) Redefine blocks on the drawings
3) Replace blocks on the drawings (replace existing existing blocks with new ones)
4) Update a block and sync the attributes on the drawings
So far I have had little success in accomplishing this task.....can anyone provide some assistance or give me direction as to where I could find the sub-routines I am looking for or do some research to develop them.
Any help would be appreciated.....!
Regards,
Vince
-
This might help you for a part of it. This was originally written to changeout an old title block for a new one.
The piece below creates the Selection set of block references. I'm using an array of block names as my list. This allows me to handle different blocks in different manners. Once I find a block I'm looking for, the insert point, scale, and rotation angle are stored in variables to use later. If there are attributes these are stored an an array so that the values are not destroyed when the block is deleted.
Set objAcadSSet = ThisDrawing.SelectionSets.Add("sSet2")
intTextCodes(0) = 0 'set code for entities
varCodeValues(0) = "INSERT" 'set entity type to filter
objAcadSSet.Select acSelectionSetAll, , , intTextCodes, varCodeValues 'create set
For Each objOldBlk In objAcadSSet
BName = UCase(objOldBlk.Name)
Select Case BName
Case arOldBlkNames(0) 'ctml0011
InsertPt(0) = objOldBlk.InsertionPoint(0)
InsertPt(1) = objOldBlk.InsertionPoint(1)
InsertPt(2) = objOldBlk.InsertionPoint(2)
xScale = objOldBlk.XScaleFactor
yScale = objOldBlk.YScaleFactor
zScale = objOldBlk.ZScaleFactor
Rot = objOldBlk.Rotation
If objOldBlk.HasAttributes Then
varOldAtt = objOldBlk.GetAttributes 'get block attributes
End If
For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
Set objOldAttRef = varOldAtt(intOldCnt)
Next intOldCnt
NewBlkName = "CTML0013.dwg"
NewBlk
And this piece is the new block going back in with the attributes fed back in.
Case arOldBlkNames(0) 'CTMl0011
Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot) 'insert new tblock
varNewAtt = objNewBlk.GetAttributes 'get attributes
For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
For intNewCnt = LBound(varNewAtt) To UBound(varNewAtt)
If varNewAtt(intNewCnt).TagString = varOldAtt(intOldCnt).TagString Then
varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
End If
Next
Next
-
Hi Swamp Members:
1) Rename blocks on the drawings
Any help would be appreciated.....!
Regards,
Vince
I will cherry-pick the easy one.
Thisdrawing.Blocks("OldBlockName").Name = "NewBlockName"
-
Hi, Vince
Here is my poor attemt to solve your task,
not completed though :(
Fatty
~'J'~
-
All of those tasks have tools written for them in either ACAD or express tools. Just have a look at your menus ...