VBA: Create Existing Ground Profile For All Alignments in a Drawing

I saw a post today in the Civil 3D DG that reminded me that I wanted the functionality to create existing ground profiles for all of the alignments in a drawing. I don't want to wait for Autodesk, I want it now. Well this is how I created it today.

As a starting point I am going to be using a renamed copy of the VBA profile sample: C:\Program Files\AutoCAD Civil 3D 2008\Sample\Civil 3D API\Vba\Profile\ProfileSample.dvb

To start I'm going to go to the Profile module (CreateProfile macro) which contains the code to create profiles. Since it creates both an existing ground profile and finish grade profile I will delete the code portions that relate to creating the finish grade profile. I don't want to create a profile so we will delete that code also. Since I am doing this just for my own use I will delete the portion that gets the collection of profiles. The picture to the right is what I was left with.

Since you probably have surface you want already in the drawing we will change the surface to one that you select in the drawing. To do this use the following code:

' Get the specified surface.
Dim oSurface As AeccSurface
Dim oAcadObject As Object
Dim entbasepnt As Variant
   
ThisDrawing.Utility.GetEntity oAcadObject, entbasepnt, "Select a Surface: "

If (TypeOf oAcadObject Is AeccSurface) Then
    Set oSurface = oAcadObject
Else
    MsgBox "Selection was not a surface"
End If

Instead of using the default name that the sample uses I will use the alignment name and then the surface name. To do this I will Dim a string and then store the data name in the created string. Make sure to replace the instance of PROFILE1_NAME with the string variable created, in the posted code I used ProfileName. So that is all of the changes that need to be made to the profile module. Next we will select all of the alignments and then send the alignment name to the CreateProfile Function to create the EG profiles.

As a starting point I will be using the PerformProfileDemonstration code in the Subroutines module. First I will delete all of the routines I don't need (I will keep the CreateProfileView code in case I want to use it later in another post, but I will comment it out so it doesn't call the code). To select the alignments we will use a snippet of sample code from the pipes sample. It essentially looks at all of the objects in the drawing and checks to see what type of object it is. I will be doing this change in the subroutines module. So to the left is the code I finished with.

Now if you hit play, you would find that I cut to much and made a bunch of mistakes, but hey its free post. The first thing we want to do is make sure I declared all of the variables correctly. Once those have been fixed I will need to add back in some of the code I deleted earlier. Mainly it was the Profiles collection and the name of the style. For the style I used Standard, but you could replace the name with any that you have in your template.

Now that everything is fixed I hit play. I got the results I was after, but I had to select the surface multiple times. To prevent from having to select the surface every time I will pull selecting the surface out of the profiles and put it into the subroutines macro. To pass the surface from the subroutines macro to the Profile macro I needed add oSurface As AeccSurface to the title of CreateProfile and then add it to where we call the create profile function.

The finished sample can be found here with a date of 12-11-2007. If you run it more than once it will just overwrite the existing one and will not create a new one, but if you have a finish grade profile with the same name it will overwrite that one. There is some more work to be done to make it error free, but should work for my purposes and only took about 2 hours including the time to write this.