Saturday, July 05, 2008

Sample Lines VBA

I'm currently remodeling my kitchen, while my drywall is drying I'd thought I'd write some code to create sample lines at odd station intervals (ie. start at 0+08 and continue every 50 feet (ie. 0+08, 0+58, 1+08,...) for a poster on the DG. Civil 3D will start the sample lines at the start station you want, but then will sample at every 50 foot section (ie. 0+08, 0+50, 1+00,...). The code modifications are based on 2009, but should work with 2008 (just haven't had a chance to test it).

Since we don't want to start from scratch I'll start with the sample code that comes with the Civil 3D, in this case I'm going to start the section line sample code: C:\Program Files (x86)\AutoCAD Civil 3D 2009\Sample\Civil 3D API\Vba\Section\SectionSample.dvb (use vbaman to load the file, and choose the Visual Basic Editor to open it).


So now we need to have the user select an alignment and check to make sure they selected an alignment. The following will code will accomplish this:

        ' Have the user select an alignment
Dim oAcadObject As Object
Dim entbasepnt As Object
ThisDrawing.Utility.GetEntity oAcadObject, entbasepnt, "Select an alignment: "
If (TypeOf oAcadObject Is AeccAlignment) Then
oAlignment = oAcadObject
MsgBox("You didn't select an alignment.")
Exit Sub
End If

If the user doesn't select an alignment the program will end and they will need to restart the routine. Now we need to edit the CreateSampleLineGroup code in the SampleLine module. Below are the parts that can be deleted or modified to match your template.


Since we deleted some lines that created a style and used that one, we need to add in the what the program should use. I'm just going to use the first one in the list under Toolspace for the respective type. You could modify the code to use the type you want. The code is below and should be placed above where the oSampleLineGroup is set:

        ' Add a new group to hold the sample lines we will make.
Dim oSampleLineGroup As AeccSampleLineGroup
' Set the oGroupPlotStyle as the default
Dim oGroupPlotStyle As AeccGroupPlotStyle
oGroupPlotStyle = g_oDocument.GroupPlotStyles.Item(0)
' Set the oSampleLineStyle as the first one on the list
Dim oSampleLineStyle As AeccSampleLineStyle
oSampleLineStyle = g_oDocument.SampleLineStyles.Item(0)
' Set the oSampleLineLabelStyle as the first one in the list
Dim oSampleLineLabelStyle As AeccLabelStyle
oSampleLineLabelStyle = g_oDocument.SampleLineLabelStyles.Item(0)

Next we need to prompt the user for the various values he/she wants to sample for. The following code is vary basic and could be improved greatly with the use of a form similar to the one that is in Civil 3D. The values for the starting station and ending station are just for information and won't be used as a default, it just made it easier to check to make sure the program worked as intended:

        ' Prompt the user to provide a swath width right
dSwathWidthRight = ThisDrawing.Utility.GetReal("Enter swath width for right side: ")

' Prompt the user to provide a swath width left
dSwathWidthLeft = ThisDrawing.Utility.GetReal("Enter swath width for left side: ")

' Prompt the user for the starting station
dStationStart = ThisDrawing.Utility.GetReal("Enter starting station " & Math.Round(oAlignment.StartingStation, 2) & ": ")
dStation = dStationStart

' Prompt the user for the ending station
dStationEnd = ThisDrawing.Utility.GetReal("Enter ending station " & Math.Round(oAlignment.EndingStation, 2) & ": ")

' Prompt the user for the station interval
dStationInterval = ThisDrawing.Utility.GetReal("Enter station interval: ")

So now that we have the information we can now add the various stations the user wants. First I will create a default naming convention for the sample line name since they have to be unique and will use an Do While statement to go through the sections that need to be revised/added at the location to add a sample line based on location:

        Dim sSampleLineName As String
' Cycle through the station range and add sample lines
Do While dStation < dStationEnd
sSampleLineName =
"SampleLine-" & dStation
Call oSampleLineGroup.SampleLines.AddByStation(sSampleLineName, dStation, dSwathWidthLeft, dSwathWidthRight)
dStation = dStation + dStationInterval

This code is the basics to get the intended results as stated above. The program would need plenty of error catching to work perfectly. For instance if you run it again with the same starting, ending and station interval you will get an error message since you can't have sample lines with the same name. To get this to not happen you would have to delete the other sections, or prompt the user to see if he/she would want the section replaced. You would probably also want default values to limit the amount of typing that would be required by the user.

I placed the dvb file on my companion website, under the 07-05-2008 date. If anyone wants a more polished program I could provide it for a nominal fee, but the above code should work in a pinch.


Anonymous said...

Great tool - thanks from Germany, Joerg

manoj said...

this vba is not available. plz load it,or mail me at

Christopher Fugitt said...

VBA is available to be downloaded at this location:

manoj said...

dear christopher
i m talking abt SectionSampleRevised.dvb
plz load it.
Page not found

We're sorry, but we were unable to locate the page you requested.

Christopher Fugitt said...

Unfortunately I was unable to find the dvb file locally. It appears the file has been lost forever. Google decided to no longer allow dvb files so it got erased.


Blog Widget by LinkWithin