Civil 3D Reminders Pack Commands

A reminder list of commands, for me, that are in the working copy of the Civil 3D Reminders Pack and what they do. I’ve changed some of the command names so they have the C3DR prefix before them and this version has not been posted to the Civil 3D Reminders Pack page. All of the commands are in the free version except for the commands colored in blue. Set up to work for Civil 3D 2010 only.

Pipes

C3DRUpdateSewerLaterals – Adjusts sewer lateral pipe network to the appropriate main line pipe network. After running the command the sewer laterals are then dynamically linked, if a main line pipe moves the lateral will update as long as the change is in the Z direction. If the main line pipe is moved in the X-Y plane then the lateral will not updated until the laterals are moved to the main line pipe. They will then dynamically update again.

C3DRLinkCrossingProfileViewLabel – Attaches a MLeader to a pipe in a profile view. When the pipe moves the MLeader will move to the correct location as long as the pipe still is crossing the profile view’s corresponding alignment.

C3DRLOADLINKS – Loads the links for the Profile Crossing Label.

C3DRTurnOffLINKS – Temporarily turns off the dynamic capabilities of the crossing pipe label and sewer lateral

C3DRSAVELINKS – Saves the links for the crossing pipe label.

C3DRPipeInfo – Gets pipe information while hovering over a pipe. Was going to make this into a Quick Edit Pipe command, but didn’t know what to do to the next pipe since pipe rules are not exposed in the API.

C3DRendPipeInfo – Gets the end pipe info while hovering over a pipe.

C3DRPIW – Adjusts a pipe to the inside edge of a structure. Started making this dynamic, but haven’t finished it.

C3DRAddPIWEvents – A start to making the C3DRPIW dynamic.

C3DRRemovePIWEvents – A start to turning off the dynamic C3DRPIW that I haven’t finished.

C3DRChangeMannings – Command to change the Manning’s value for multiple selected pipes.

C3DRSwapParts – Allows the user to swap multiple pipe and structure pipes at one time.

Corridor

C3DRXREFCorridor3DPolyline – Extract a 3D Polyline from a corridor in an XREF.

Points

C3DRScalePoints – Scales points in the X-Y Direction, but preserves the point’s elevation, Z.

C3DRAddPointToPointGroup – Adds a point to a specified point group instead of having to go into properties of the point group to add the point to a point group.

Surfaces

C3DRTIN – Toggles the triangles on or off for a surface.

C3DRSubgradeSurface – Creates a subgrade surface based on selected polylines representing areas of different material depths.

C3DRCreateEGSurface – Creates an EG surface utilizing point groups. The work flow is the user imports points into the drawing and then runs this command. Point groups are then created in the drawing based and added to the EG surface. (Probably needs a capability to have the user modify the point group default settings, it was set up for one company’s standards).

Things to Do:

• Add demand loading.
• Add license checking.
• Lookup license language.
• Learn C#.
• Learn versioning.
• Make Pipe to Inside wall dynamic to make it useful.

Sampling More Sections

After creating sections sometimes it can be difficult finding where to sample more sections. There are at least two ways to add additional sections to sample line groups. The first is go to into the Sample Line Group properties and go to the the Section Tab and choose the Sample more sources… button.

Another way to is to right click on Sections and choose Sample more sources…

Either way you end up at the Section Sources dialog box. In the box you can add or remove sampled sections. If you want to remove sections this would be an easier place to remove them then selecting the sections and deleting them.

Merry Christmas

Hope you have a nice holiday. In case you need some help putting up some last minute decorations, see the plan below:

I am not the creator of above plan, but did receive it from a friend many Christmases ago.

A New Civil 3D Blog

Check out the new blog by Brian: http://civil3dplus.wordpress.com/

Not much there now, but if he keeps it up there should be some great blog posts in the future.

Crossing Profile Label – Almost done

I’ve been working on creating a crossing profile label that is dynamic to a pipe. If the pipe moves the label will move to the invert of the crossing pipe in profile. The video below shows the label reacting.

Unfortunately I was unable to use a profile view label since the location of the label isn’t exposed in the API. In it’s place is a MLeader. As the label is updated the contents of the pipe label is changed based on the station and elevation of the invert and the inner diameter of the pipe. I’m having a problem with the labels updating when the data shortcuts are involved. If the source file has changed it doesn’t always reflect the change as shown in the screencast above. Have any suggestions for improvement? Send me an email or leave a comment.

Adding Points at Center of Circles

Have you ever had the need to add a bunch of points at the center of a circle? Well if you have then this Civil 3D Reminders widget may be for you. This widget lets you select circles and then it adds a point at the center of the selected circles. This screencast shows the macro in action:

The code uses a filtered selection set and then goes through the selection set and adds a point to the center of the circle. If you want to build your own you can check out help or past posts from this blog. Or if you just want the functionality you can purchase the widget using the Buy Now button below. The widget is for 2010, if you need another version let me know and I can make it.

Thanks

Add Points to Center of Circle Widget

Single Seat $20.00 Whole Office $100.00

Day 2 – Dynamic Profile View Label

I’ve been thinking about the dynamic profile view label quite a bit lately. Evidently the Civil 3D API doesn’t provide the location of a Civil 3D label. This makes it difficult to figure out where in the world the label is at in the drawing. Instead of utilizing a profile view label I’m going to have to go to a mleader to label the pipe. This provides additional complexity since I will now have to check to see if the profile view has been modified and update any station/elevation information in the mleader. I think I’ll work on this today after sending an email to a reseller I met at AU who has a client who is hiring locally in the solar panel industry.

I’ve also added another listing on eBay, Brooks & Dunn Waitin’ on Sundown. I’m not quite sure if the economics work out on selling CD's on eBay. It seems the company that gets the best deal out of it is shipper.

And for those of you who like to read the articles from a feed reader, like the Kung Fu Drafter, I’ve truncated the posts in attempt to drive some traffic to this site. Sorry for the inconvenience.

Day 1 – Underemployed

In reality this is about day a lot since I’ve been working 32 hours a week for quite a bit, but just recently I’ve been downgraded to 0 hours a week. I haven’t been officially laid off, but 0 hours a week is pretty close to it. I’ve noticed that lots of blogs go dark once the blogger gets unemployed such as the The Civil Chick,  Stream Restoration Engineering with Civil 3D and Civil 3D Question and Answer (and probably others) Although some have posted recently. I think that its not the time to dark, but to continue to post to see if work leads present themselves or possibly some side jobs to supplement my income until I get a regular paycheck again.

In the meantime I’ve spent some time signing up for an Ebay account to sell some items, anybody interested in a Jeff Foxworthy comedy album?

Today I’ve also gone and found a old copy of my resume that I need to update.

And now for a Civil 3D tip. When finding the horizontal distance between points you don’t have to set the point style to not have elevation, you can use the Inquiry tool, the CGLIST command or the CGSLIST to get the horizontal distance. The hard part is getting out of the habit of using the dist command to find the horizontal distance.

Excel Flash Cards Voice

I was doing a bit of driving so I tried out adding a voice to the flash cards mentioned in a previous post. The computer speakers didn’t work too well so it didn’t work as well as I would like. Here’s the code with the voice, it also is way to verbose.

Option Explicit

Public Voice As New SpVoice


Sub FlashCardSpeak()
    
    Dim oSheet As Worksheet
    Set oSheet = ThisWorkbook.Worksheets.Item("ListOfTerms")
    
    Dim iRow As Integer
    Dim iCount As Integer
    Dim Response
    Dim iRow1, iRow2, iRow3, iRow4, iRow5, iRow6, iRow7, iRow8, iRow9, iRow10 As Integer
    
    iRow = 1
    iRow1 = 1
    iRow2 = 2
    iRow3 = 3
    iRow4 = 4
    iRow5 = 5
    iRow6 = 6
    iRow7 = 7
    iRow8 = 8
    iRow9 = 9
    iRow10 = 10
    
Do Until oSheet.Cells(iRow1, 1) = "" And oSheet.Cells(iRow2, 1) = "" And oSheet.Cells(iRow3, 1) = "" _
    And oSheet.Cells(iRow4, 1) = "" And oSheet.Cells(iRow5, 1) = "" And oSheet.Cells(iRow6, 1) = "" _
    And oSheet.Cells(iRow7, 1) = "" And oSheet.Cells(iRow8, 1) = "" And oSheet.Cells(iRow9, 1) = "" _
    And oSheet.Cells(iRow10, 1) = ""
    
    If oSheet.Cells(iRow1, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow1, 3) = "" Then
            
            Voice.Speak oSheet.Cells(iRow1, 1)
            
            Response = MsgBox(oSheet.Cells(iRow1, 1), vbYesNoCancel, "Do you know it?")
            
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow1, 2)
                MsgBox oSheet.Cells(iRow1, 2), , oSheet.Cells(iRow1, 1)
                oSheet.Cells(iRow1, 3) = 1
                iRow1 = iRow1 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow1, 2)
                MsgBox oSheet.Cells(iRow1, 2), , oSheet.Cells(iRow1, 1)
            Else
                Exit Sub
            End If
        Else
            iRow1 = iRow1 + 10
        End If
    End If
        
    If oSheet.Cells(iRow2, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow2, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow2, 1)
            Response = MsgBox(oSheet.Cells(iRow2, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow2, 2)
                MsgBox oSheet.Cells(iRow2, 2), , oSheet.Cells(iRow2, 1)
                oSheet.Cells(iRow2, 3) = 1
                iRow2 = iRow2 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow2, 2)
                MsgBox oSheet.Cells(iRow2, 2), , oSheet.Cells(iRow2, 1)
            Else
                Exit Sub
            End If
        Else
            iRow2 = iRow2 + 10
        End If
    End If

    If oSheet.Cells(iRow3, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow3, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow3, 1)
            Response = MsgBox(oSheet.Cells(iRow3, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow3, 2)
                MsgBox oSheet.Cells(iRow3, 2), , oSheet.Cells(iRow3, 1)
                oSheet.Cells(iRow3, 3) = 1
                iRow3 = iRow3 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow3, 2)
                MsgBox oSheet.Cells(iRow3, 2), , oSheet.Cells(iRow3, 1)
            Else
                Exit Sub
            End If
        Else
            iRow3 = iRow3 + 10
        End If
    End If

    If oSheet.Cells(iRow4, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow4, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow4, 1)
            Response = MsgBox(oSheet.Cells(iRow4, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow4, 2)
                MsgBox oSheet.Cells(iRow4, 2), , oSheet.Cells(iRow4, 1)
                oSheet.Cells(iRow4, 3) = 1
                iRow4 = iRow4 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow4, 2)
                MsgBox oSheet.Cells(iRow4, 2), , oSheet.Cells(iRow4, 1)
            Else
                Exit Sub
            End If
        Else
            iRow4 = iRow4 + 10
        End If
    End If

    If oSheet.Cells(iRow5, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow5, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow5, 1)
            Response = MsgBox(oSheet.Cells(iRow5, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow5, 2)
                MsgBox oSheet.Cells(iRow5, 2), , oSheet.Cells(iRow5, 1)
                oSheet.Cells(iRow5, 3) = 1
                iRow5 = iRow5 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow5, 2)
                MsgBox oSheet.Cells(iRow5, 2), , oSheet.Cells(iRow5, 1)
            Else
                Exit Sub
            End If
        Else
            iRow5 = iRow5 + 10
        End If
    End If

    If oSheet.Cells(iRow6, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow6, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow6, 1)
            Response = MsgBox(oSheet.Cells(iRow6, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow6, 2)
                MsgBox oSheet.Cells(iRow6, 2), , oSheet.Cells(iRow6, 1)
                oSheet.Cells(iRow6, 3) = 1
                iRow6 = iRow6 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow6, 2)
                MsgBox oSheet.Cells(iRow6, 2), , oSheet.Cells(iRow6, 1)
            Else
                Exit Sub
            End If
        Else
            iRow6 = iRow6 + 10
        End If
    End If

    If oSheet.Cells(iRow7, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow7, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow7, 1)
            Response = MsgBox(oSheet.Cells(iRow7, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow7, 2)
                MsgBox oSheet.Cells(iRow7, 2), , oSheet.Cells(iRow7, 1)
                oSheet.Cells(iRow7, 3) = 1
                iRow7 = iRow7 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow7, 2)
                MsgBox oSheet.Cells(iRow7, 2), , oSheet.Cells(iRow7, 1)
            Else
                Exit Sub
            End If
        Else
            iRow7 = iRow7 + 10
        End If
    End If

    If oSheet.Cells(iRow8, 1) = "" Then
        ' Don't do anything
        
    Else

        If oSheet.Cells(iRow8, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow8, 1)
            Response = MsgBox(oSheet.Cells(iRow8, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow8, 2)
                MsgBox oSheet.Cells(iRow8, 2), , oSheet.Cells(iRow8, 1)
                oSheet.Cells(iRow8, 3) = 1
                iRow8 = iRow8 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow8, 2)
                MsgBox oSheet.Cells(iRow8, 2), , oSheet.Cells(iRow8, 1)
            Else
                Exit Sub
            End If
        Else
            iRow8 = iRow8 + 10
        End If
    End If

    If oSheet.Cells(iRow9, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow9, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow9, 1)
            Response = MsgBox(oSheet.Cells(iRow9, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow9, 2)
                MsgBox oSheet.Cells(iRow9, 2), , oSheet.Cells(iRow9, 1)
                oSheet.Cells(iRow9, 3) = 1
                iRow9 = iRow9 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow9, 2)
                MsgBox oSheet.Cells(iRow9, 2), , oSheet.Cells(iRow9, 1)
            Else
                Exit Sub
            End If
        Else
            iRow9 = iRow9 + 10
        End If
    End If

    If oSheet.Cells(iRow10, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow10, 3) = "" Then
            Voice.Speak oSheet.Cells(iRow10, 1)
            Response = MsgBox(oSheet.Cells(iRow10, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                Voice.Speak oSheet.Cells(iRow10, 2)
                MsgBox oSheet.Cells(iRow10, 2), , oSheet.Cells(iRow10, 1)
                oSheet.Cells(iRow10, 3) = 1
                iRow10 = iRow10 + 10
            ElseIf Response = vbNo Then
                Voice.Speak oSheet.Cells(iRow10, 2)
                MsgBox oSheet.Cells(iRow10, 2), , oSheet.Cells(iRow10, 1)
            Else
                Exit Sub
            End If
        Else
            iRow10 = iRow10 + 10
        End If
    End If
Loop
End Sub

Move in .NET

In VBA it was fairly easy to move an object, there was usually a Move method associated with an entity. In .NET it’s a bit more complicated because you use the TransformBy method. The TransformBy method not only moves an object it also lets you scale, rotate and mirror an object. TransformBy requires a Matrix3d object which determines what happens to the object. The AutoCAD .NET Developers Guide covers how to use each one fairly well, do a search for “Transform Objects” for more information on how to do it. That’s will be where I’ll be looking for it once I find this reminder post.

Dynamic Crossing Pipe Label

While I’m waiting on feedback for the dynamic sewer lateral program I thought I’d start on a new project, creating a dynamic profile view label for crossing pipes. Currently you are not able to label a crossing pipe were it crosses a profile in a dynamic manner. The method I currently use utilizes a profile view label. When the pipe changes location I have to manually adjust the profile view label. I’d prefer to not have to do that and just have the label update automatically.

The general steps I’m thinking of using are below:

1. Select Profile View
2. Select Crossing Pipe
3. Have the user use the default label style (first one on the list) or select a profile view label style from a list of available styles.
4. Get the alignment associated with the profile view.
5. Check to make sure the pipe crosses the profile view’s alignment.
6. Get the station/elevation of the pipe crossing point.
7. Create the label and put it at the correct location.
8. Turn on dynamic code.

Got any ideas to improve my plans? If so leave a comment.

Excel Flashcards

I choose to study to be certified as a cost engineer and just recently took the test. There was a whole document of terminology I needed to be familiar with. Since I needed a relatively painless way to cover the words I thought I’d create flash cards in Excel to help go through them. I converted the PDF file with the terminology into a list in Excel. Column A had the Description of the word and Column B had the Definition.

The code is a bit verbose and could probably be reduced quite a bit. The code goes through the first 10 words, providing a message box of the word. I then have the opportunity to indicate that I know the word or not. If I don’t know the word, it stays in the queue. If I indicate that I do know the word a 1 is put in Column C and then next word is added to the queue. By indicating that I know it in Column C I’m able to start back up where I started if I have to go and do something else. In both cases I’m presented with the definition of the word. I also added information to the worksheet indicating how many words there are and how many words I have remaining. I created a Shape and assigned the macro to it so when I push the shape the macro starts. Here’s the flash cards in action:

Here’s the code:

Option Explicit

Public Voice As New SpVoice

Sub FlashCard()
    
    Dim oSheet As Worksheet
    Set oSheet = ThisWorkbook.Worksheets.Item("ListOfTerms")
    
    Dim iRow As Integer
    Dim iCount As Integer
    Dim Response
    Dim iRow1, iRow2, iRow3, iRow4, iRow5, iRow6, iRow7, iRow8, iRow9, iRow10 As Integer
    
    iRow = 1
    iRow1 = 1
    iRow2 = 2
    iRow3 = 3
    iRow4 = 4
    iRow5 = 5
    iRow6 = 6
    iRow7 = 7
    iRow8 = 8
    iRow9 = 9
    iRow10 = 10
    
Do Until oSheet.Cells(iRow1, 1) = "" And oSheet.Cells(iRow2, 1) = "" And oSheet.Cells(iRow3, 1) = "" _
    And oSheet.Cells(iRow4, 1) = "" And oSheet.Cells(iRow5, 1) = "" And oSheet.Cells(iRow6, 1) = "" _
    And oSheet.Cells(iRow7, 1) = "" And oSheet.Cells(iRow8, 1) = "" And oSheet.Cells(iRow9, 1) = "" _
    And oSheet.Cells(iRow10, 1) = ""
    
    If oSheet.Cells(iRow1, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow1, 3) = "" Then
            
            Voice.Speak oSheet.Cells(iRow1, 1)
            
            Response = MsgBox(oSheet.Cells(iRow1, 1), vbYesNoCancel, "Do you know it?")
            
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow1, 2), , oSheet.Cells(iRow1, 1)
                oSheet.Cells(iRow1, 3) = 1
                iRow1 = iRow1 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow1, 2), , oSheet.Cells(iRow1, 1)
            Else
                Exit Sub
            End If
        Else
            iRow1 = iRow1 + 10
        End If
    End If
        
    If oSheet.Cells(iRow2, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow2, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow2, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow2, 2), , oSheet.Cells(iRow2, 1)
                oSheet.Cells(iRow2, 3) = 1
                iRow2 = iRow2 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow2, 2), , oSheet.Cells(iRow2, 1)
            Else
                Exit Sub
            End If
        Else
            iRow2 = iRow2 + 10
        End If
    End If

    If oSheet.Cells(iRow3, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow3, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow3, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow3, 2), , oSheet.Cells(iRow3, 1)
                oSheet.Cells(iRow3, 3) = 1
                iRow3 = iRow3 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow3, 2), , oSheet.Cells(iRow3, 1)
            Else
                Exit Sub
            End If
        Else
            iRow3 = iRow3 + 10
        End If
    End If

    If oSheet.Cells(iRow4, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow4, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow4, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow4, 2), , oSheet.Cells(iRow4, 1)
                oSheet.Cells(iRow4, 3) = 1
                iRow4 = iRow4 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow4, 2), , oSheet.Cells(iRow4, 1)
            Else
                Exit Sub
            End If
        Else
            iRow4 = iRow4 + 10
        End If
    End If

    If oSheet.Cells(iRow5, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow5, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow5, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow5, 2), , oSheet.Cells(iRow5, 1)
                oSheet.Cells(iRow5, 3) = 1
                iRow5 = iRow5 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow5, 2), , oSheet.Cells(iRow5, 1)
            Else
                Exit Sub
            End If
        Else
            iRow5 = iRow5 + 10
        End If
    End If

    If oSheet.Cells(iRow6, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow6, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow6, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow6, 2), , oSheet.Cells(iRow6, 1)
                oSheet.Cells(iRow6, 3) = 1
                iRow6 = iRow6 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow6, 2), , oSheet.Cells(iRow6, 1)
            Else
                Exit Sub
            End If
        Else
            iRow6 = iRow6 + 10
        End If
    End If

    If oSheet.Cells(iRow7, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow7, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow7, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow7, 2), , oSheet.Cells(iRow7, 1)
                oSheet.Cells(iRow7, 3) = 1
                iRow7 = iRow7 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow7, 2), , oSheet.Cells(iRow7, 1)
            Else
                Exit Sub
            End If
        Else
            iRow7 = iRow7 + 10
        End If
    End If

    If oSheet.Cells(iRow8, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow8, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow8, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow8, 2), , oSheet.Cells(iRow8, 1)
                oSheet.Cells(iRow8, 3) = 1
                iRow8 = iRow8 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow8, 2), , oSheet.Cells(iRow8, 1)
            Else
                Exit Sub
            End If
        Else
            iRow8 = iRow8 + 10
        End If
    End If

    If oSheet.Cells(iRow9, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow9, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow9, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow9, 2), , oSheet.Cells(iRow9, 1)
                oSheet.Cells(iRow9, 3) = 1
                iRow9 = iRow9 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow9, 2), , oSheet.Cells(iRow9, 1)
            Else
                Exit Sub
            End If
        Else
            iRow9 = iRow9 + 10
        End If
    End If

    If oSheet.Cells(iRow10, 1) = "" Then
        ' Don't do anything
        
    Else
        If oSheet.Cells(iRow10, 3) = "" Then
        
            Response = MsgBox(oSheet.Cells(iRow10, 1), vbYesNoCancel, "Do you know it?")
        
            If Response = vbYes Then
                MsgBox oSheet.Cells(iRow10, 2), , oSheet.Cells(iRow10, 1)
                oSheet.Cells(iRow10, 3) = 1
                iRow10 = iRow10 + 10
            ElseIf Response = vbNo Then
                MsgBox oSheet.Cells(iRow10, 2), , oSheet.Cells(iRow10, 1)
            Else
                Exit Sub
            End If
        Else
            iRow10 = iRow10 + 10
        End If
    End If
Loop
End Sub

Dynamic Sewer Lateral Program

I spent some time at AU working on the Civil 3D Reminders Pack. Mainly creating a command that provides a dynamic link between in the sewer lateral and the main line pipe. In order to get some feedback I’m looking for Alpha testers to provide feedback, error reporting and suggested improvements. The program is built for Civil 3D 2010 only.

The program currently only works when the mainline pipe is moved vertically, the sewer laterals don’t currently move when the main line is moved horizontally. The sewer laterals will need to be in a separate pipe network from the mainlines for optimum performance.

I don’t have an installer (haven’t learned how to create one yet) so you’ll have to NETLOAD the program. To turn on the dynamic link you will have to turn it on by typing a command each time you open the file.

Here’s a brief screencast showing the laterals adjusting with the main line.

Once in the Beta stages I’ll be offering the program for sale.

Civil 3D 2010 Swap Parts Part III

This post will show how to add the capability to swap parts in a profile view to the Swap Parts command in the Civil 3D Reminders Pack, see the previous post here. The code addition is pretty small. All that is needed is to check to see if the selected entity is a ProfileViewPart and if it is convert the entity to the corresponding pipe or structure entity. The code then runs like it did before.

            ' Add code to support profile view parts
            If TypeOf ent Is Autodesk.Civil.PipeNetwork.DatabaseServices.ProfileViewPart Then
                ' Convert the profile view part to it's corresponding pipe or structure part.
                Dim oProfileViewPart As Autodesk.Civil.PipeNetwork.DatabaseServices.ProfileViewPart
                oProfileViewPart = ent
                ent = DirectCast(tr.GetObject(oProfileViewPart.ModelPartId, OpenMode.ForWrite), Entity)
            End If

Add the code right before it checks to see if the ent is a Pipe.

Trip From AU 2009

Autodesk University is over and I’ve made the trip to my next destination. On the way back from Las Vegas I made some stops. First up was visiting the Aliens in Baker, CA. 

The Aliens serve up free jerky samples from their market.

Not quite sure why they came all the way from outer space to set up a market in Baker, CA. Maybe it was the world’s largest thermometer which is near by.

The next stop on my journey was a stop in Barstow at the Harvey House. Harvey House used to be a train station with a restaurant called Harvey House. Today Harvey House houses a railroad museum, visitor’s center and a Highway 66 museum. Space is available if you want to lease space there. Mention my name when inquiring about leasing and receive a questioning stare. 

In the railroad museum I learned people collected date nails. The picture below explains what date nails are.

I arrived at the The Mother Road Route 66 Museum near closing time, so I didn’t get to explore it too much.

Here’s a picture of the building from the other side.

From Harvey House you can see Barstow’s movie drive-in. I wasn’t able to stop and see a movie though. The drive in has two screens, each shows a double feature nightly. Today’s movies were The Blind Side/Ninja Assassin and Old Dogs/The Twilight Saga: New Moon. During the winter the box office opens at 6 pm.

 

And finally I’ve got some random fast food trivia for you. Barstow, California was the birthplace of both Taco Bell and Del Taco. Here’s a picture of the home of Del Taco, now open at 6 am for breakfast.

Also interesting is that both now have their company headquarters' in Orange County, California.

Add Data to Existing XRecord

I had a hard time finding how to add existing information to an existing XRecord. I found a way utilizing code from Kean’s blog: http://through-the-interface.typepad.com/through_the_interface/2006/11/linking_circles_1.html

Here’s a snippet of code I used to add a value to an existing XRecord.

                    Dim rb As New ResultBuffer
                    For Each resBuf In resBufArray
                        rb.Add(New TypedValue(DxfCode.Handle, resBuf.Value))
                    Next
                    ' Add the new pipe handle.
                    rb.Add(New TypedValue(DxfCode.Handle, objHandle))
                    sewerLatXRec.XlateReferences = True
                    sewerLatXRec.Data = DirectCast(rb, ResultBuffer)
                End If

The best location to get information on how to create XRecord’s is the AutoCAD .NET Labs training materials.

I think I spent way too much time finding how to add information to the XRecord.

AU 2009

Autodesk University has been great so far, even though I’m not an official attendee. On Friday I got to go the Blogger’s Social, I had an invitation, to meet and greet with fellow bloggers and some Autodesk celebrities. The appetizers where good with a Mexican taste. I was also able to make it into the AEC Mixer, just don’t tell anyone, and check out the video games on display and meet with some people.

Today I was able to do a usability study on product user interface during the keynote address. After lunch I was a Lab Assistant and made a little spending money. I helped out with Lee Ambrosius’s Lab “Going from VBA to vb.NET in 90 Minutes”. The lab experience was great and if I came back to AU I’d volunteer again.

Now off to crash (kind of, I got an invitation) to a preview of Civil 3D.

Extract 3DPolyline from Corridor Through an XREF

Have you ever wanted to extract a 3DPolyline from a corridor located in an XREF? Well I’ve added the capability to the Civil 3D Reminders Pack. I took code from the Offset in XREF code from a previous plug in of the month and a previous post on this blog. You can check out the finished product by downloading the Civil 3D Reminders Pack.

Here’s a video of the command in action:

Trip to AU 2009

I started my travels to Autodesk University yesterday. I stopped by some of the notable sights on the way from San Luis Obispo County to Las Vegas.

First up is the James Dean Memorial Intersection where the State Highways 41 & 46 diverge. It’s the place where James Dean had his fatal car accident.

After going over the hills I made a right turn next to James Dean’s last stop and drove down Petroleum Highway (State Highway 33). Petroleum Highway is named after the many oil rigs along the road.

In Buttonwillow I came across a large cow along the side of the road. Buttonwillow is the “Heart of Agriculture”.

 

Next stop was the famous Tehachapi Loop. There was a small crowd present to witness one of the 36 daily train trips. The Loop is famous because the train goes over itself as it goes through the loop. Here’s a picture of the tunnel.

The loop is a National Historic Civil Engineering Landmark. Here’s the history of the loop according to the plaque in place near the loop.

Here’s a picture of the train going through the loop.

Next up is a place that I worked at for a time, the U.S. Borax Mine in Boron, CA. For a time in the late 1880’s borax was transported utilizing a 40 mule team. The visitor’s center has a display showing what the team looked like.

While I was working there they where putting together a new fleet of shovels and trucks (the company I worked for at the time constructed the pad the equipment was assembled on). It was interesting coming into work each day watching the progress on the equipment. There is no real reference in the photo below, but the equipment is really large.

Here’s a picture of the mine. It’s changed quite a bit since I worked there. The white material is the primary material they are mining, borates.

Large overburden piles at the mine and a portion of the refining plant.

On Highway 58 Caltrans appeared to be testing different slope treatments. Behind the fences is a funnel and piping system which appeared to collect the water for testing. Some of the treatments appeared to work better than others. There was also another site near Barstow.

There was more sights to see such as the Baker Thermometer and the Bakersfield Sign.

Mass Label Contours - Correction

It looks like I messed up the interval for the Mass Label Contours. To make the correction make the change in the attached screencast. http://screencast.com/t/ZTQ0MDFlYmU

Or you can re-download the file. http://style.civil3dreminders.com/masscontourlabels

Also remember if you are going to AU I’m giving away a SpaceNavigator. Between 6:30pm and 7pm, on Tuesday, I’ll tweet a location to @3DConnexion on where I’m going to be. The first person to find me and ask for the 3DMouse gets the SpaceNavigator.

To follow me on Twitter just sign up and follow me, my Twitter location is: http://twitter.com/C3DReminders While you are there make sure to also follow @3DConnexion.

Civil 3D Customization Services

I find myself with some time on my hands and am looking to fill some of it up. Contact me if you are in need of customization services. Services could include:

• Custom Reports
• Custom Subassemblies
• Custom Routines/macros

Find something that you liked on of my previous posts, but want it customized to your own work flow? Send me a line and we can talk about having it improved to meet your needs.

SpaceNavigator Giveaway At AU

Want a free SpaceNavigator? Well I’m giving one away at AU courtesy of 3DConnexion.

Twitter seems all the rage today so I’m going to use Twitter to help give away the mouse. Between 6:30pm and 7pm, on Tuesday, I’ll tweet a location to @3DConnexion on where I’m going to be. The first person to find me and ask for the 3DMouse gets the SpaceNavigator.

To follow me on Twitter just sign up and follow me, my Twitter location is: http://twitter.com/C3DReminders While you are there make sure to also follow @3DConnexion. Most cell phones have downloadable applications that lets you use Twitter, so no need to lug around a laptop. 

Please be safe, no running.

Rotate Headwall

When you move or adjust a location of a headwall it doesn’t remain perpendicular to a pipe like you may want. This post will create a quick VBA macro to rotate the headwall back into place. The code has the user select a structure and then rotates it depending on if it is attached to the start of the pipe or the end of the pipe. The rotation is done in radians, so the rotation is pi.

Option Explicit


' Command to rotate headwall to be 90 degrees from pipe.
Sub RotateHeadwall()
    ' Always get the objects again since MDI is supported.
    If (GetBasePipeObjects = False) Then
        MsgBox "Error accessing base civil objects."
        Exit Sub
    End If
    
    On Error Resume Next
    
    ' Select headwall
    Dim oStructure As AeccStructure
    Dim vPoint As Variant
    Dim oAcadObj As AcadObject
    
    ThisDrawing.Utility.GetEntity oAcadObj, vPoint, "Select Headwall to rotate: "
        
    If (TypeOf oAcadObj Is AeccStructure) Then
        Set oStructure = oAcadObj
        If oStructure.ConnectedPipesCount = 0 Then
            ' THe structure is not connected to a pipe.
            MsgBox "The structure is not connected to a pipe."
        End If
        
        Dim oPipe As AeccPipe
        Set oPipe = oStructure.ConnectedPipe(0)
        Dim dRotation As Double
        Dim dStartPt(0 To 2) As Double
        Dim dEndPt(0 To 2) As Double
        dStartPt(0) = oPipe.StartPoint.X: dStartPt(1) = oPipe.StartPoint.Y
        dEndPt(0) = oPipe.EndPoint.X: dEndPt(1) = oPipe.EndPoint.Y
        
        If oPipe.StartStructure.ObjectID = oStructure.ObjectID Then
            dRotation = ThisDrawing.Utility.AngleFromXAxis(dStartPt, dEndPt) + (4 * Atn(1)) ' Added 180 degrees to the value
        Else
            dRotation = ThisDrawing.Utility.AngleFromXAxis(dStartPt, dEndPt)
        End If
        oStructure.Rotation = dRotation
    End If
    
End Sub

Once compiled you can then add the command to the cui and add it to the right click menu for a structure. Here’s a short video showing the command in action and added to the shortcut menu for a structure object.

It could use some improvement by allowing it to use an already selected object. The code may be found here: http://style.civil3dreminders.com/rotateheadwall

More information on creating a command in the cui may be found in this previous post.

Mass Label Contours

Have you ever wanted to label a surface at one time without having to draw multiple lines? Now you can with the simple routine below. The main things that I learned in doing it is the polar point. The polar point allows you to find a point based on a starting point, angle and distance. For this code I find the midpoint between the first and second coordinate point of the contour and then use the polarpoint to find a point a set distance away from the contour that is going to be labeled.

The rest of the code gets some prompts from the user and then extracts the contours from the surface (either major or minor) and the process them, adding the contour labels at interval, starting from the first segment.

The entire dvb file may be found here: http://style.civil3dreminders.com/masscontourlabels

'
' MODULE_ID {Subroutines.bas}
' {LabelContours.dvb}
'
' Copyright {2008} by Autodesk, Inc.
'
' Permission to use, copy, modify, and distribute this software for
' any purpose and without fee is hereby granted, provided that the
' above copyright notice appears in all copies and  that both that
' copyright notice and the limited warranty and  restricted rights
' notice below appear in all supporting  documentation.
'
' AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
' AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
' MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
' Use, duplication, or disclosure by the U.S. Government is subject to
' restrictions set forth in FAR 52.227-19 (Commercial Computer
' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
' (Rights in Technical Data and Computer Software), as applicable.
'
'
'
Option Explicit



'
' These are all the subroutines that can be called from
' Civil 3D's VBRUN command.
'


'
' Label major contours
'
'
Sub LabelMultipleContours()
    'always get the objects again since MDI is supported
    If (GetCivilObjects = False) Then
        Exit Sub
    End If
   
    Dim oSurface As AeccTinSurface
   
    Dim vPoint As Variant
   
    ThisDrawing.Utility.GetEntity oSurface, vPoint, "Select Surface: "
   
    Dim strInput As String
   
    With ThisDrawing.Utility
        .InitializeUserInput 0, "Minor mAjor"
        strInput = ThisDrawing.Utility.GetKeyword("Enter contour type to label [Minor/mAjor]: ")
    End With
   
    Dim dInterval As Double
   
    On Error Resume Next
    With ThisDrawing.Utility
        .InitializeUserInput 6
        dInterval = ThisDrawing.Utility.GetReal("Interval along contour <500>: ")
        ' If user enters then utilize the default value.
        If Err Then
            If Err.Number = -2145320928 Then
                Err.Clear
                dInterval = 500
            Else
                ThisDrawing.Utility.Prompt Err.Number
                Exit Sub
            End If
        End If
    End With
   
    Dim vContours As Variant
   
    Select Case strInput
        Case "Minor"
            vContours = oSurface.ExtractContour(aeccDisplayOrientationPlan, aeccSFMinorContours, oSurface.Statistics.MinElevation, oSurface.Statistics.MaxElevation)
        Case "mAjor"
            vContours = oSurface.ExtractContour(aeccDisplayOrientationPlan, aeccSFMajorContours, oSurface.Statistics.MinElevation, oSurface.Statistics.MaxElevation)
    End Select
   
   
    Dim i As Integer
    Dim oPoly As AcadLWPolyline
    Dim dX1 As Double
    Dim dY1 As Double
    Dim dX2 As Double
    Dim dY2 As Double
    Dim dMidX As Double
    Dim dMidY As Double
    Dim dM As Double
    Dim dMPerp As Double
    Dim dBasePoint(0 To 2) As Double
    Dim dAngle As Double
    Dim dAngle2 As Double
    Dim vPolarPt As Variant
    Dim vPolarPt2 As Variant
   
    For i = 0 To UBound(vContours)
        Set oPoly = vContours(i)
        dX1 = oPoly.Coordinates(0)
        dY1 = oPoly.Coordinates(1)
        dX2 = oPoly.Coordinates(2)
        dY2 = oPoly.Coordinates(3)
       
        dMidX = (dX1 + dX2) / 2
        dMidY = (dY1 + dY2) / 2
        dBasePoint(0) = dMidX: dBasePoint(1) = dMidY
       
        dAngle = ThisDrawing.Utility.AngleFromXAxis(oPoly.Coordinate(0), oPoly.Coordinate(1)) + (4 * Atn(1)) / 2 ' Added 90 degrees to the value
       
        vPolarPt = ThisDrawing.Utility.PolarPoint(dBasePoint, dAngle, 0.01)
        vPolarPt2 = ThisDrawing.Utility.PolarPoint(dBasePoint, dAngle, -0.1)

        ThisDrawing.SendCommand "_AeccAddContourLabelingGroup " & vPolarPt(0) & "," & vPolarPt(1) & " " & vPolarPt2(0) & "," & vPolarPt2(1) & " " & dInterval & " "
        oPoly.Delete
    Next
   
End Sub

adf