Change Block Attribute base on Insertion Point

[tptaylor]

I have a group of blocks, SCP1, SCP2, and SCP3 that each hold an attribute called panelnumber. These blocks are placed in the drawing automatically in a VB module that takes user input values. These blocks are placed in the drawing and are stacked in a series of columns and rows. The number of columns and rows varies. The panel numbers are sequentially placed with the first block being on column 1, row 1, then column 1 row 2, so from left to right top to bottom. There are times when a block maybe removed and another block added. I am looking for a way to renumber the blocks by selecting them in a window then renumbering them from left to right top to bottom.

How do I get the insertion point of the blocks?

Thanks

[borgunit]

Create a selection set of the blocks and then cycle through each one of them in the selection set ie

For Each acBlk in acSset
    vPts = acBlk.InsertionPoint
Next acBlk

You could store the insertion points in an array and then sort them out how you want.

[tptaylor]

Thanks for the reply.

I am new to array's. I have been able to call the blocks, find the minimum and maximum x and y coordinate. Count the number of columns and rows. I do not know how to define an array and then sort them according to x and y coordinates. Can you point me to an example code snippet that uses arrays? Your help is appreciated.

[borgunit]

Dim vPts() as variant '<< an array
Dim i as integer

i = 0
For Each acBlk in acSset
    ReDim Preserve vPts(1, i) '<< dimension the array each pass
    vPts(0,i) = acBlk.InsertionPoint(0)
    vPts(1,i) = acBlk.InsertionPoint(1)
    i = i + 1
Next acBlk

[tptaylor]

Thanks I will try that.

I need to sort, by x and y (min to max) then change an attribute tag "panel number" sequentially top to bottom left to right. Blocks are “SCP1”, “SCP2” and “SCP3”

Any thoughts

[borgunit]

http://www.freevbcode.com/ShowCode.asp?ID=2530

[tptaylor]

Thanks! Just what I was looking for!

[tptaylor]

Borgunit many thanks

Here is what I finally used.

This program will search an ACAD drawing for blocks called SCP (SCP* finds SCP1, SCP2, and SCP3). When it finds the block it stores the insertion point of the block into a data array. It then sorts the data array according to the x value then the y value. Once it sorts the data it then calls each block based on the x and y coordinate and finds an attribute value "PANELNUMBER" and sequentially numbers the panels based on the x and y value (x column left to right, y row top to bottom).
I have to give major credit to a colleague of mine who cleaned my code up to get it to look like this.

 
Function reNumberPanels()
Dim myBlock As AcadBlockReference
Dim oBkRef As AcadBlockReference
Dim i As Integer, J As Integer, temp As Double
Dim DArray() As Double
Dim PanelNumber As Integer
Dim ssetObj As AcadSelectionSet
Dim mode As Integer
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim varAttributes As Variant, k As Integer
 
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
mode = acSelectionSetAll
gpCode(0) = 8
dataValue(0) = "ATTRIB"
ssetObj.Select mode, , , gpCode, dataValue
'******** Determine the coordinates for the SCP* blocks and set in Data Array **************'
Dim ik As Integer
ik = -1
For i = 0 To ssetObj.Count - 1
If TypeOf ssetObj(i) Is AcadBlockReference Then
Set oBkRef = ssetObj(i)
If UCase(oBkRef.Name) Like "SCP*" Then
ik = ik + 1
ReDim Preserve DArray(1, ik)
DArray(0, ik) = oBkRef.InsertionPoint(0)
DArray(1, ik) = oBkRef.InsertionPoint(1)
End If
End If
Next i
'******** Sort the dtat array by x then y coordinate **************'
For i = 0 To UBound(DArray, 2) - 1
For J = i + 1 To UBound(DArray, 2)
If Round(DArray(0, i), 2) > Round(DArray(0, J), 2) Then
temp = DArray(0, i)
DArray(0, i) = DArray(0, J)
DArray(0, J) = temp
temp = DArray(1, i)
DArray(1, i) = DArray(1, J)
DArray(1, J) = temp
Else
If Round(DArray(0, i), 2) = Round(DArray(0, J), 2) Then
If Round(DArray(1, i), 2) > Round(DArray(1, J), 2) Then
temp = DArray(0, i)
DArray(0, i) = DArray(0, J)
DArray(0, J) = temp
temp = DArray(1, i)
DArray(1, i) = DArray(1, J)
DArray(1, J) = temp
End If
End If
End If
Next
Next
 
'******** Search the for the "PANELNUMBER" attribute by Data Array and reset values sequtinally **************'
If ssetObj.Count > 0 Then ssetObj.Clear
ssetObj.Select mode, , , gpCode, dataValue
For i = 0 To ssetObj.Count - 1
If TypeOf ssetObj(i) Is AcadBlockReference Then
Set oBkRef = ssetObj(i)
If UCase(oBkRef.Name) Like "SCP*" Then
For J = 0 To UBound(DArray, 2) - 1
If Round(DArray(0, J), 2) = Round(oBkRef.InsertionPoint(0), 2) And Round(DArray(1, J), 2) = Round(oBkRef.InsertionPoint(1), 2) Then
varAttributes = oBkRef.GetAttributes
For k = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(k).TagString = "PANELNUMBER" Then
varAttributes(k).TextString = J + 1
varAttributes(k).Update
End If
Next k
End If
Next
End If
End If
Next
 
ThisDrawing.SelectionSets("SSET").Delete
End Function