Author Topic: Using draworder via VBA  (Read 7843 times)

0 Members and 1 Guest are viewing this topic.

Kthulu

  • Guest
Using draworder via VBA
« 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

Arizona

  • Guest
Re: Using draworder via VBA
« Reply #1 on: February 16, 2006, 06:18:07 AM »
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?

Kthulu

  • Guest
Re: Using draworder via VBA
« Reply #2 on: February 16, 2006, 06:56:01 AM »
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

Glenn R

  • Guest
Re: Using draworder via VBA
« Reply #3 on: February 18, 2006, 07:54:03 PM »
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...

Code: [Select]
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.