Block insertion

[a.kouchakzadeh]

Hello people, and Mr. Yuan

I'm intending to draw a block in my plan, but there is one issue and it is each time the user runs my program, I want the program to force the user to pick two points using .GetPoint (xxx) method. first point is the block InsertionPoint, and the second point is where the center of the block has to be.

the reason why I wanna do this is because the center of the block is not always at the right top. some times it will intersect with the plan. like this:

therefore I want my program let the user  to chose where the block has to appear. but its extremely important to keep the insertion point at the while lines intersection.

for example, the top picture should look like this:

any ideas how can I do this?
@norman.yuan 

[a.kouchakzadeh]

I saw this example in the "Mastering autoCAD VBA" book and its great help. but my problem is using this program, I need to create a block definition for each block reference by using some sort of loop.

 Public Sub CreateABlock()
     Dim BlockObject As AcadBlock
     Dim InputPoint1 As Variant, Radius As Double

     Dim InputPoint2 As Variant
     InputPoint1 = ThisDrawing.Utility.GetPoint(, “Insert position for block!”)
     Set BlockObject = ThisDrawing.Blocks.Add(InputPoint, “MyBlock”)
     InputPoint2 = ThisDrawing.Utility.GetPoint(, “Insert position for circle’s center!”)
     Radius = ThisDrawing.Utility.GetDistance(InputPoint, “Insert radius!”)
     BlockObject.AddCircle InputPoint2, Radius
     BlockObject.AddBox InputPoint2, Radius, Radius, Radius
 End Sub

[Ed__Jobe · Accepted solution]

Why not just create a dynamic block with a stretch parameter? That's essentially what you're trying to do. A dynamic block creates an anonymous block for each variation of the original block. That's what your program would have to do since the center of the tag is at different places in relation to the insertion point.

[a.kouchakzadeh]

Hello Ed and thanks for your reply

Unfortunately im not familiar with dynamic blocks and stretch parameter. I assume i gotta read about it a bit and then come back. 

[a.kouchakzadeh]

Ed, 
Are you sure its possible to create a dynamic block in VBA autocad?

[Ed__Jobe]

I was just suggesting that you create one instead of trying to write code that already has that functionality built into AutoCAD.

[Ed__Jobe]

Here's a sample. Insert the block and place the leader at the desired insertion point. Then select the block and click on the center grip to move the tag.

[a.kouchakzadeh]

that was great Ed.

I added another action to your block. a point parameter; and set a move action for it. its working pretty well. how ever, lets say I created the Dynamic Block manually. is there any way, when running the program, the user is asked to enter the top attribute, bottom attribute, block insertion point, and the point where the center of the block has to appear? 

Im running this code but its giving an error:

Public Sub AddABlock()
    Dim BlockReference As AcadBlockReference
    Dim InputPoint As Variant
    InputPoint = ThisDrawing.Utility.GetPoint(, "Input the position for the block!")
    Set BlockReference = ThisDrawing.ModelSpace.InsertBlock(InputPoint, "tag (1)", 1, 1, 1, 0)
End Sub

P.S: sorry for adding questions to the topic. 

[Ed__Jobe]

You can use Utility.GetPoint and GetString to prompt the user for that info and then supply them to the ModelSpace.InsertBlock method. Then use the return from that method and manipulate where the tag goes. I haven't tried it, but I think it should work.

Before you insert the block, you should check the Doc.Blocks collection to see if it exists in the dwg, and if not supply the full path to the InsertBlock method.

[a.kouchakzadeh]

I added another block which was "TAG1" Instead of "Tag (1)"

This one is working fine with this code:

Public Sub AddABlock()
    Dim BlockReference As AcadBlockReference
    Dim InputPoint As Variant
    InputPoint = ThisDrawing.Utility.GetPoint(, "Input the position for the block!")
    Set BlockReference = ThisDrawing.ModelSpace.InsertBlock(InputPoint, "tag1)", 1, 1, 1, 0)
End Sub

but when executing, the program even doesnt ask me to enter the attribute and just sets A as its attribute.

how can I fix this and make it ask the user for the attribute first?

[Ed__Jobe]

As I said, use GetString to prompt for an attribute string.

You have :

Set BlockReference = ThisDrawing.ModelSpace.InsertBlock

Also use the GetPoint method to prompt for the second point. Using the last point in the argument will draw a rubberband to the cursor.

Dim CtrPoint as variant

CtrPoint = ThisDrawing.GetPoint( InputPoint, "prompt")

Use the BlockReference object to do the rest, like GetAttributes.

[Ed__Jobe]

This is close, but I haven't figured out how to translate the center point to the block's coordinate system.

Sub PlaceTag1()
    Dim InsPt As Variant
    Dim CtrPt As Variant
    Dim strAtt As String
    Dim strBlk As String
    Dim Blk As AcadBlock
    Dim BlkRef As AcadBlockReference
    
    
    strBlk = "TAG1"
    For Each Blk In ThisDrawing.Blocks
        If Not Blk.Name = strBlk Then
            strBlk = "N:\filepath\TAG1.dwg"
        End If
    Next
    
    InsPt = ThisDrawing.Utility.GetPoint(, "Pick insertion point of leader.")
    Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(InsPt, strBlk, 1, 1, 1, 0)
    strAtt = "A"
    strAtt = ThisDrawing.Utility.GetString(0, "Enter attribute text. [" & strAtt & "]")
    Dim att As AcadAttributeReference
    Dim atts As Variant
    atts = BlkRef.GetAttributes
    Set att = atts(0)
    att.TextString = strAtt
    att.Update
    
    CtrPt = ThisDrawing.Utility.GetPoint(InsPt, "Pick center point of tag.")
    Dim OcsNormal As Variant
    OcsNormal = BlkRef.Normal
    Dim CtrPtOCS As Variant
    CtrPtOCS = ThisDrawing.Utility.TranslateCoordinates(CtrPt, acUCS, acOCS, False, OcsNormal)
    Dim DynProps As Variant
    DynProps = BlkRef.GetDynamicBlockProperties
    'set X
    Dim dbprop As AcadDynamicBlockReferenceProperty
    Set dbprop = DynProps(0)
    dbprop.Value = CtrPtOCS(0)
    'set Y
    Set dbprop = DynProps(1)
    dbprop.Value = CtrPtOCS(1)
    
    
End Sub

[a.kouchakzadeh]

Thanks Ed. this was a great help. as you mentioned the only problem left is the coordinates system which is acting goofy. I couldn't find any thing to fix it so far but if I came up with some thing, I'll post it

[Ed__Jobe · Accepted solution]

I made the following revisions.

    'set X
    Dim dbprop As AcadDynamicBlockReferenceProperty
    Set dbprop = DynProps(0)
    dbprop.Value = CtrPtOCS(0) - InsPt(0)
    'set Y
    Set dbprop = DynProps(1)
    dbprop.Value = CtrPtOCS(1) - InsPt(1)

[a.kouchakzadeh]

well Done Sir.

That was Amazing!

[Ed__Jobe]

Another idea came to me. You can simply use a multileader. Attached is a dwg with a style called HEX. The advantage of using a leader is that you can take advantage of it's ability to always have the leader landing be horizontal and automatically align to the left or right depending on the quadrant.

You can modify the routine to add a leader instead of a block.