Pointing to last added block (GetAttributes) and indexing blocks automatically

Pointing to last added block (GetAttributes) and indexing blocks automatically

Anonymous
Not applicable
156 Views
0 Replies
Message 1 of 1

Pointing to last added block (GetAttributes) and indexing blocks automatically

Anonymous
Not applicable
Pos.1
How can I point to the last added block to get attributes ?

Pos.2

I have following codes to put certain attribute all blocks that are added during the session. Yet,it does not function.
In following order:
1. User adds or copy's block to drawing
2. I try to add attribute (Ind comes from indexed register)
3. New attribute with index is to be added to prev. block

And, if possible attribute should be at the same area as
then block - not at position of 0,0,0.

Thanks,
Pasi

Dim bRefObj As AcadBlockReference
Dim entArray() As AcadEntity

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "ATTEDIT" Or CommandName = "ERASE" Then
Ind = 101 ' test index
a = AddAttributes(Ind)
Select Case CommandName
' Case "ATTEDIT":
' If ind=0 Then AddObjectsToBlock (bRefObj)
Case "COPY": AddObjectsToBlock (bRefObj)
End Select
SendKeys "{Esc}"
End If
End Sub

Public Function AddAttributes(Ind As Integer) As AcadEntity
Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
Dim cL As AcadLayer
Set cL = ThisDrawing.ActiveLayer
height = 1#
mode = acAttributeModeInvisible
prompt = "IB"
insertionPoint(0) = 0#
insertionPoint(1) = 0#
insertionPoint(2) = 0#
tag = "IB"
value = Str(Ind)
Set attributeObj = ThisDrawing.ModelSpace.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
ThisDrawing.ActiveLayer = cL
End Function


Public Sub AddObjectsToBlock(blkRef As AcadBlockReference, entArray() As AcadEntity)
Dim blkDef As AcadBlock, origin(0 To 2) As Double, i As Long
origin(0) = 0: origin(1) = 0: origin(2) = 0
Set blkDef = ThisDrawing.Blocks(blkRef.Name)
For i = LBound(entArray) To UBound(entArray)
entArray(i).Move blkRef.insertionPoint, origin
Next
ThisDrawing.CopyObjects entArray, blkDef
If delObj Then
For i = LBound(entArray) To UBound(entArray)
entArray(i).Delete
Next
End If
End Sub
0 Likes
157 Views
0 Replies
Replies (0)