TheSwamp
Code Red => VB(A) => Topic started by: cadpro on March 22, 2007, 06:00:58 AM
-
Hi,
I would like to create a VBA module to undefine Xref command, then create a new command called 'xref', then redefine it. Is this possible? Please help.
Thanks
-
No.
-
Redefine...in fact is not necessary...when a user types xref in the command line, immedietly the ActiveUCS should go to 'World', as well as the ActiveLayer should go to '0'. After that the Xref dialog box should pop up. After inserting the drawing through the xref dialog box, the layer and ucs should go back to the original as it was earlier. Can this be accomplished?
Thanks
-
Yes, you can use the BeginCommand event of the active document to do this.
Redefine...in fact is not necessary...when a user types xref in the command line, immedietly the ActiveUCS should go to 'World', as well as the ActiveLayer should go to '0'. After that the Xref dialog box should pop up. After inserting the drawing through the xref dialog box, the layer and ucs should go back to the original as it was earlier. Can this be accomplished?
Thanks
-
Don't forget XATTACH as well.
-
This is the code I wrote. But unfortunately, it's not working.
Please help.
Option Explicit
Dim CurUCS As AcadUCS
Dim CurLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
Set CurUCS = ThisDrawing.ActiveUCS
Set CurLayer = ThisDrawing.ActiveLayer
SendKeys "{Esc}"
ThisDrawing.SendCommand "ucs" & vbCr & "world" & vbCr
ThisDrawing.Layers("0").Freeze = False
ThisDrawing.Layers("0").LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
ThisDrawing.ActiveUCS = CurUCS
ThisDrawing.ActiveLayer = CurLayer
End If
End SubThanks
-
I don't think you're going to be able to effectively use the sendkeys function while you are beginning another command. You may want to take a look at programmatically setting your UCS rather than using the sendkeys function.
This is the code I wrote. But unfortunately, it's not working.
Please help.
Option Explicit
Dim CurUCS As AcadUCS
Dim CurLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
Set CurUCS = ThisDrawing.ActiveUCS
Set CurLayer = ThisDrawing.ActiveLayer
SendKeys "{Esc}"
ThisDrawing.SendCommand "ucs" & vbCr & "world" & vbCr
ThisDrawing.Layers("0").Freeze = False
ThisDrawing.Layers("0").LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
ThisDrawing.ActiveUCS = CurUCS
ThisDrawing.ActiveLayer = CurLayer
End If
End SubThanks
-
This appears to work.
Sub owcs()
Dim zero(2) As Double
Dim Xaxis(2) As Double
Dim Yaxis(2) As Double
Dim strNm As String, sUcs As String
Dim oUcs As AcadUCS
If ThisDrawing.GetVariable("WORLDUCS") = 1 Then
Exit Sub
Else
sUcs = ThisDrawing.GetVariable("UCSNAME")
'Debug.Print sUcs
Xaxis(0) = 1: Yaxis(1) = 1
Set oUcs = ThisDrawing.UserCoordinateSystems.Add(zero, Xaxis, Yaxis, "World")
ThisDrawing.ActiveUCS = oUcs
End If
End Sub
-
I duplicated WCS and it all works fine. But one problem. If the user clicks on the Xref dialog box's Cancel button, the old UCS and Layer are not restored as it doesn't execute the EndCommand Event. I have given the code to restore the old UCS and Layer in the EndCommand event. Is there a workaround?
Thanks
-
I duplicated WCS and it all works fine. But one problem. If the user clicks on the Xref dialog box's Cancel button, the old UCS and Layer are not restored as it doesn't execute the EndCommand Event. I have given the code to restore the old UCS and Layer in the EndCommand event. Is there a workaround?
Thanks
Something that has worked for me in the past, is to set a configuration variable in the begincommand event, then clear it in the end command event ... filtering of course for the proper command names ... now in the begin command event, if the variable is already set, then clear it and reset the previous settings saved in the last firing of the begincommand event.
The flow would be something like this:
[Begin Command]
<check config setting>
if settings = true
{
<reset drawing vars>
<clear config setting>
}
<verify xref call>
<set config settings>
<save current settings>
<change drawing vars>
xref command runs
[End Command]
<verify xref call>
<reset drawing vars>
<clear config setting>
This scenario would reset the previous settings that didn't get reset when xref was cancelled, immediately upon running another command .. beware however, you would also need to verify the settings using the Begin Lisp event too in order to capture most scenarios.
-
Keith,
I'm sorry I didn't understand the workaround you explained. I will give the code that I have done. Hope you will do the changes in the code, and that makes me understand better.
Option Explicit
Dim CurUCS As AcadUCS
Dim CurLayer As AcadLayer
Dim UCSs As Object
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
Set CurUCS = ThisDrawing.ActiveUCS
Set CurLayer = ThisDrawing.ActiveLayer
Call ShowWCS
ThisDrawing.Layers("0").Freeze = False
ThisDrawing.Layers("0").LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
End If
End Sub
Sub ShowWCS()
'
' Display WCS
'
Dim wcs As Object
Dim dorigin(0 To 2) As Double
Dim dxAxisPnt(0 To 2) As Double
Dim dyAxisPnt(0 To 2) As Double
dorigin(0) = 0#
dorigin(1) = 0#
dorigin(2) = 0#
dxAxisPnt(0) = 1#
dxAxisPnt(1) = 0#
dxAxisPnt(2) = 0#
dyAxisPnt(0) = 0#
dyAxisPnt(1) = 1#
dyAxisPnt(2) = 0#
Set wcs = ThisDrawing.UserCoordinateSystems.Add(dorigin, dxAxisPnt, dyAxisPnt, "WORLD")
' Display WCS.
ThisDrawing.ActiveUCS = wcs
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
ThisDrawing.ActiveUCS = CurUCS
ThisDrawing.ActiveLayer = CurLayer
ThisDrawing.UserCoordinateSystems.Item("World").Delete
End If
End Sub
If I am not wrong, I understood that the execution control never enters the EndCommand Event if the Xref dialog box is cancelled. Please help.
Thanks
-
dim bActive as boolean
set this true in your startcommand
set it false in your endcommand
if it is true when you start the startcommand then the endcommand was never activated (an escape happened). Now you reset the layers
-
Bryco,
I did what you said in the previous post, but didn't work. In the third step, you wrote, If true in StartCommand, then EndCommand never activated. So my question is, if EndCommand never activated, then the boolean is true, which is set in startcommand. so the snippet that is needed will not run.
Thanks
-
Watch the layer manager as you use the Line command ,escape yadayada
Option Explicit
Private Curlayer As AcadLayer
Private bActive As Boolean
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If bActive Then
ThisDrawing.ActiveLayer = Curlayer
End If
If CommandName = "LINE" Then
Set Curlayer = ThisDrawing.ActiveLayer
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
bActive = True
End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "LINE" Then
bActive = False
ThisDrawing.ActiveLayer = Curlayer
End If
End Sub
-
No! Didn't work.
-
That's odd works for me on 2000,2004,2006,7 &8 The instructions do include yadayada which actually means you do something else after you escape. But net will be the answer I guess.