Sorry Guy's everything is openforWrite (I think) so the problem is probably my clunky student grade code. : )
Entire code apart from posted function below:
Public Class NetworkFix
Implements Autodesk.AutoCAD.Runtime.IExtensionApplication
'Private m_doc As CivilDocument = Nothing
Public Shared m_trans As Transaction = Nothing
'Private m_Database As Database = Nothing
'Private m_Editor As Editor = Nothing
'Public Shared g_oPipeApplication As AeccPipeApplication = Nothing
'Public Shared oPipeDocument As AeccPipeDocument = Nothing
'Public Shared oPipeDatabase As AeccPipeDatabase = Nothing
'Public Shared oPipeNetworks As AeccPipeNetworks = Nothing
Public Shared oPipeNetwork3 As AeccPipeNetwork = Nothing
'Public Shared g_oCivil3DDoc As AeccLandUi.AeccDocument = Nothing
Public Shared M_PipeNetwork As AeccPipeNetwork = Nothing
'Public Shared oacaddoc As oAcadDocument
Public Shared NET_PipeNetwork As Network
Public Shared contextVal As Object
Public Shared contextfound = False
Public Shared IDNewStructure As ObjectId = Nothing
Public Shared oNewStruc As Autodesk.Civil.DatabaseServices.Structure = Nothing
Shared useThisEntityOption As PromptEntityOptions
Shared useThisEntityResult As PromptEntityResult
Sub Initialize() Implements Autodesk.AutoCAD.Runtime.IExtensionApplication.Initialize
DemandLoading.RegistryUpdate.RegisterForDemandLoading()
End Sub
Sub Terminate() Implements Autodesk.AutoCAD.Runtime.IExtensionApplication.Terminate
End Sub
Private Shared Sub handle_promptEntityOptions(ByVal sender As Object, ByVal e As PromptEntityOptionsEventArgs)
useThisEntityOption = e.Options
End Sub
Private Shared Sub handle_promptEntityResult(ByVal sender As Object, ByVal e As PromptEntityResultEventArgs)
useThisEntityResult = e.Result
End Sub
<CommandMethod("MikeC3dPAck", "MeccNetworkFixConnections", CommandFlags.Modal)> _
Public Sub MeccNetworkTools()
'Get Civil 3D application, document and database
If Not GetCivilApplication() Then
Exit Sub
End If
Dim Start As Boolean = True
Dim frmPipeTools As New FrmPipeNetworkTools
'Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
m_trans = db.TransactionManager.StartTransaction()
Dim netpipe As Pipe = Nothing
Dim onetstructure As Autodesk.Civil.DatabaseServices.Structure = Nothing
Try
Dim entopts As New PromptEntityOptions("Select Network: ")
entopts.Message = "Select Network: "
Dim ent As PromptEntityResult = Nothing
Dim Opipe1 As Autodesk.AECC.Interop.Pipe.AeccPipe = Nothing
Dim oStructure1 As Autodesk.AECC.Interop.Pipe.AeccStructure = Nothing
Try
ent = m_Editor.GetEntity(entopts)
Catch
m_Editor.WriteMessage("You did not select a valid entity")
RemoveHandler m_Editor.PromptingForEntity, AddressOf handle_promptEntityOptions
RemoveHandler m_Editor.PromptedForEntity, AddressOf handle_promptEntityResult
End Try
RemoveHandler m_Editor.PromptingForEntity, AddressOf handle_promptEntityOptions
RemoveHandler m_Editor.PromptedForEntity, AddressOf handle_promptEntityResult
' Try
If ent.Status = PromptStatus.OK Then
Dim entid As ObjectId = ent.ObjectId
Dim entity1 As Autodesk.AutoCAD.DatabaseServices.Entity = DirectCast(M_trans.GetObject(entid, OpenMode.ForRead, True), Autodesk.AutoCAD.DatabaseServices.Entity)
Dim obj As Object = entity1 'g_oCivil3DDoc.ObjectIdToObject(entid.OldIdPtr)
If TypeOf obj Is Pipe Then
netpipe = obj
Opipe1 = netpipe.AcadObject
ElseIf TypeOf obj Is Autodesk.Civil.DatabaseServices.Structure Then
onetstructure = obj
oStructure1 = onetstructure.AcadObject
Else
m_Editor.WriteMessage("The selection was not a member of a PipeNetwork")
'm_trans.Abort()
End If
'CLEAR Dictionary entries
Dim NETpipeNetworkID
Dim NETpipeNetwork As Network = Nothing
Dim sPipeNetwork1 As String
'sPipeNetwork1 = FindPipeNetworkName(Opipe1, oStructure1, oPipeDocument)
Try
For Each NETpipeNetworkID In m_doc.GetPipeNetworkIds
NETpipeNetwork = M_trans.GetObject(NETpipeNetworkID, OpenMode.ForWrite, False, False)
'If NETpipeNetwork.Name = sPipeNetwork1 Then
' NET_PipeNetwork = NETpipeNetwork
' M_PipeNetwork = NET_PipeNetwork.AcadObject
'End If
If Not netpipe Is Nothing Then
For Each opipeid As ObjectId In NETpipeNetwork.GetPipeIds
Dim npipe As Pipe = M_trans.GetObject(opipeid, OpenMode.ForWrite, False, False)
If netpipe.Name = npipe.Name Then
NET_PipeNetwork = NETpipeNetwork
npipe = Nothing
netpipe = Nothing
End If
Next
ElseIf onetstructure Is Nothing Then
For Each oStrucId As ObjectId In NETpipeNetwork.GetPipeIds
Dim nstructure As Autodesk.Civil.DatabaseServices.Structure = m_trans.GetObject(oStrucId, OpenMode.ForWrite, False, False)
If onetstructure.Name = nstructure.Name Then
NET_PipeNetwork = NETpipeNetwork
onetstructure = Nothing
nstructure = Nothing
End If
Next
End If
Next
Catch
End Try
End If
''Add partslist and family data
For Each opipeId As ObjectId In NET_PipeNetwork.GetPipeIds
netpipe = DirectCast(M_trans.GetObject(opipeId, OpenMode.ForWrite, True), Pipe)
Dim iox As Double = netpipe.StartPoint.X
Dim ioy As Double = netpipe.StartPoint.Y
Dim eox As Double = netpipe.EndPoint.X
Dim eoy As Double = netpipe.EndPoint.Y
Dim ioZ As Double = netpipe.StartPoint.Z
Dim eoZ As Double = netpipe.EndPoint.Z
If netpipe.ConnectedPartCount < 2 Then 'We have a a disconnected structure
Dim Netstructure As [Structure] = Nothing
For Each OstructureID As ObjectId In NET_PipeNetwork.GetStructureIds
Netstructure = DirectCast(M_trans.GetObject(OstructureID, OpenMode.ForWrite, True), [Structure])
If Netstructure.Location.X = iox And Netstructure.Location.Y = ioy Then
Try
If netpipe.StartStructureId = Nothing Then
netpipe.ConnectToStructure(ConnectorPositionType.Start, OstructureID, True)
End If
Catch
End Try
ElseIf Netstructure.Location.X = eox And Netstructure.Location.Y = eoy Then
Try
If netpipe.EndStructureId = Nothing Then
netpipe.ConnectToStructure(ConnectorPositionType.End, OstructureID, True)
End If
Catch
End Try
Else ' We have no structure at the end, create one and connect it
If netpipe.StartStructureId = Nothing Then ' Still nothing
''add structure
Try
AddStructure(NET_PipeNetwork, netpipe.StartPoint, netpipe, ConnectorPositionType.Start)
netpipe.ConnectToStructure(ConnectorPositionType.Start, oNewStruc.ObjectId, True)
Catch
End Try
ElseIf netpipe.EndStructureId = Nothing Then 'Still nothing
Try
AddStructure(NET_PipeNetwork, netpipe.EndPoint, netpipe, ConnectorPositionType.End)
netpipe.ConnectToStructure(ConnectorPositionType.End, oNewStruc.ObjectId, True)
Catch
End Try
End If
'Next structure
End If
Next
End If
Next
'Catch
'End Try
M_trans.Commit()
Catch ex As System.Exception
m_Editor.WriteMessage("Exception Message is : " + ex.Message.ToString())
If M_trans IsNot Nothing Then M_trans.Abort()
Finally
If M_trans IsNot Nothing Then M_trans.Dispose()
End Try
ResetVar()
End Sub
Let me know if you see anything. (There's probably loads here, still learning)
Mike
Mike Evans
Civil3D 2022 English
Windows 7 Professional 64-bit
Intel(R) Core(TM) i7-3820 CPU @ 3.60GHz (8 CPUs), ~4.0GHz With 32768MB RAM, AMD FirePro V4900, Dedicated Memory: 984 MB, Shared Memory: 814 MB
