Importing Markers using Collections

In this example, we take all the markers in Maxsurf, one at a time, and create points in 3D space in AutoCAD. The process is a simple loop that gets the marker coordinates, sets the layer according to the marker station and then adds a point in AutoCAD as shown in Figure 18.

 

Figure 18 Flow Chart for Importing Markers Using the Collection

 

The following sections of code import the markers into AutoCAD. The code has been broken up and annotated in sections.

 

Public Sub ImportMarkers()

   

    'sTime is the start time for the code execution

    sTime = VBA.Timer

 

    Dim msDesign As Maxsurf.Design  'Creates a shortcut to the design object

    Dim CoOrd(2) As Double          'This will be the coordinates of the marker point

 

   

    ThisDrawing.SetVariable "PDMODE", 32

    'This sets the style of the AutoCAD point

    ThisDrawing.SetVariable "PDSIZE", 1

    'This sets the size of the AutoCAD point

   

    msTime = 0

    slTimeIn = 0

    Set msDesign = msApp.Design    'Defines the term msDesign

 

 

The Marker object has several properties, including three that define the x, y and z coordinates for each markers location. These are the Position, Offset and Height properties. These properties are stored into an array named CoOrd(2). The AddPoint method of the AutoCAD object library requires the point to be passed in as a three variable array.

 

    For i = 1 To msDesign.markers.count

   

        'msTimeIn is the time that we call Maxsurf

        msTimeIn = VBA.Timer

        CoOrd(0) = msDesign.markers(i).Position

        CoOrd(1) = msDesign.markers(i).Offset

        CoOrd(2) = msDesign.markers(i).Height

 

        'msTime is the total time spent in Maxsurf

        'It is appended on every iteration

        msTime = msTime + VBA.Timer - msTimeIn

 

Instead of setting the layer for the point in this procedure, it is more efficient to make a call to a generic procedure for setting the layer. This way several procedures can make use of it and changes only need to be made once.

 

The sub procedure for changing the layer reads in a pre-title (“Maxsurf Markers”) and a number, in this case the marker station number. For example, a marker on station 4 will become a point on layer “Maxsurf Markers 04”.

 

        'This calls a subprocedure to set the layer for the marker

        'Requires the first part of the layer name (String) and the station

        slTimeIn = VBA.Timer

        Call SetLayer("Maxsurf Markers", msDesign.markers(i).Station)

        slTime = slTime + VBA.Timer - slTimeIn

       

        ThisDrawing.Application.ActiveDocument.ModelSpace.AddPoint (CoOrd)

       

    Next

   

    ZoomAll

    'redraw the screen so that circles are circles again

    ThisDrawing.Regen acActiveViewport

    'Returning the active layer to "0" makes deleting layers easier

    ThisDrawing.activeLayer = ThisDrawing.Layers("0")

   

    fTime = VBA.Timer - sTime

    'The command vbCrLf puts a carriage return, line feed in the MsgBox

    MsgBox "Total Execution Time was     " & fTime & " Seconds" & vbCrLf & "Total Time Calling Maxsurf   " & msTime & " Seconds" & vbCrLf & "Total Time setting layers and adding points " & slTime & " Seconds"

    

   

End Sub

 

The Call to the SetLayer procedure calls the following section of code. The code for creating a new layer in AutoCAD will be generic for most purposes so it makes sense to have it as its own entity.

 

To keep the layers ordered in the AutoCAD dialogs, layers with numbers less than ten are named with a zero before the single digit. When the layers appear in a list, they will be listed from 01 to 99. This makes handling the layers easier.

 

The code tests for the existence of each layer before creating a new layer. Although there are no direct complications when overwriting an existing layer, it can cause unwanted effects when the user has customised a layer and the customised settings are overwritten when the layer is overwritten. The code tests the name newLayer against all existing layers. If the layer exists, it makes the layer active and exits. If the layer newLayer does not exist, it creates the layer.

 

The code for creating layers reads as follows:

 

Private Sub SetLayer(PreTitle As String, Layer As Variant)

    'This sub procedure creates the new layers for other procedures

    Dim Layr As AcadLayer

   

    If Layer < 10 Then

        'Placing a zero infront of numbers less than 10 keeps the layers

            'in numerical order in the Layers Dialog

        newLayer = (PreTitle & " 0" & Layer)

    Else

        newLayer = (PreTitle & " " & Layer)

    End If

   

    For Each Layr In ThisDrawing.Layers

        If newLayer = Layr.Name Then

            ThisDrawing.Layers(newLayer).LayerOn = True

            ThisDrawing.activeLayer = ThisDrawing.Layers(newLayer)

            Exit Sub

        End If

    Next

 

    'If the Layer already exists, it will have exited already

    ThisDrawing.Layers.Add (newLayer)

    ThisDrawing.Layers(newLayer).LayerOn = True

    ThisDrawing.activeLayer = ThisDrawing.Layers(newLayer)

End Sub