[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Find block's insertion point based on the following code to loop through all drawing block's attributes

Posted on 2005-04-22
8
Medium Priority
?
1,378 Views
Last Modified: 2010-05-18
I'm taking the following code and trying to loop through all my blocks and their attributes.
This has been working fine for me where the message box gives me basically a room number attribute of a block.
Now I will take that room number if it has a value and look in a database for it to populate that room with some blocks.
Before I begin writing the code to do this, I would like to get the block's insertion point so that as I create a new block I can just add 1 to the x and y coordinates.  Please help.
Thank you sincerely!

Public Sub Adjust_Blocks()
'On Error GoTo Err_Adjust_Blocks_Click:

    Dim acadapp As AutoCAD.AcadApplication
    Dim acadDoc As AutoCAD.AcadDocument
    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
    Dim objBlkCol As AcadBlocks
    Dim objBlk As AcadBlock
    Dim intType(0) As Integer
    Dim varData(0) As Variant
   
    Dim objBlkRef As AutoCAD.AcadBlockReference
    Dim objAttRef As AutoCAD.AcadAttributeReference
    Dim vAtts As Variant
    Dim aCode(1)      As Integer
    Dim aValue(1)     As Variant
    Dim vCode         As Variant
    Dim vValue        As Variant
    Dim iLoop         As Integer
    Dim iLoop2        As Integer
    Dim J As Long
    Dim strPath

start_over:
            'Call Create_Backup
            SysCmd acSysCmdSetStatus, "Adjusting: " & myItem & "..."
            DoEvents

            Set acadDoc = GetObject(myItem)
            Set acadapp = acadDoc.Application
            Set objSelCol = acadDoc.SelectionSets
            Set objBlkCol = acadDoc.Blocks
            SysCmd acSysCmdSetStatus, "Opening AutoCAD drawing: " & myItem & "..."
            DoEvents
           
            For Each objSelSet In objSelCol
                MsgBox "objSelSet: " & objSelSet.Name
            Next
           
            For Each objBlk In objBlkCol
                If Left$(objBlk.Name, 2) = "rn" Then
                    J = J + 1
                    'txtDoorLook = "door_TAG " & Str(J)
                    DoEvents
                    Set objSelSet = acadDoc.SelectionSets.Add("rn" & intI)
                    intType(0) = 2
                    varData(0) = objBlk.Name
                    objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
                    For iLoop = 0 To objSelSet.Count - 1
                        Set objBlkRef = objSelSet.Item(iLoop)
                        If objBlkRef.HasAttributes Then
                            vAtts = objBlkRef.GetAttributes
                            sSearchRoom = vAtts(0).TextString
                            MsgBox sSearchRoom
                        End If
                    Next iLoop
                    objSelSet.Clear
                    Set objSelSet = Nothing
                End If
            Next
            acadDoc.SetVariable "filedia", 1
       
skip_extract:
   
    'MsgBox "Finished finding all blocks in drawing..."
   
Exit_Adjust_Blocks_Click:
    On Error Resume Next
    SysCmd acSysCmdClearStatus
    Set acadapp = Nothing
    Set acadDoc = Nothing
    Set objSelCol = Nothing
    Set objBlkCol = Nothing
    Set objSelSet = Nothing
    Exit Sub
   
Err_Adjust_Blocks_Click:
    If Err = -2145320851 Then
        Set objSelSet = Nothing
        GoTo start_over:
    End If
    Call Error_Action(Err, Err.description, "frmLogOutMonitor @ Form_Close", Erl())
    Resume Exit_Adjust_Blocks_Click
End Sub
0
Comment
Question by:stephenlecomptejr
  • 4
  • 3
8 Comments
 
LVL 5

Expert Comment

by:haikle
ID: 13848370
Is this what you are looking for...

object.InsertionPoint

where
object is an acad block reference and InsertionPoint is a 3-element array of doubles
  InsertionPoint(0)
  InsertionPoint(1)
  InsertionPoint(2)
representing x, y, and z coordinates of the block reference's insertion point.

0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 13850973
yes, yes, yes...

so via the code above - would  objSelSet.InsertionPoint(0) and objSelSet.InsertionPoint(1)

currently testing it right now...
0
 
LVL 5

Expert Comment

by:haikle
ID: 13852465
Yes, except, the insertionpoint is not a property of AcadSelectionSet.

I don't think that will work.

You need to query the insertion point for AcadBlockReference objects.
0
Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 13853692
What do you mean by query the insertion point for AcadBlockReference objects?
0
 
LVL 5

Expert Comment

by:haikle
ID: 13853869
Well, you said < objSelSet.InsertionPoint(0) and objSelSet.InsertionPoint(1) >
Your objSelSet is a AcadSelectionSet object.
That object does not have insertionpoint property.

The InsertionPoint property applies to AcadBlockReference objects.
So, somewhere in your code, you should be querying the insertion point using

objBlkRef.Insertionpoint(0)
objBlkRef.Insertionpoint(1)
objBlkRef.Insertionpoint(2)
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 13870628
So let's say I had the following code:

Dim acadapp As AutoCAD.AcadApplication
Dim acadDoc As AutoCAD.AcadDocument
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim objBlkCol As AcadBlocks
Dim objBlk As AcadBlock
Dim intType(0) As Integer
Dim varData(0) As Variant
'note new entry
Dim objBlkRef As AutoCAD.AcadBlockReference
'
Dim objAttRef As AutoCAD.AcadAttributeReference
Set acadDoc = GetObject(myItem)
Set acadapp = acadDoc.Application
Set objSelCol = acadDoc.SelectionSets
Set objBlkCol = acadDoc.Blocks
'Set objBlkRef = acadDoc.?????   <----- not sure what to place here?
For Each objSelSet In objSelCol
   MsgBox "objSelSet: " & objSelSet.Name & objBlkRef.InsertionPoint(0) & " / " & objBlkRef.InsertionPoint(1)
Next
Stop
How can I query to get the AcadBlockReference object?
0
 
LVL 5

Accepted Solution

by:
haikle earned 1200 total points
ID: 13872387
I'm sorry, I don't think I understand your question then.

You define  objBlkRef using  <Dim objBlkRef As AutoCAD.AcadBlockReference>
So it's a block reference. In a given drawing, there could be 1 block reference or 1000 block reference. Or there could be NONE.

So, you can't necessarily use <Set objBlkRef = acadDoc.?????> like you can with collections or sets.

You need to use <Set objBlkRef = >  in a loop in which you search for a particular block reference.

Actually, you've already done this in your code
For iLoop = 0 To objSelSet.Count - 1
                        Set objBlkRef = objSelSet.Item(iLoop)  '<---------- Here, you've set the blk ref
                        If objBlkRef.HasAttributes Then
                            xIns = objBlkRef.Insertionpoint(0)  '<---------- Try Insertionpoint here
                            yIns = objBlkRef.Insertionpoint(1)  '<---------- and here

                            vAtts = objBlkRef.GetAttributes
                            sSearchRoom = vAtts(0).TextString
                            MsgBox sSearchRoom
                        End If
Next iLoop
0
 
LVL 14

Assisted Solution

by:Tommy Kinard
Tommy Kinard earned 800 total points
ID: 13912862
Hi stephenlecomptejr,

The macro below rotates all blocks in the current drawing 32 degrees.

Sub RotateBlock()
    Dim E As AcadBlockReference
    Dim A As AcadDocument
    Dim entry As AcadEntity
    Set A = ActiveDocument
    For Each entry In A.ModelSpace                          'for each entity in acad modelspace
        If TypeOf entry Is AcadBlockReference Then     'if it is what I am looking for do something with it
            Set E = entry
            On Error Resume Next
            E.Rotate E.InsertionPoint, 32 'rotate the block 32 degrees
            Err.Clear
            On Error GoTo 0
            Set E = Nothing
        End If
    Next
End Sub

HTH
dragontooth

0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If, like me, you find yourself repeatedly and tediously joining many segments (lines, arcs) in other people's drawings back into polylines that can be used more effectively in Computer Aided Machining and Laser Cutting, then this article is for you!…
In this article, we will see the basic design consideration while designing a Multi-tenant web application in a simple manner. Though, many frameworks are available in the market to develop a multi - tenant application, but do they provide data, cod…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
In a question here at Experts Exchange (https://www.experts-exchange.com/questions/29062564/Adobe-acrobat-reader-DC.html), a member asked how to create a signature in Adobe Acrobat Reader DC (the free Reader product, not the paid, full Acrobat produ…
Suggested Courses
Course of the Month18 days, 2 hours left to enroll

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question