VBA help - block insertion

[matt_HH]

Hi There

Sorry that this will be such a basic question. I am not a VBA expert in any way....quite new actually . Running Autocad Architecure 2014. 

I have a VBA utility that I have made a special button for. I want this button to insert a dynamic block.

I have WBLOCK'ed the block and it is in a nework folder - no issues here.

There are several other snippets of VBA code that I have found online ands have tried to modify them to work. I must be doing something wrong, as it always stumbles within the code or silently sits there doing nothing.

I just want to click this button and my dynamic block (from network)  will be brought into the existing drawing, and the user will select insert point and direction..... Mouse click...done....block inserted. Similar action to a block that would be brought from a tool pallette (but has to be from this VBA utility)

Any help would be appreciated.

Matt

[Alfred.NESWADBA]

Hi,

show the code you tried, show the dwg you like to insert and give us all messages you might get during debuging.

Then we know more about where you are and what data you are working with. By default inserting a dynamic block does not make a difference to inserting a "normal" block.

- alfred -

[matt_HH]

Hi Alfred

I have made some progress. I can now insert the block and it works....woo hoo.

All I require now is for the user to be able to set the rotation angle after clicking the insertion point. How would I do this? I hilighted the code to red for the spot I think I am missing something to rotate the block.

thanks

------------------------------------------------------------------

Private Sub cmdProfileinsert_Click()
 
Dim strPath As String
Dim strBlockName As String
Dim objBlock As AcadBlock
Dim entRef As AcadBlockReference
Dim dblPkPt() As Double
   strBlockName = "Profile"
   strPath = "H:\blah\blah\Profile.dwg"
   On Error Resume Next
   Set objBlock = ThisDrawing.Blocks.Item(strBlockName)
   On Error GoTo 0
   If Not objBlock Is Nothing Then objBlock.Delete 'To reinitialize Block from container file
   DbxCopyBlock strBlockName, strPath 'Copy block into ThisDrawing
   dblPkPt = ThisDrawing.Utility.GetPoint(, "Pick insertion Point: ") 'Get insertion point for test insert
   Set entRef = ThisDrawing.ModelSpace.InsertBlock(dblPkPt, "Profile", 1#, 1#, 1#, 0) 'Test insert
      
End Sub

[Alfred.NESWADBA]

Hi,

>> I am missing something to rotate the block

The last parameter (0 in your case) is the value for rotation (measured in radiant).

- alfred -

[matt_HH]

Hi there

>>The last parameter (0 in your case) is the value for rotation (measured in radiant).

So how would I make it so the user could select the angle or degree that suits them?

Matt

[Alfred.NESWADBA]

Hi,

you mean the user should see the block rotating (in drag mode) while moving the mouse or the user should first input a rotation value and that has to be used then?

First option is tricky or you use ThisDrawing.SendCommand ... I know that this should be avoided as long as possible, but in that case it's one code line compared to a big amount of code when you try to simulate the rotation draging.

The second option could be done by

Dim AngleRad as Double
AngleRad = ThisDrawing.Utility.GetAngle(dblPkPt,"Rotation: ")

...and use the resulting angle as your last parameter in your insert-code.

- alfred -

[matt_HH]

Good morning.

it would be preferable to have the user select the direction of the block by draging the mouse in the correct direction.

Click the button, and select input location then be able to drag the block on the direction they want to place on drawing.

9 times out of 10 it will be in 90º selections (place on drawing and go either up, down, left or right)

thanks

PS.....sorry for being a pain

[Alfred.NESWADBA]

Hi,

to avoid a lot of coding I would first start my suggestion with ThisDrawing.SendCommand

Let's know if that is working for you ... or if not, why not.

- alfred -

[matt_HH]

Hello again

Im sorry for bing a VBA dummy (this could easliy answer the 'why not' portion of your post...lol.

I am not sure of the proper nomenclature for the .SendCommand line (you mentioned in earlier post it could be one line).

would it get added after the 'pick insertion point' line or would it replace the last line?

Private Sub cmdProfileinsert_Click()
 
Dim strPath As String
Dim strBlockName As String
Dim objBlock As AcadBlock
Dim entRef As AcadBlockReference
Dim dblPkPt() As Double
   strBlockName = "Profile"
   strPath = "H:\blah\blah\Profile.dwg"
   On Error Resume Next
   Set objBlock = ThisDrawing.Blocks.Item(strBlockName)
   On Error GoTo 0
   If Not objBlock Is Nothing Then objBlock.Delete 'To reinitialize Block from container file
   DbxCopyBlock strBlockName, strPath 'Copy block into ThisDrawing
   dblPkPt = ThisDrawing.Utility.GetPoint(, "Pick insertion Point: ") 'Get insertion point for test insert
   Set entRef = ThisDrawing.ModelSpace.InsertBlock(dblPkPt, "Profile", 1#, 1#, 1#, 0) 'Test insert

End Sub

[Alfred.NESWADBA]

Hi,

does that help?

Option Explicit
Const tBlName As String = "X_AL_AL_Schriftkopf"    'the blockname ... change it to your blockname

Public Sub test()
   'first get a point
   On Error Resume Next
   Dim tPnt As Variant
   tPnt = ThisDrawing.Utility.GetPoint(, "Insertion Point: ")
   If Err.Number <> 0 Then
      'insertion point cancelled or invalid
   Else
      'now the insertion command
      Dim tInsCmd As String
      tInsCmd = tInsCmd & "_-INSERT" & vbCr & tBlName & vbCr
      tInsCmd = tInsCmd & PntToStr(tPnt) & vbCr
      tInsCmd = tInsCmd & "XYZ" & vbCr & "1" & vbCr & "1" & vbCr & "1" & vbCr
      Call ThisDrawing.SendCommand(tInsCmd)     'this command ends with request of rotation
   End If
End Sub

Private Function PntToStr(ByVal Pnt As Variant) As String
   'conversion of an array of 3 doubles to a command-line string
   Dim tStr As String: tStr = ""
   tStr = tStr & Replace(Pnt(0), ",", ".") & ","   'X-value
   tStr = tStr & Replace(Pnt(1), ",", ".") & ","   'Y-value
   tStr = tStr & Replace(Pnt(2), ",", ".")         'Z-value
   PntToStr = tStr   'return the coordinate as command line string
End Function

HTH, - alfred -

[matt_HH]

good morning.

I get variable not defined erron on for tBlName

Do I need to have a line in there that identifies the location of the block from the network??

eg - strBlockName = "Profile"
   strPath = "H:\blah\blah1\blah2\Profile.dwg"

[Alfred.NESWADBA]

Hi,

define a variable for your blockname (if not already defined in your drawing then including the full oath- & filename).

- alfred -