TheSwamp
Code Red => VB(A) => Topic started by: Kthulu on February 16, 2006, 04:06:43 AM
-
I have some code to try and handle xref insertions into our company drawings. The first part of the code works as expected, waits for a command to be issued, checks for layer, sets it if the layer exists, creates it if not. What I am then trying to do is use the sendcommand function to attempt to send the newly attached xref to the back via draworder. I know this code won't work as it will attempt to do this before the xref is attached and will send the last object added to the back. But I am unsure of how to issue the command after xref command has been completed.
Any help would be greatfully appreciated.
p.s I am a novice at this stuff so be gentle with the programming lingo...
Chris
Option Explicit
' set the public object current Layer to be an AutoCAD Layer
Public objCurrentLayer As AcadLayer
' set the public object Previous Layer to be an AutoCAD Layer
Public objPreviousLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
' Save the current / active AutoCAD layer
Set objPreviousLayer = ThisDrawing.ActiveLayer
' Check for the folowing cases of the AutoCAD command.
Select Case CommandName
' check for AutoCAD Xref commands..
Case "XREF"
If Not ThisDrawing.ActiveLayer.Name = "0" Then
Set objCurrentLayer = ThisDrawing.Layers.Add("0")
objCurrentLayer.color = acWhite
objCurrentLayer.LayerOn = True
objCurrentLayer.Freeze = False
objCurrentLayer.Lock = False
ThisDrawing.ActiveLayer = objCurrentLayer
ThisDrawing.SendCommand "draworder" & vbCr & "l" & vbCr & vbCr & "back" & vbCr
' end of if checking for 0 being the current layer.
End If
End Select
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
' Check for the folowing cases of the AutoCAD command that has just ended.
Select Case CommandName
' check for a match on the following AutoCAD commands
Case "XREF"
' make the current active AutoCAD layer the previously saved layer.
ThisDrawing.ActiveLayer = objPreviousLayer
' clear the objCurrentLayer
Set objPreviousLayer = Nothing
End Select
' clear the objCurrentLayer
Set objCurrentLayer = Nothing
' end Private Sub AcadDocument_EndCommand
End Sub
-
What version of acad are you working with?
Also I found this http://usa.autodesk.com/adsk/servlet/ps/item?id=2878365&linkID=2475323&siteID=123112 in the Autodesk knowledge base. Is the solution they offer something that might work for you via VBA?
-
What version of acad are you working with?
2006
Also I found this http://usa.autodesk.com/adsk/servlet/ps/item?id=2878365&linkID=2475323&siteID=123112 in the Autodesk knowledge base. Is the solution they offer something that might work for you via VBA?
Draworder works for xref's in 2006 (Or at least in our office it does!)
I've just realized I'v posted this in the wrong forum, good start to my pennies worth, what a k**b! :ugly:
Chris
-
Hmmm...a couple of points.
1. You should NEVER issue a 'Command' call inside a reactor/event. It's possible to get into an endless loop for one thing.
2. There's no 'reliable' way in VBA to tell if a command was cancelled. So you have to deal with the possibility that the 'CommandEnded' event will not fire.
3. Also, somebody could just go into the reference manager and do nothing but view the list. Your event would fire, but the user has not attached another xref.
I think you can start to see that this is not as easy as it sounds.
However, having said that, here is a VERY quick knockup. Paste it into the 'ThisDrawing' module and give it a whirl...
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case "XREF", "XATTACH"
' Get the last entity in the current space. The command *might* not have done anything...
Dim pEnt As AcadEntity
Set pEnt = ThisDrawing.CurrentSpace(ThisDrawing.CurrentSpace.Count - 1)
' Bail out if it's NOT an xref...
If Not TypeOf pEnt Is AcadExternalReference Then Exit Sub
'Gxet an extension dictionary and, if necessary, add a SortentsTable object
Dim pXDict As AcadObject
Set pXDict = ThisDrawing.CurrentSpace.GetExtensionDictionary
' Enable in-line error handling...
On Error Resume Next
Dim pSortEntsTbl As AcadSortentsTable
' Try and get a pointer to the existing (if there is one) SortEntsTable...
Set pSortEntsTbl = pXDict.GetObject("ACAD_SORTENTS")
If Err Then Err.Clear
If pSortEntsTbl Is Nothing Then
' No SortentsTable object, so add one
Set pSortEntsTbl = pXDict.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
' Resume 'normal' error handling...
On Error GoTo 0
Dim entArray(0) As AcadObject
Set entArray(0) = pEnt
' Move the object to the bottom of the draworder...
pSortEntsTbl.MoveToBottom entArray
AcadApplication.Update
End Select
End Sub
Public Property Get CurrentSpace() As AcadBlock
If ThisDrawing.GetVariable("CVPORT") = 1 Then
Set CurrentSpace = PaperSpace
Else
Set CurrentSpace = ModelSpace
End If
End Property
BTW, look up AcadSortEntsTable in the AutoCAD VBA Help. This is the draworder table.
Cheers,
Glenn.