The code to do it in vb.net is below:
1: Option Explicit On
2:
3: Imports System.Runtime.InteropServices.Marshal
4: Imports Autodesk.AutoCAD.Runtime
5: Imports Autodesk.AutoCAD.ApplicationServices
6: Imports Autodesk.AutoCAD.DatabaseServices
7: Imports Autodesk.AutoCAD.EditorInput
8: Imports Autodesk.AutoCAD.Geometry
9: Imports Autodesk.Civil.DatabaseServices.Styles
10: Imports Autodesk.Civil.ApplicationServices
11: Imports Autodesk.Civil.Land.DatabaseServices
12: Imports AeccLandLib = Autodesk.AECC.Interop.Land
13: Imports AeccLandUi = Autodesk.AECC.Interop.UiLand
14: Imports AcadCom = Autodesk.AutoCAD.Interop
15: Imports System.Security
16: Imports C3DRemindersPack.Utilities
17:
18: <Assembly: CommandClass(GetType(FlattenFeatureLine))>
19:
20: Public Class FlattenFeatureLine
21:
22: Public Shared g_sName As String
23:
24: <CommandMethod("C3DRFlattenFeatureLine", CommandFlags.UsePickSet Or CommandFlags.Redraw Or CommandFlags.Modal)> _
25: Public Sub cmdFlattenFeatureLine()
26:
27: Try
28: 'Get Civil 3D application, document and database
29: GetCivilObject()
30:
31: Dim oDoc As Document = Application.DocumentManager.MdiActiveDocument
32: Dim ed As Editor = oDoc.Editor
33:
34: Try
35: Dim selectionRes As PromptSelectionResult = ed.SelectImplied()
36: If selectionRes.Status = PromptStatus.Error Then
37: ' Ask the user to select points.
38: Dim selectionOpts As New PromptSelectionOptions()
39: selectionOpts.MessageForAdding = vbLf & "Select feature line to flatten: "
40: selectionRes = ed.GetSelection(selectionOpts)
41: Else
42: ' If there was a pickfirst set, clear it.
43: ed.SetImpliedSelection(New ObjectId(-1) {})
44: End If
45:
46: ' If the user hasn't cancelled.
47: If selectionRes.Status = PromptStatus.OK Then
48: ' Take the objects one by one.
49: Dim tr As Transaction = oDoc.TransactionManager.StartTransaction()
50: Try
51:
52: Dim objIds As ObjectId() = selectionRes.Value.GetObjectIds()
53: For Each objId As ObjectId In objIds
54: Dim ent As Entity = DirectCast(tr.GetObject(objId, OpenMode.ForRead), Entity)
55: ' Check to see if the entity is a point.
56: If TypeOf ent Is FeatureLine Then
57: Dim oFeatLine As AeccLandLib.AeccLandFeatureLine
58:
59: Dim entid As ObjectId = ent.ObjectId
60: Dim obj As Object = g_oCivil3DDoc.ObjectIdToObject(entid.OldIdPtr)
61: oFeatLine = obj
62: oFeatLine.ShowToolTip() = False
63: Dim dPoints() As Double
64: dPoints = oFeatLine.GetPoints()
65:
66: Dim i As Integer
67:
68: For i = 2 To UBound(dPoints)
69: dPoints(i) = 0
70: i = i + 2
71: Next
72:
73: oFeatLine.SetPointsElevation(dPoints)
74:
75: End If
76: Next
77: tr.Commit()
78: Catch ex As Autodesk.AutoCAD.Runtime.Exception
79: ed.WriteMessage(ex.Message)
80: tr.Abort()
81:
82: End Try
83: End If
84: Catch ex As Autodesk.AutoCAD.Runtime.Exception
85: ed.WriteMessage(ex.Message)
86: End Try
87:
88:
89:
90: Catch ex As Exception
91:
92: Finally
93:
94:
95: End Try
96:
97:
98: End Sub
99:
100: End Class
I may have some unneeded items in it, but it should get the job done. Hopefully in a future version the Civil 3D developers will provide the command currently located on the Elevation Editor. I didn’t test it, but the code should take several selected feature lines and flatten all of them. You should be able to take the code from the Civil 3D Reminders Pack and add this class to it and compile the code and use netload to load the dll.
1 comment:
create post. Now after a few weeks of C++ programming class I can actually follow along on your programming and function calls.
Post a Comment