Scale Points, Retain Elevation

Matt did a post over at Civil3D.com did a post on scaling your points and keeping the elevations. The method takes a bit of work of exporting and importing the points. It didn’t sound like much fun to do so I decided to add a more automated way of doing the task and add it to the Civil 3D Reminders Pack.

I recycled most of the code, so I’m not going to include the code in this post. The main steps in coding for this is to get the original elevation of the point. Next the point is scaled utilizing the ScaleEntity Method utilizing the base point provided by the user and the scale factor. Next the code assigns the original elevation of the point, replacing the scaled value. The last step is to Update the point. If the points aren’t updated then they won’t be selectable by the user until the file is closed and opened up again.

If you want to see the rest of the code you can download the Civil 3D Reminders Pack source code from the Civil 3D Reminders Pack Webpage.

The Civil 3D Reminders Pack only works in Civil3D 2010. If you want something that will work in an earlier version try this code in VBA:

Option Explicit
 
Sub TrianglesOnOff()
    
    Dim oAcadObj As AcadObject
    Dim vPnt As Variant
    
    ' Have the user select a surface.
    ThisDrawing.Utility.GetEntity oAcadObj, vPnt, "Select Point: "
 
    If (TypeOf oAcadObj Is AeccPoint) Then
        Dim oPoint As AeccPoint
        
        Set oPoint = oAcadObj
        
        ' Define the scale
        Dim basePoint(0 To 2) As Double
        Dim scalefactor As Double
        basePoint(0) = 0: basePoint(1) = 0: basePoint(2) = 0
        scalefactor = 1.5
        Dim dElev As Double
        dElev = oPoint.Elevation
        oPoint.ScaleEntity basePoint, scalefactor
        oPoint.Elevation = dElev
        
    End If
 
End Sub

You’ll have to add a prompt for the scale factor or change the factor each time you run the program.