Tracing an electrical network in AutoCAD Map 3D

Hi, all

well my problem that i want to trace an electrical network over an autocad drawing. Each entity in this drawing contains object data which has some information. On this basis of information i want to create a tracing.

Though i have been partially been successful, but not able to do it throughly, So i m requesting u all to suggest wat all the modification should be done to complete the tracing.

I am attaching the sample file over which i have done the code as well as whole code

Plz pplz suggest me somethng bcoz i hv went out of mind

sample.dwg

Hi, all

well my problem that i want to trace an electrical network over an autocad drawing. Each entity in this drawing contains object data which has some information. On this basis of information i want to create a tracing.

 

Though i have been partially been successful, but not able to do it throughly, So i m requesting u all to suggest wat all the modification should be done to complete the tracing.

 

I am attaching the sample file over which i have done the code as well as whole code

 

Plz pplz suggest me somethng bcoz i hv went out of mind

My code part-I

Option Explicit
Dim i As Integer
Public iTypeFieldIndex As Integer
Public iPillar_NumberFieldIndex As Integer
Public iCKT_NO As Integer
Public iSTATUS As Integer
Public i2_CKTNO As Integer
Public i4m_CKTNO As Integer
Public iPillar4m As Integer
Public iPillar2 As Integer
Dim PillarArray() As Long
Dim LT_Array() As Long
Public iLT_array As Integer
Public iPillararray As Integer
Public SSet4LT_name As Variant
Dim ssetLineObj As AcadSelectionSet
'Entry level function
Public Function Get_8W_PillarAttributes()
ZoomExtents 'Full extent the current drawing
iPillararray = 0
iLT_array = 0
iTypeFieldIndex = GetPillar_TypeFieldIndexes() 'get field index of type field in pillar object data
iPillar_NumberFieldIndex = GetPillar_PillarNo_FieldIndexes() 'get the pillar number index of pillartype field in pillar object data
iPillar4m = GetLT_Pillar4m_Index()
iPillar2 = GetLT_Pillar2_Index()
i4m_CKTNO = GetLT_4m_CKTNO_Index()
i2_CKTNO = GetLT_2_CKTNO_Index()
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim OD_PB As ODTable ' variable to connect to PB table
Set OD_PB = acad.Projects(ThisDrawing).ODTables.Item("PILLAR_BOUNDARY") ' setting up the table for use
Dim ODrcs_PB As ODRecords
Set ODrcs_PB = OD_PB.GetODRecords ' get all records in the table
Dim pillar_8W_objectID() As Long 'store pillar objectID in an array
Dim iPillarCount As Integer
Dim PillarNo() As Long
Dim iPillarNo As Integer 'store pillarnumber in this array
For Each acadOBJ In ThisDrawing.ModelSpace
   boolVal = ODrcs_PB.Init(acadOBJ, True, False)
       Do While ODrcs_PB.IsDone = False
           If ODrcs_PB.Record.Item(iTypeFieldIndex).Value = "8W" Then
               iPillarCount = iPillarCount + 1
               iPillarNo = iPillarNo + 1
               ReDim Preserve pillar_8W_objectID(iPillarCount) As Long
               ReDim Preserve PillarNo(iPillarNo) As Long
               pillar_8W_objectID(iPillarCount - 1) = ODrcs_PB.Record.ObjectID
               PillarNo(iPillarNo - 1) = ODrcs_PB.Record.Item(iPillar_NumberFieldIndex).Value
           End If
         ODrcs_PB.Next
       Loop
Next
Call GetObjects_in_Pillars(pillar_8W_objectID(), PillarNo()) 'passing pillar objID and pillarno
End Function
Private Function GetPillar_TypeFieldIndexes()
Dim ODtbs As ODTables
Dim iType As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("PILLAR_BOUNDARY").ODFieldDefs.Count - 1
   'get the field index of "TYPE" field
       If ODtbs.Item("PILLAR_BOUNDARY").ODFieldDefs.Item(i).Name = "TYPE" Then
           iType = i
       End If
Next i
GetPillar_TypeFieldIndexes = iType
End Function
Private Function GetPillar_PillarNo_FieldIndexes()
Dim ODtbs As ODTables
Dim iPillarNo As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("PILLAR_BOUNDARY").ODFieldDefs.Count - 1
   'get the field index of "PILLAR_NO" field
       If ODtbs.Item("PILLAR_BOUNDARY").ODFieldDefs.Item(i).Name = "PILLAR_NO" Then
           iPillarNo = i
       End If
Next i
GetPillar_PillarNo_FieldIndexes = iPillarNo
End Function
Private Function GetObjects_in_Pillars(pillar_8W_objectID() As Long, PillarNo() As Long)
Dim minExt As Variant
Dim maxExt As Variant
Dim ssetObj As AcadSelectionSet
Dim iNo_of_Pillars As Integer
Dim mode As Integer
mode = acSelectionSetCrossing
If ThisDrawing.SelectionSets.Count > 0 Then
   For i = (ThisDrawing.SelectionSets.Count - 1) To 0 Step -1
       ThisDrawing.SelectionSets.Item(i).Delete
   Next i
End If
If ThisDrawing.SelectionSets.Count = 0 Then
   
   For iNo_of_Pillars = 0 To (UBound(pillar_8W_objectID()) - 1) Step 1
       Dim acadLWPOLY As AcadLWPolyline
       Set acadLWPOLY = Nothing
       Set acadLWPOLY = ThisDrawing.ObjectIdToObject(pillar_8W_objectID(iNo_of_Pillars))
       acadLWPOLY.GetBoundingBox minExt, maxExt
       'declaration of selesection set
       Set ssetObj = Nothing
'        MsgBox "Pillar Number: " & pillarno(iNo_of_Pillars)
       'Create a filter for getting only CIRCUIT BLOCKS
       Set ssetObj = ThisDrawing.SelectionSets.Add(pillar_8W_objectID(iNo_of_Pillars))
       Dim gpCode(0) As Integer
       Dim dataValue(0) As Variant
       gpCode(0) = 8
       Dim iDataValue As Integer
       iDataValue = 0
       
       For iDataValue = 0 To (ThisDrawing.Layers.Count - 1) Step 1
           If Left$(ThisDrawing.Layers.Item(iDataValue).Name, 3) = "CIR" Then
               dataValue(0) = ThisDrawing.Layers.Item(iDataValue).Name
           End If
       Next iDataValue
       
       Dim groupCode As Variant, dataCode As Variant
       groupCode = gpCode
       dataCode = dataValue
       ssetObj.Select mode, maxExt, minExt, groupCode, dataCode
       Call GetCBObjects(ssetObj, PillarNo(iNo_of_Pillars))
   
   Next
End If
End Function
Private Sub GetCBObjects(ssetObj As AcadSelectionSet, PillarNo As Long)
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim ODT As ODTables
Set ODT = acad.Projects(ThisDrawing).ODTables
Dim OD_CB As ODTable
Set OD_CB = ODT.Item("CIRCUIT_BNDY")
Dim minExt As Variant
Dim maxExt As Variant
Dim acblock As AcadBlockReference
Dim ODrcs_CB As ODRecords
Dim ODrc_CB As ODRecord
Set ODrcs_CB = Nothing
iCKT_NO = GetCB_CKTNO_Index()
iSTATUS = GetCB_Status_Index()
Dim iCKT45 As Integer, iCKT4 As Integer, iCKT5 As Integer
For Each acadOBJ In ssetObj
   If Left$(acadOBJ.Layer, 3) = "CIR" Then
       Set ODrcs_CB = OD_CB.GetODRecords
       ODrcs_CB.Init acadOBJ, False, False
       If ODrcs_CB.IsDone = True Then
           boolVal = True
       End If
       
       Do Until ODrcs_CB.IsDone 'This runs for number of circuit breakers in the given pillar
           Set ODrc_CB = ODrcs_CB.Record
           If ODrc_CB.Item(iCKT_NO).Value = "CKT4" And ODrc_CB.Item(iSTATUS).Value = "CLOSE" Then
               iCKT45 = iCKT45 + 1
               iCKT4 = iCKT4 + 1
           End If
           If ODrc_CB.Item(iCKT_NO).Value = "CKT5" And ODrc_CB.Item(iSTATUS).Value = "CLOSE" Then
               iCKT45 = iCKT45 + 1
               iCKT5 = iCKT5 + 1
           End If
           ODrcs_CB.Next
       Loop
   
   End If
Next
'Check which side of pillar is feeded
If iCKT45 = 2 Then
   MsgBox "Entry Level Pillar: " & PillarNo
   Call For_Each_CB_EntryPillar(ssetObj, PillarNo)
Else:
   MsgBox "More than one entry level pillars"
       If iCKT4 = 1 And iCKT5 = 0 Then
           MsgBox "Left side of entry level pillar is feeded by DT"
       Else: MsgBox "Right side of entry level pillar is feeded by DT"
       End If
End If
End Sub
Private Function GetCB_CKTNO_Index()
Dim ODtbs As ODTables
Dim iCKT As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("CIRCUIT_BNDY").ODFieldDefs.Count - 1
       If ODtbs.Item("CIRCUIT_BNDY").ODFieldDefs.Item(i).Name = "CKT_NO" Then
          iCKT = i
       End If
Next i
GetCB_CKTNO_Index = iCKT
End Function
Private Function GetCB_Status_Index()
Dim ODtbs As ODTables
Dim iSTAT As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("CIRCUIT_BNDY").ODFieldDefs.Count - 1
       If ODtbs.Item("CIRCUIT_BNDY").ODFieldDefs.Item(i).Name = "STATUS" Then
          iSTAT = i
       End If
Next i
GetCB_Status_Index = iSTAT
End Function
Private Function For_Each_CB_EntryPillar(ssetObj As AcadSelectionSet, PillarNo As Long)
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim ODT As ODTables
Set ODT = acad.Projects(ThisDrawing).ODTables
Dim OD_CB As ODTable
Set OD_CB = ODT.Item("CIRCUIT_BNDY")
Dim minExt As Variant
Dim maxExt As Variant
Dim acblock As AcadBlockReference
Dim ODrcs_CB As ODRecords
Dim ODrc_CB As ODRecord
Dim mode As Integer
mode = acSelectionSetCrossing
Set ODrcs_CB = Nothing
For Each acadOBJ In ssetObj
   If Left$(acadOBJ.Layer, 3) = "CIR" Then
       Set ODrcs_CB = OD_CB.GetODRecords
       ODrcs_CB.Init acadOBJ, False, False
       If ODrcs_CB.IsDone = True Then
           boolVal = True
       End If
       Do Until ODrcs_CB.IsDone 'This runs for number of circuit breakers in the given pillar
           Set ODrc_CB = ODrcs_CB.Record
           Set acblock = Nothing
           Set acblock = ThisDrawing.ObjectIdToObject(ODrcs_CB.Record.ObjectID)
           acblock.GetBoundingBox minExt, maxExt
           Call LT_4_Each_CB(acblock, minExt, maxExt, PillarNo, ODrc_CB.Item(iCKT_NO).Value)
           'SSet4LT_name = PillarNo & "." & ODrc_CB.Item(iCKT_NO).Value
           ODrcs_CB.Next
       Loop
   End If
Next
End Function

Private Function GetLT_Pillar4m_Index()
Dim ODtbs As ODTables
Dim iPillar4m As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("LT_CABLE").ODFieldDefs.Count - 1
       If ODtbs.Item("LT_CABLE").ODFieldDefs.Item(i).Name = "FROM_PILLARNO" Then
          iPillar4m = i
       End If
Next i
GetLT_Pillar4m_Index = iPillar4m
End Function
Private Function GetLT_Pillar2_Index()
Dim ODtbs As ODTables
Dim iPillar2 As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("LT_CABLE").ODFieldDefs.Count - 1
       If ODtbs.Item("LT_CABLE").ODFieldDefs.Item(i).Name = "TO_PILLARNO" Then
          iPillar2 = i
       End If
Next i
GetLT_Pillar2_Index = iPillar2
End Function
Private Function GetLT_4m_CKTNO_Index()
Dim ODtbs As ODTables
Dim i4CKTNO As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("LT_CABLE").ODFieldDefs.Count - 1
       If ODtbs.Item("LT_CABLE").ODFieldDefs.Item(i).Name = "FROM_CKTNO" Then
          i4CKTNO = i
       End If
Next i
GetLT_4m_CKTNO_Index = i4CKTNO
End Function
Private Function GetLT_2_CKTNO_Index()
Dim ODtbs As ODTables
Dim i2CKTNO As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("LT_CABLE").ODFieldDefs.Count - 1
       If ODtbs.Item("LT_CABLE").ODFieldDefs.Item(i).Name = "TO_CKTNO" Then
          i2CKTNO = i
       End If
Next i
GetLT_2_CKTNO_Index = i2CKTNO
End Function
Private Function LT_4_Each_CB(acblock As AcadBlockReference, minExt As Variant, maxExt As Variant, PillarNo As Long, CB_CKT_No As Variant)
Dim acadOBJ As Object
Dim mode As Integer
mode = acSelectionSetCrossing
Dim SSet4LT As AcadSelectionSet
MsgBox PillarNo & "." & CB_CKT_No
Set SSet4LT = ThisDrawing.SelectionSets.Add(PillarNo & "." & CB_CKT_No)
'Create a filter for getting only LT_Cable
Dim gpCode(0) As Integer
gpCode(0) = 8
Dim dataValue(0) As Variant
Dim iDataValue As Integer
iDataValue = 0
For iDataValue = 0 To (ThisDrawing.Layers.Count - 1) Step 1
   If Left$(ThisDrawing.Layers.Item(iDataValue).Name, 2) = "LT" Then
       dataValue(0) = ThisDrawing.Layers.Item(iDataValue).Name
   End If
Next iDataValue
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
SSet4LT.Select mode, maxExt, minExt, groupCode, dataCode
MsgBox "Number of LT: " & PillarNo & "." & CB_CKT_No & "=" & SSet4LT.Count
'for each CB
'MsgBox SSet4LT.Count
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim ODT As ODTables
Set ODT = acad.Projects(ThisDrawing).ODTables
Dim OD_LT As ODTable
Set OD_LT = ODT.Item("LT_CABLE")
Dim ODrcs_LT As ODRecords
Dim ODrc_LT As ODRecord
Dim iRecord As Integer
iRecord = 0
For Each acadOBJ In SSet4LT
   If Left$(acadOBJ.Layer, 2) = "LT" Then
       Set ODrcs_LT = OD_LT.GetODRecords
       ODrcs_LT.Init acadOBJ, False, False

       If ODrcs_LT.IsDone = True Then
           boolVal = True
       End If

       Do Until ODrcs_LT.IsDone 'This runs for number of circuit breakers in the given pillar
           Set ODrc_LT = ODrcs_LT.Record
           'Add this LT_Cable to the existing array
           ReDim Preserve LT_Array(iLT_array) As Long
           LT_Array(iLT_array) = ODrc_LT.ObjectID
           iLT_array = iLT_array + 1
           For i = 0 To (UBound(LT_Array) - 1) Step 1
               If ODrc_LT.ObjectID = LT_Array(i) Then
                   iRecord = iRecord + 1
               End If
           Next
           If iRecord = 0 Then
               If Not ODrc_LT.Item(i2_CKTNO).Value = "MP" Or Not ODrc_LT.Item(i4m_CKTNO).Value = "MP" Then
                   If ODrc_LT.Item(iPillar2).Value = "SERVICE" Then
                       MsgBox ODrc_LT.Item(iPillar4m).Value & "." & ODrc_LT.Item(i4m_CKTNO).Value & "-->" & "SERVICE POINT"
                   Else:
                       MsgBox ODrc_LT.Item(iPillar4m).Value & "." & ODrc_LT.Item(i4m_CKTNO).Value & "-->" & ODrc_LT.Item(iPillar2).Value & "." & ODrc_LT.Item(i2_CKTNO).Value
                   Call To_Pillar(ODrc_LT.Item(iPillar2).Value, ODrc_LT.Item(i2_CKTNO).Value, LT_Array())
                   GoTo nextrecord
                   End If
               Else:
                   MsgBox ODrc_LT.Item(iPillar4m).Value & "." & ODrc_LT.Item(i4m_CKTNO).Value & "-->" & ODrc_LT.Item(iPillar2).Value & "." & ODrc_LT.Item(i2_CKTNO).Value
'                    Call To_MP
               End If
           End If
nextrecord:
           ODrcs_LT.Next
       Loop
   End If
Next
End Function
Private Function To_Pillar(PillarNo As Long, CKT_No As Variant, LT_Array() As Long)
MsgBox "PillarNo: " & PillarNo & " " & "CKT Number: " & CKT_No
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim boolBC As Boolean
Dim OD_PB As ODTable
Set OD_PB = acad.Projects(ThisDrawing).ODTables.Item("PILLAR_BOUNDARY")
Dim ODrcs_PB As ODRecords
Dim ODrc_PB As ODRecord
Dim iPillar As Long
Dim Pillar_ObjectID As Long
For Each acadOBJ In ThisDrawing.ModelSpace
   If Left$(acadOBJ.Layer, 6) = "PILLAR" Then
       Set ODrcs_PB = OD_PB.GetODRecords
       ODrcs_PB.Init acadOBJ, False, False
       If ODrcs_PB.IsDone = True Then
           boolVal = True
       End If
       Do Until ODrcs_PB.IsDone
         Set ODrc_PB = ODrcs_PB.Record
         iPillar = ODrc_PB.Item(iPillar_NumberFieldIndex).Value
           If iPillar = PillarNo Then
               Pillar_ObjectID = ODrc_PB.ObjectID
               If ODrc_PB.Item(iTypeFieldIndex).Value = "6W" Or ODrc_PB.Item(iTypeFieldIndex).Value = "4W" Or ODrc_PB.Item(iTypeFieldIndex).Value = "2W" Or ODrc_PB.Item(iTypeFieldIndex).Value = "FUMP" Then
                   MsgBox "The pillar is " & ODrc_PB.Item(iTypeFieldIndex).Value & " TYPE"
                   'create selection set for this pillar
                   Dim ssetPillar As AcadSelectionSet
                   Dim acadLWPOLY As AcadLWPolyline
                   Dim minExt As Variant
                   Dim maxExt As Variant
                   Set acadLWPOLY = Nothing
                   Set acadLWPOLY = ThisDrawing.ObjectIdToObject(Pillar_ObjectID)
                   acadLWPOLY.GetBoundingBox minExt, maxExt
                   'declaration of selesection set
                   ReDim Preserve PillarArray(iPillararray) As Long
                   PillarArray(iPillararray) = Pillar_ObjectID
                   'Create a filter for getting only CIRCUIT BLOCKS
                   Dim mode As Integer
                   mode = acSelectionSetCrossing
                   MsgBox PillarArray(iPillararray) & "." & (iPillararray + 1)
                   Set ssetPillar = Nothing
                   Set ssetPillar = ThisDrawing.SelectionSets.Add(PillarArray(iPillararray) & "." & (iPillararray + 1))
                   Dim gpCode(0) As Integer
                   Dim dataValue(0) As Variant
                   gpCode(0) = 8
                   Dim iDataValue As Integer
                   iDataValue = 0
                       For iDataValue = 0 To (ThisDrawing.Layers.Count - 1) Step 1
                           If Left$(ThisDrawing.Layers.Item(iDataValue).Name, 3) = "CIR" Then
                               dataValue(0) = ThisDrawing.Layers.Item(iDataValue).Name
                           End If
                       Next iDataValue
                   Dim groupCode As Variant, dataCode As Variant
                   groupCode = gpCode
                   dataCode = dataValue
                   ssetPillar.Select mode, maxExt, minExt, groupCode, dataCode
                   iPillararray = iPillararray + 1
                    Call Get_CB_in_Pillar(ssetPillar, PillarNo, LT_Array())
               Else:
                   MsgBox "Inside MP: Pillar"
'                    Exit Function
               End If
           End If
       ODrcs_PB.Next
'        Exit Function
       Loop
   End If
Next
End Function

Private Function Get_CB_in_Pillar(ssetPillar As AcadSelectionSet, PillarNo As Long, LT_Array() As Long)
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Dim boolVal As Boolean
Dim ODT As ODTables
Set ODT = acad.Projects(ThisDrawing).ODTables
Dim OD_CB As ODTable
Set OD_CB = ODT.Item("CIRCUIT_BNDY")
Dim minExt As Variant
Dim maxExt As Variant
Dim acblock As AcadBlockReference
Dim ODrcs_CB As ODRecords
Dim ODrc_CB As ODRecord
Dim mode As Integer
mode = acSelectionSetCrossing
Dim SSet_LT As AcadSelectionSet
Set ODrcs_CB = Nothing
For Each acadOBJ In ssetPillar
   If Left$(acadOBJ.Layer, 3) = "CIR" Then
       Set ODrcs_CB = OD_CB.GetODRecords
       ODrcs_CB.Init acadOBJ, False, False
       If ODrcs_CB.IsDone = True Then
           boolVal = True
       End If
       Do Until ODrcs_CB.IsDone 'This runs for number of circuit breakers in the given pillar
           Set ODrc_CB = ODrcs_CB.Record
           Set acblock = Nothing
           Set acblock = ThisDrawing.ObjectIdToObject(ODrc_CB.ObjectID)
           acblock.GetBoundingBox minExt, maxExt
           'create selection set for each Circuit Breaker
               Set SSet_LT = ThisDrawing.SelectionSets.Add(ODrc_CB.ObjectID & "." & ODrc_CB.Item(iCKT_NO).Value)
               'Create a filter for getting only LT_Cable
               Dim gpCode(0) As Integer
               Dim dataValue(0) As Variant
               gpCode(0) = 8
               Dim iDataValue As Integer
               iDataValue = 0
               For iDataValue = 0 To (ThisDrawing.Layers.Count - 1) Step 1
                   If Left$(ThisDrawing.Layers.Item(iDataValue).Name, 2) = "LT" Then
                       dataValue(0) = ThisDrawing.Layers.Item(iDataValue).Name
                   End If
               Next iDataValue
               Dim groupCode As Variant, dataCode As Variant
               groupCode = gpCode
               dataCode = dataValue
               SSet_LT.Select mode, maxExt, minExt, groupCode, dataCode
'                MsgBox "The CB: " & PillarNo & "." & ODrc_CB.Item(iCKT_NO).Value
               If ODrc_CB.Item(iSTATUS).Value = "OPEN" Then
                   MsgBox "The CB: " & PillarNo & "." & ODrc_CB.Item(iCKT_NO).Value & " contains " & SSet_LT.Count & " LT_Cables and status of this CB: " & ODrc_CB.Item(iSTATUS).Value
               Else:
                   MsgBox "The CB: " & PillarNo & "." & ODrc_CB.Item(iCKT_NO).Value & " contains " & SSet_LT.Count & " LT_Cables and status of this CB: " & ODrc_CB.Item(iSTATUS).Value
                   Call LT_4_Each_CB(acblock, minExt, maxExt, PillarNo, ODrc_CB.Item(iCKT_NO).Value)
               End If
           ODrcs_CB.Next
       Loop
   End If
Next
End Function

Perhaps if you explained what the routine is supposed to do.

Also would you consider s LISP solution?

Perhaps if you explained what the routine is supposed to do.

 

Also would you consider s LISP solution?

I am trying my best to explain the problem: Hope my english is well enough

1. I have a electrical network drawing

2. Containing a pillar, circuit breakers, bus couplers, LT_Cable

3. Pillars are of many types of them are 8W, 6W, 4W, FUMP OR MP

4. 8W TYPE OF pillar is always a entry point for the network, ie. currents flows from them. on the condition that the 4 &

5 Circuit Breakers (C.B) are close

5. When we are decided which pillar( if 8W are many then) is the entry point we consider each circuit breakers one by one

6. when circuit breaker is selected then LT_Cables within its extents are found out. And its attribute of this cable is used for determining the route of the current flowing from given circuit to destination circuit.

7. This is done for every circuit in the pillar present

hope i m explaining well enough.............

now the second step in this

1. When we determin that current flows from given C.B in the 8W pillar to another CB in another pillar, then before iterating for each CB present in 8W it should make the "to pillar " as current pillar and find the number of CB present in this pillar and iterate for each CB for cables otherthan wat have been covered upwards........

2. if present, it should follow downstream again

eg....... in the sample drawing file attached

11061524 is main 8W pillar and contains 8 C.B, each counted from left side

from 1st CB ie 11061524.CKT01 the cable flows to 11061506.CKT03.

So at second iteration the pillar 11061506 should become primary pillar and downstream tracing should be done.

ie. for each CB in 11061506

say 11061506.CKT01--> 10060309.CKT02 an so on

so when it reaches the last pillar from where no cables originate it should go back to the previous pillars and iterate for the remaining CB in it. if thats finished then a step back for the previous pillar and iterate the remaining CB and so

untill and unless all CB and pillars are searched....

I am using AutoCAD 2004 Map 3D