Friday, October 30, 2009

Scale Points, Retain Elevation

Matt did a post over at 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.

No comments:


Blog Widget by LinkWithin