Public Sub ChangesSurveyFigureToNonBreakline()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim oAcadApp As Autodesk.AutoCAD.Interop.AcadApplication = Nothing
Dim oAeccSurveyApp As Autodesk.AECC.Interop.UiSurvey.AeccSurveyApplication = Nothing
Dim oAeccSurveyDoc As Autodesk.AECC.Interop.UiSurvey.AeccSurveyDocument = Nothing
Dim oAeccSurveyDB As Autodesk.AECC.Interop.Survey.AeccSurveyDatabase = Nothing
Dim opt1 As New PromptEntityOptions(vbCrLf & "Select survey figure to change to non-breakline: ")
opt1.SetRejectMessage(vbCrLf & "error!")
opt1.AppendKeywordsToMessage = False
opt1.AddAllowedClass(GetType(SurveyFigure), True)
Dim Res1 As PromptEntityResult = ed.GetEntity(opt1)
If (Res1.Status = PromptStatus.OK) Then 'single item picked
Using trans As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Try
If oAcadApp Is Nothing Then
oAcadApp = GetObject(, "AutoCAD.Application")
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(ex.Message)
End Try
Try
oAeccSurveyApp = oAcadApp.GetInterfaceObject("AeccXUiSurvey.AeccSurveyApplication.10.3")
oAeccSurveyDoc = oAeccSurveyApp.ActiveDocument
oAeccSurveyDB = oAeccSurveyApp.ActiveDocument.Database
Dim ent As Autodesk.AutoCAD.DatabaseServices.Entity = trans.GetObject(Res1.ObjectId, OpenMode.ForRead)
Dim oFigure As IAeccSurveyFigure = TryCast(ent, IAeccSurveyFigure)
oFigure.IsBreakline = False
oFigure.Save()
trans.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Error : ", ex.Message & vbCrLf)
End Try
End Using
End If
End Sub
Public Sub ChangesSurveyFigureToNonBreakline()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim oAcadApp As Autodesk.AutoCAD.Interop.AcadApplication = Nothing
Dim oAeccSurveyApp As Autodesk.AECC.Interop.UiSurvey.AeccSurveyApplication = Nothing
Dim oAeccSurveyDoc As Autodesk.AECC.Interop.UiSurvey.AeccSurveyDocument = Nothing
Dim oAeccSurveyDB As Autodesk.AECC.Interop.Survey.AeccSurveyDatabase = Nothing
Dim opt1 As New PromptEntityOptions(vbCrLf & "Select survey figure to change to non-breakline: ")
opt1.SetRejectMessage(vbCrLf & "error!")
opt1.AppendKeywordsToMessage = False
opt1.AddAllowedClass(GetType(SurveyFigure), True)
Dim Res1 As PromptEntityResult = ed.GetEntity(opt1)
If (Res1.Status = PromptStatus.OK) Then 'single item picked
Using trans As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Try
If oAcadApp Is Nothing Then
oAcadApp = GetObject(, "AutoCAD.Application")
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(ex.Message)
End Try
Try
oAeccSurveyApp = oAcadApp.GetInterfaceObject("AeccXUiSurvey.AeccSurveyApplication.10.3")
oAeccSurveyDoc = oAeccSurveyApp.ActiveDocument
oAeccSurveyDB = oAeccSurveyApp.ActiveDocument.Database
Dim oProjects As AeccSurveyProjects = CType(oAeccSurveyDB.Projects, AeccSurveyProjects)
Dim z As AeccSurveyProject = oProjects.Item(0)
Dim oSurveyFigure As AeccSurveyFigure = z.Figures.Item(1)
oSurveyFigure.IsBreakline = False
oSurveyFigure.Save()
oSurveyFigure.Reload()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Error : ", ex.Message & vbCrLf)
End Try
End Using
End If
End Sub
Public Sub ChangesSurveyFigureToNonBreakline()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim oAcadApp As Autodesk.AutoCAD.Interop.AcadApplication = Nothing
Dim oAeccSurveyApp As Autodesk.AECC.Interop.UiSurvey.AeccSurveyApplication = Nothing
Dim oAeccSurveyDoc As Autodesk.AECC.Interop.UiSurvey.AeccSurveyDocument = Nothing
Dim oAeccSurveyDB As Autodesk.AECC.Interop.Survey.AeccSurveyDatabase = Nothing
Dim opt1 As New PromptEntityOptions(vbCrLf & "Select survey figure to change to non-breakline: ")
opt1.SetRejectMessage(vbCrLf & "error!")
opt1.AppendKeywordsToMessage = False
opt1.AddAllowedClass(GetType(SurveyFigure), True)
Dim Res1 As PromptEntityResult = ed.GetEntity(opt1)
If (Res1.Status = PromptStatus.OK) Then
Using trans As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Try
If oAcadApp Is Nothing Then
oAcadApp = GetObject(, "AutoCAD.Application")
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(ex.Message)
End Try
Try
oAeccSurveyApp = oAcadApp.GetInterfaceObject("AeccXUiSurvey.AeccSurveyApplication.10.3")
oAeccSurveyDoc = oAeccSurveyApp.ActiveDocument
oAeccSurveyDB = oAeccSurveyApp.ActiveDocument.Database
Dim oEnt As Autodesk.AutoCAD.DatabaseServices.Entity = trans.GetObject(Res1.ObjectId, OpenMode.ForRead)
Dim TmpFigure As SurveyFigure = TryCast(oEnt, SurveyFigure)
Dim oSF As SurveyFigure = nothing
Dim oCurrentProject As AeccSurveyProject = oAeccSurveyDB.CurrentProject
For i As Integer = 0 To oCurrentProject.Figures.Count - 1
Dim oSurveyFigure As AeccSurveyFigure = oCurrentProject.Figures.Item(i)
Dim FigureId As ObjectId = New ObjectId(New IntPtr(oSurveyFigure.GetObjectId))
oSF = TryCast(trans.GetObject(FigureId, OpenMode.ForRead), SurveyFigure)
If oSF.Id = TmpFigure.Id Then
oSurveyFigure.IsBreakline = False
oSurveyFigure.Save()
End If
Next
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Error : ", ex.Message & vbCrLf)
End Try
End Using
End If
End Sub
<CommandMethod("DF")> _
Public Sub DeleteSurveyFigure()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim oAcadApp As Autodesk.AutoCAD.Interop.AcadApplication = Nothing
Dim oAeccSurveyApp As Autodesk.AECC.Interop.UiSurvey.AeccSurveyApplication = Nothing
Dim oAeccSurveyDoc As Autodesk.AECC.Interop.UiSurvey.AeccSurveyDocument = Nothing
Dim oAeccSurveyDB As Autodesk.AECC.Interop.Survey.AeccSurveyDatabase = Nothing
Dim opt1 As New PromptEntityOptions(vbCrLf & "Select survey figure to delete: ")
opt1.SetRejectMessage(vbCrLf & "error!")
opt1.AppendKeywordsToMessage = False
opt1.AddAllowedClass(GetType(SurveyFigure), True)
Dim entRes As PromptEntityResult = ed.GetEntity(opt1)
If (entRes.Status = PromptStatus.OK) Then 'single item picked
Using tr As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Dim acadent As AcadEntity = DirectCast(entRes.ObjectId.GetObject(OpenMode.ForRead).AcadObject, AcadEntity)
Dim survapp As New AeccSurveyApplication()
survapp.Init(DirectCast(Autodesk.AutoCAD.ApplicationServices.Application.AcadApplication, AutoCAD.Interop.AcadApplication))
Dim Surveydb As AeccSurveyDatabase = DirectCast(survapp.ActiveDocument.Database, AeccSurveyDatabase)
Dim surveyProj As AeccSurveyProject = Surveydb.CurrentProject
surveyProj.Open()
If surveyProj Is Nothing Then
Return
End If
Dim figs As AeccSurveyFigures = surveyProj.Figures
Dim id As Integer = 0
For Each fig As AeccSurveyFigure In figs
If fig.IsInDrawing(DirectCast(db.AcadDatabase, AcadDatabase)) AndAlso (fig.GetObjectId(DirectCast(db.AcadDatabase, AcadDatabase)) = acadent.ObjectID) Then
id = fig.ID
Exit For
End If
Next
If id <> 0 Then
figs.Remove(id)
End If
tr.Commit()
End Using
End If
End Sub
Dim BreaklineID as long
BreaklineID = fig.GetObjectId(DirectCast(db.AcadDatabase, AcadDatabase))
Dim hn As Handle = New Handle(BreaklineID)
Dim oid As ObjectId = db.GetObjectId(False, hn, 0)
Dim ent As AcadObject = DirectCast(tr.GetObject(oid, OpenMode.ForRead, False), AcadObject)
For Each fig As AeccSurveyFigure In figs
If fig.IsInDrawing(DirectCast(db.AcadDatabase, AcadDatabase)) AndAlso (fig.IsBreakline = True) Then
BreaklineID = fig.GetObjectId(DirectCast(db.AcadDatabase, AcadDatabase))
ed.WriteMessage(BreaklineID.ToString & vbCrLf)
Dim hn As Autodesk.AutoCAD.DatabaseServices.Handle = New Handle(BreaklineID)
Try
Dim oid As ObjectId = db.GetObjectId(False, hn, 0)
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Exception" & vbCrLf)
End Try
Dim ent As AcadObject = DirectCast(tr.GetObject(oid, OpenMode.ForRead, False).AcadObject, AcadObject)
End If
Next
I always seem to run into trouble by not knowing when I'm mixing COM and .NET objects together.Part of this confusion is compounded, I'm sure, by the use of VB.NET. Let me explain why....VB.NET doesn't care how you type things, as long as they are spelled correctly. For instance: OBjecTId, OBJECTID, objectid, ObjectID, ObjectId are all valid incarnations that would point to the same object. So you have no idea that the COM AcadDatabase ObjectID and the .NET Managed Acad.Database ObjectId are two different things. Whereas, in C#, you must type them exactly as they are defined in the API. So ObjectID (COM) and ObjectId (.NET) ARE 2 different objects, this is how I keep things sane when combining COM and managed code (which I try to keep to a minimum).
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.Civil.DatabaseServices
Imports Autodesk.AECC.Interop.Survey
Imports System
Public Class Main
Implements Autodesk.AutoCAD.Runtime.IExtensionApplication
Public Sub Initialize() Implements IExtensionApplication.Initialize
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor()
ed.WriteMessage("Initializing - " & My.Application.Info.AssemblyName)
End Sub
Public Sub Terminate() Implements IExtensionApplication.Terminate
End Sub
<CommandMethod("TEST1")> Public Sub Test1()
Dim oAcadApp As Autodesk.AutoCAD.Interop.AcadApplication = Nothing
Dim oAeccSurveyApp As Autodesk.AECC.Interop.UiSurvey.AeccSurveyApplication = Nothing
Dim oAeccSurveyDoc As Autodesk.AECC.Interop.UiSurvey.AeccSurveyDocument = Nothing
Dim oAeccSurveyDB As Autodesk.AECC.Interop.Survey.AeccSurveyDatabase = Nothing
oAcadApp = GetObject(, "AutoCAD.Application")
oAeccSurveyApp = oAcadApp.GetInterfaceObject("AeccXUiSurvey.AeccSurveyApplication.10.4")
oAeccSurveyDoc = oAeccSurveyApp.ActiveDocument 'AeccSurveyCOMDoc
oAeccSurveyDB = oAeccSurveyApp.ActiveDocument.Database
Using trans As Autodesk.AutoCAD.DatabaseServices.Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Dim oCurrentProject As AeccSurveyProject = oAeccSurveyDB.CurrentProject
For Each fig As AeccSurveyFigure In oCurrentProject.Figures
If fig.IsInDrawing(oAeccSurveyDB) Then
Dim comID As Long = fig.GetObjectId(oAeccSurveyDB)
Dim netID As Object = oAeccSurveyDB.ObjectIdToObject(comID)
Dim figID As Integer = fig.ID
End If
Next
End Using
End Sub
<CommandMethod("TEST2")> Public Sub Test2()
Dim oAcadApp As Object = Nothing
Dim oAeccSurveyApp As Object = Nothing
Dim oAeccSurveyDoc As Object = Nothing
Dim oAeccSurveyDB As Object = Nothing
oAcadApp = GetObject(, "AutoCAD.Application")
oAeccSurveyApp = oAcadApp.GetInterfaceObject("AeccXUiSurvey.AeccSurveyApplication.10.4")
oAeccSurveyDoc = oAeccSurveyApp.ActiveDocument 'AeccSurveyCOMDoc
oAeccSurveyDB = oAeccSurveyApp.ActiveDocument.Database
Using trans As Autodesk.AutoCAD.DatabaseServices.Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
Dim oCurrentProject As Object = oAeccSurveyDB.CurrentProject
For Each fig As Object In oCurrentProject.Figures
If fig.IsInDrawing(oAeccSurveyDB) Then
Dim comID As Long = fig.GetObjectId(oAeccSurveyDB)
Dim netID As Object = oAeccSurveyDB.ObjectIdToObject(comID)
Dim figID As Integer = fig.ID
End If
Next
End Using
End Sub
End Class
System.Runtime.InteropServices.COMException (0x8002802A): Type mismatch. (Exception from HRESULT: 0x8002802A (TYPE_E_WRONGTYPEKIND))
at Microsoft.VisualBasic.CompilerServices.LateBinding.InternalLateCall(Object o, Type objType, String name, Object[] args, String[] paramnames, Boolean[] CopyBack, Boolean IgnoreReturn)
at Main.Test2() in F:\Visual Studio\Projects\Main.vb:line 73
at Autodesk.AutoCAD.Runtime.CommandClass.InvokeWorker(MethodInfo mi, Object commandObject, Boolean bLispFunction)
at Autodesk.AutoCAD.Runtime.CommandClass.InvokeWorkerWithExceptionFilter(MethodInfo mi, Object commandObject, Boolean bLispFunction)
at Autodesk.AutoCAD.Runtime.PerDocumentCommandClass.Invoke(MethodInfo mi, Boolean bLispFunction)
at Autodesk.AutoCAD.Runtime.CommandClass.CommandThunk.Invoke()