Insert block whilst displaying it

[Anonymous]

I have searched the NGs and this is partially answered in many posts but I
can't seem to find a solution.
I want to pause for user input whilst inserting a block as I want the user
to be able to provide the insertion point and possibly change the rotation
angle (which I achieved with "r 90" etc selected from a menu) and of course
trap that the user may Escape etc. I iterate through many blocks doing this
then programmatically update attributes using .
I had this all working great with the following code but it crashes when
using the mouse to pan:-

GetPoint:
ThisDrawing.SendCommand "-Insert" & vbCr & blockName & vbCr & "R" & vbCr
& Rotation & vbCr & "S" & vbCr & "1" & vbCr
If InStr(ThisDrawing.GetVariable("LASTPROMPT"), "*Cancel*") > 0 Then
Exit Function
If InStr(ThisDrawing.GetVariable("LASTPROMPT"), "Command:") > 0 Then
Exit Function
If InStr(ThisDrawing.GetVariable("LASTPROMPT"),
"[Basepoint/Scale/X/Y/Z/Rotate]:") > 0 Then GoTo SetBlock
'any other response reissue command
GoTo GetPoint
SetBlock:
Set oBlockRef =
ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
Rotation = oBlockRef.Rotation
........

Why this is happening has been explained so I want to find the next best
solution, preferably without resorting to DLLs, ObjectARX, .Net etc. I have
seen suggestions with lisp including the following:-

(command "-insert" block pause "" "")

But if I issue a sendcommand with the above it continues processing the code
that follows. Is there a VBA / lisp solution?

Many thanks in anticipation

Dave Preston

[gizmowiebe]

Dave you can try the following code. It is something I use to get users input


Sub test()

Insertblock "C:\block.dwg"

End Sub


Function Insertblock(ByVal blockname As String)


Dim pnt, pnt2 As Variant

prompt1 = vbCrLf & "Enter block insert point: "

' Get the first point without entering a base point


pnt = ThisDrawing.Utility.GetPoint(, prompt1)

Set blockRefObj = ThisDrawing.ModelSpace.Insertblock(pnt, blockname, 1#, 1#, 1#, 0)

On Error Resume Next

blockRefObj.Rotate pnt, ThisDrawing.Utility.GetAngle(pnt, "Select Rotation Angle:")

End Function

[Anonymous]

Thanks, but that does not display the block for the user to place

Dave Preston

"gizmowiebe" wrote in message news:5858762@discussion.autodesk.com...
Dave you can try the following code. It is something I use to get users
input


Sub test()

Insertblock "C:\block.dwg"

End Sub


Function Insertblock(ByVal blockname As String)


Dim pnt, pnt2 As Variant

prompt1 = vbCrLf & "Enter block insert point: "

' Get the first point without entering a base point


pnt = ThisDrawing.Utility.GetPoint(, prompt1)

Set blockRefObj = ThisDrawing.ModelSpace.Insertblock(pnt, blockname, 1#,
1#, 1#, 0)

On Error Resume Next

blockRefObj.Rotate pnt, ThisDrawing.Utility.GetAngle(pnt, "Select
Rotation Angle:")

End Function

[Anonymous]

Here is I posted earlier:

comStr = "(command " & _
Chr(34) & "._-insert" & Chr(34) & _
vbCr & Chr(34) & blkName & _
Chr(34) & " pause" & vbCr & _
Chr(34) & "1" & Chr(34) & _
vbCr & Chr(34) & "1" & Chr(34) & _
vbCr & Chr(34) & "0" & Chr(34) & ")"
.SendCommand comStr & vbCr

~'J'~

[Anonymous]

Thanks Fatty, but this doesn't resolve the main issue in that it cannot
handle pan

wrote in message news:5860940@discussion.autodesk.com...
Here is I posted earlier:

comStr = "(command " & _
Chr(34) & "._-insert" & Chr(34) & _
vbCr & Chr(34) & blkName & _
Chr(34) & " pause" & vbCr & _
Chr(34) & "1" & Chr(34) & _
vbCr & Chr(34) & "1" & Chr(34) & _
vbCr & Chr(34) & "0" & Chr(34) & ")"
.SendCommand comStr & vbCr

~'J'~

[Anonymous]

Dave there is no good way in vba.
I use a function in a sendcommand function to see if pan has been used and if so I exit. It works fine for me but if someone actually types 'p, not so good (do people actually do that?) I don't have a tool bar with pan in it to know if that works. I have told people that they are on their own if they don't want to use the middlebutton and have had no complaints

If Panned Then
Exit Function
End If
If EscPressed Then
Exit Function
End If

[code]
Public Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer

Public Const VK_ESCAPE = &H1B
Public Const VK_LBUTTON = &H1
Public Const VK_SPACE = &H20
Public Const VK_RETURN = &HD
Public Const VK_LEFT = &H25
Public Const VK_MBUTTON = &H4


Function Panned() As Boolean
Dim varCancel As Variant
varCancel = ThisDrawing.GetVariable("LASTPROMPT")
If varCancel = "Specify rotation angle: 0" Then
If GetAsyncKeyState(VK_MBUTTON) < 0 Then
Panned = True
End If
Else
Panned = False
End If
End Function
[/code]

[Anonymous]

Hi Bryco, thanks for the response and you obviously have encountered the
same issue and have a solution that would avoid the crash.
I am only talking about using the mouse wheel to pan.
It looks as though what you're doing is stopping them pan, but this seems
unreasonably limiting as it's a natural thing to do when placing many
blocks, or have I missed something?

Dave Preston

wrote in message news:5862048@discussion.autodesk.com...
Dave there is no good way in vba.
I use a function in a sendcommand function to see if pan has been used and
if so I exit. It works fine for me but if someone actually types 'p, not so
good (do people actually do that?) I don't have a tool bar with pan in it to
know if that works. I have told people that they are on their own if they
don't want to use the middlebutton and have had no complaints

If Panned Then
Exit Function
End If
If EscPressed Then
Exit Function
End If

[code]
Public Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer

Public Const VK_ESCAPE = &H1B
Public Const VK_LBUTTON = &H1
Public Const VK_SPACE = &H20
Public Const VK_RETURN = &HD
Public Const VK_LEFT = &H25
Public Const VK_MBUTTON = &H4


Function Panned() As Boolean
Dim varCancel As Variant
varCancel = ThisDrawing.GetVariable("LASTPROMPT")
If varCancel = "Specify rotation angle: 0" Then
If GetAsyncKeyState(VK_MBUTTON) < 0 Then
Panned = True
End If
Else
Panned = False
End If
End Function
[/code]

[mdhutchinson]

IMOH your best best is to use lisp for this.

lisp far and away exceeds vba in this sort of thing.

[Anonymous]

No the user can still pan, you just don't get to run the rest of your function, change the atts, layers etc

[code]
Public Function InsertBySendCommand(BlockName As String, Optional strlayer As String, _
Optional dblScale As Double = 1, Optional blnRot As Boolean = False, _
Optional strAttTag As String) As AcadBlockReference
Dim curAttreq As Integer
curAttreq = ThisDrawing.GetVariable("ATTREQ")
If curAttreq = 1 Then
ThisDrawing.SetVariable "ATTREQ", 0
End If
ThisDrawing.SetVariable "DRAGMODE", 2
If blnRot = True Then
ThisDrawing.SendCommand "-insert" & vbCr & BlockName & vbCr & "s" _
& vbCr & dblScale & vbCr & "r" & vbCr & "0" & vbCr
Else
ThisDrawing.SendCommand "-insert" & vbCr & BlockName & vbCr & "s" & vbCr & dblScale & vbCr
End If
If Panned Then
Exit Function
End If
If EscPressed Then
Exit Function
End If
'ADD STUFF

End Function


Sub testinsert()
InsertBySendCommand "b"

End Sub
[/code]