Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Contributor
alteru
Posts: 15
Registered: ‎01-29-2008
Message 1 of 10 (591 Views)

Interpolate even elevations between two points in civil3d

591 Views, 9 Replies
01-22-2009 08:01 AM
I am wanting to create a lisp routine that will set points at even elevations (ie: 100.00', 101.00', 102.00' etc.) between 2 selected aecc cogo points. I know civil3d can interpolate between selected points with "create points - interpolate", "incremental elevation" command but it wont do it to the even elevations if the picked points are not also to even elevations (ie: i want to select points with elevation of 98.07' and 103.57', and have it automatically set points at 99.00', 100.00', 101.00' 102.00' and 103.00' using the grade between selected points.)

I can do simple lisp routines but this one is way out of my league LOL, any help would be appreciated.
*Some Buddy
Message 2 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

01-22-2009 09:50 AM in reply to: alteru

Hi,

 

I am affraid that yo won't have an answer here,
because yo are asking about AutoCAD Civil 3D and this forum is about vanilla
AutoCAD only. Maybe you should try here:

 


 

or if you use a news reader, try

 

autodesk.civil3d.customization

 

Regards


style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
I
am wanting to create a lisp routine that will set points at even elevations
(ie: 100.00', 101.00', 102.00' etc.) between 2 selected aecc cogo points. I
know civil3d can interpolate between selected points with "create points -
interpolate", "incremental elevation" command but it wont do it to the even
elevations if the picked points are not also to even elevations (ie: i want to
select points with elevation of 98.07' and 103.57', and have it automatically
set points at 99.00', 100.00', 101.00' 102.00' and 103.00' using the grade
between selected points.)

I can do simple lisp routines but this one is
way out of my league LOL, any help would be
appreciated.
Mentor
stevor
Posts: 836
Registered: ‎12-26-2005
Message 3 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

01-22-2009 10:28 AM in reply to: alteru
As I understand your process, all the parts to a viable solution have been presented in this forum, or in others like it.

One method to develope for unit increments, eg: 1 foot, would be:

1.determine the elevations of the selected points
2. sort the 2 end points to min Z and max Z
3. make an integer of the min Z
4. increment it by 1 to get each interval elev, up to the integer of the max Z.
5. prorate the X and Y displacements of each new station between the 2 ends.
S
*Laurie Comerford
Message 4 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

01-22-2009 06:47 PM in reply to: alteru
Hi alteru,

Here is some VBA code to do what you want:


Option Explicit
Type Type_Data
Elevation As Double
FirstDistance As Double
UnitDistance As Double
Direction As Double
End Type
Public Const scMsgHeader = "Point creation"
Public Const icIncrement = 1

Public ogCivilApp As AeccApplication
Public ogCivilDoc As AeccDocument
Public ogCivilDb As AeccDatabase

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Start Civil 3D and create Civil 3D document and database objects.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetCivilObjects() As Boolean
On Error GoTo ErrorHandler
Dim sAppName As String
Select Case Val(ThisDrawing.Application.Version)
Case 17.2 ' v2009
sAppName = "AeccXUiLand.AeccApplication.6.0"
Case 17.1 ' v2008
sAppName = "AeccXUiLand.AeccApplication.5.0"
Case 17# ' v2007
sAppName = "AeccXUiLand.AeccApplication.4.0"
Case Else
MsgBox "'GetCivilObjects' only provides for Civil 3D R2007, 2008
and 2009", vbInformation, "Laurie"
GetCivilObjects = False
Exit Function
End Select
Set ogCivilApp = ThisDrawing.Application.GetInterfaceObject(sAppName)
If ogCivilApp Is Nothing Then
MsgBox "Error creating " & sAppName & ", exit."
GetCivilObjects = False
Exit Function
End If
Set ogCivilDoc = ogCivilApp.ActiveDocument
Set ogCivilDb = ogCivilDoc.Database
GetCivilObjects = True
Exit Function
ErrorHandler:
MsgBox "Problem creating Civil objects with 'GetCivilObjects'" & vbCrLf _
& "due to: " & vbCrLf & Err.Description & vbCrLf & vbCrLf _
& "You may need to repair your Civil 3D Application",
vbCritical, "Laurie"
Err.Clear
GetCivilObjects = False
End Function ' GetCivilObjects

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CloseCivil() As Boolean
On Error GoTo ErrorHandler
Set ogCivilDoc = Nothing
Set ogCivilDb = Nothing
Set ogCivilApp = Nothing

CloseCivil = True
Exit Function
ErrorHandler:
MsgBox "Unable to process data in Function 'CloseCivil' due to:" &
vbCrLf & Err.Description, vbCritical, scMsgHeader
Err.Clear
CloseCivil = False
End Function ' CloseCivil


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Select the points and draw points on the integer elevations
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CreatePoints()
Dim PtStart(0 To 2) As Double
Dim v As Variant
Dim Pt1 As AeccPoint
Dim Pt2 As AeccPoint
Dim daDistances(0 To 2) As Double
Dim tData As Type_Data
On Error GoTo ErrorHandler
GetCivilObjects
Set Pt1 = GetPoint("Select the first Civil 3D point")
If Pt1 Is Nothing Then Exit Sub
Set Pt2 = GetPoint("Select the second Civil 3D point")
If Pt2 Is Nothing Then Exit Sub
If GetData(Pt1, Pt2, tData) = False Then Exit Sub
PtStart(0) = Pt1.Easting
PtStart(1) = Pt1.Northing

v = ThisDrawing.Utility.PolarPoint(PtStart, tData.Direction,
tData.FirstDistance)
PtStart(0) = v(0)
PtStart(1) = v(1)
PtStart(2) = tData.Elevation
Set Pt1 = ogCivilDoc.Points.Add(PtStart)
Pt1.Description = "Added by Program"
tData.Elevation = tData.Elevation + icIncrement
Do While tData.Elevation < Pt2.Elevation
v = ThisDrawing.Utility.PolarPoint(PtStart, tData.Direction,
tData.UnitDistance)
PtStart(0) = v(0)
PtStart(1) = v(1)
PtStart(2) = tData.Elevation
Set Pt1 = ogCivilDoc.Points.Add(PtStart)
Pt1.Description = "Added by Program"
tData.Elevation = tData.Elevation + icIncrement
Loop
CloseCivil
Exit Sub
ErrorHandler:
MsgBox "Unable to process data in Sub 'CreatePoints' due to:" &
vbCrLf & Err.Description, vbCritical, scMsgHeader
Err.Clear
End Sub ' CreatePoints

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Add the data needed for point creation to the data type tData
' Called from: CreatePoints
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetData(Pt1 As AeccPoint, Pt2 As AeccPoint, tData As Type_Data)
As Boolean
On Error GoTo ErrorHandler
Dim dTmp As Double
Dim PtStart(0 To 2) As Double
Dim PtEnd(0 To 2) As Double
Dim dTotalDist As Double
Dim dHeightIncrement As Double
dTotalDist = Sqr((Pt1.Easting - Pt2.Easting) ^ 2 + (Pt1.Northing -
Pt2.Northing) ^ 2)
dHeightIncrement = Pt2.Elevation - Pt1.Elevation
If dHeightIncrement < 0 Then
Dim Pt As AeccPoint
Set Pt = Pt1
Set Pt1 = Pt2
Set Pt2 = Pt
dHeightIncrement = -dHeightIncrement
Else

End If '
tData.Elevation = icIncrement + Int(Pt1.Elevation / icIncrement) *
icIncrement
If tData.Elevation > Pt2.Elevation Then
GetData = False
Exit Function
Else

End If '
tData.FirstDistance = (tData.Elevation - Pt1.Elevation) * dTotalDist
/ dHeightIncrement
tData.UnitDistance = icIncrement * dTotalDist / dHeightIncrement
PtStart(0) = Pt1.Easting
PtStart(1) = Pt1.Northing
PtEnd(0) = Pt2.Easting
PtEnd(1) = Pt2.Northing
tData.Direction = ThisDrawing.Utility.AngleFromXAxis(PtStart, PtEnd)
GetData = True
Exit Function
ErrorHandler:
MsgBox "Unable to process data in Function 'GetData' due to:" &
vbCrLf & Err.Description, vbCritical, scMsgHeader
Err.Clear
GetData = False
End Function ' GetData
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Called from:
' Calls:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetPoint(spPrompt As String) As AeccPoint
On Error GoTo ErrorHandler
Dim oEnt As AcadEntity
Dim Pt(0 To 2) As Double
On Error Resume Next
ThisDrawing.Utility.GetEntity oEnt, Pt, "Select first Civil 3D point
object"
If Err <> 0 Then
Err.Clear
If MsgBox("No object was selected" & vbCrLf & "Do you wish to try
again ?", vbYesNo, scMsgHeader) = vbYes Then
GetPoint spPrompt
Else
Set GetPoint = Nothing
Exit Function
End If

Else

End If '
On Error GoTo ErrorHandler
If TypeOf oEnt Is AeccPoint Then
Set GetPoint = oEnt
Exit Function
End If
If MsgBox("The selected object was not a Civil 3D point" & vbCrLf &
"Do you wish to try again ?", vbYesNo, scMsgHeader) = vbYes Then
GetPoint spPrompt
Else
Set GetPoint = Nothing
End If
Exit Function
ErrorHandler:
MsgBox "Unable to process data in Function 'GetPoint' due to:" &
vbCrLf & Err.Description, vbCritical, scMsgHeader
Err.Clear
Set GetPoint = Nothing
End Function ' GetPoint



Paste the code into a vba module and add the two Civil 3D references
appropriate to your version of Civil 3D.

If you wanted to use a different increment for the height change the
value in the line:

Public Const icIncrement = 1


Regards


Laurie Comerford

alteru wrote:
> I am wanting to create a lisp routine that will set points at even
> elevations (ie: 100.00', 101.00', 102.00' etc.) between 2 selected aecc
> cogo points. I know civil3d can interpolate between selected points with
> "create points - interpolate", "incremental elevation" command but it
> wont do it to the even elevations if the picked points are not also to
> even elevations (ie: i want to select points with elevation of 98.07'
> and 103.57', and have it automatically set points at 99.00', 100.00',
> 101.00' 102.00' and 103.00' using the grade between selected points.)
>
> I can do simple lisp routines but this one is way out of my league LOL,
> any help would be appreciated.
Distinguished Contributor
cadtown
Posts: 363
Registered: ‎04-12-2004
Message 5 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

01-22-2009 07:46 PM in reply to: alteru
Try the attached routine (the slope is calculated from the elevations of the two points selected)
Is this what you are trying to do ?...
Contributor
alteru
Posts: 15
Registered: ‎01-29-2008
Message 6 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

02-11-2009 05:51 PM in reply to: alteru
I loaded the .vlx file and ran "int2pt", selected first point and then second point, then i recieve this error "error: Civil 3D API: The parameter is incorrect." We are running C3d 2009, is this an issue with the code?

thanks
alteru
Contributor
alteru
Posts: 15
Registered: ‎01-29-2008
Message 7 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

02-11-2009 05:58 PM in reply to: alteru
I dont know VBA code at all....we are using 2009

thanks
alteru
Distinguished Contributor
cadtown
Posts: 363
Registered: ‎04-12-2004
Message 8 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

02-11-2009 06:26 PM in reply to: alteru
Yeah, there was an issue with the code.
Try attached instead.
Contributor
alteru
Posts: 15
Registered: ‎01-29-2008
Message 9 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

02-12-2009 07:25 AM in reply to: alteru
Thanks, thats exactly what i was looking for!!!

Ok, I've got another one...

select civil 3d point object, select a random point (using "nearest" i would guess) on an arc, then select an ending point along the arc (not necessarily the end of the arc) to set a civil 3d point object with a user supplied grade (ie: -1%).

See attached JPG

Thanks
Alteru
Valued Contributor
anim8er_gie
Posts: 95
Registered: ‎10-01-2008
Message 10 of 10 (591 Views)

Re: Interpolate even elevations between two points in civil3d

02-12-2009 08:14 AM in reply to: alteru
Why didn't you generate contours for a surface that these points inhabit? With contour smoothing off, the verticies for the contour would be the locations you are looking for.

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community