optimering og rettelse af MSVBA kode

Kender du dette:

ftp://ftp2.bentley.com/dist/collateral/Web/BI/LearningMS_VBA_excerpt.pdf

ja, jeg kender til det. Jeg har læst alle tænkelige manualer om MSVBA, der sker dog mystiske fejl. Jeg tror nu mest det er pga. Visual Basic fejl, ikke MicroStation relaterede funktioner. Nested For Loops og lignende.

Nu kan jo prøve at vise koden..

det kunne jeg jo egentligt godt.. synes bare det er lidt svært at forklare her, uden "live" kommunikation fra begge sider..

koden er her:

Public IsKloakk3DActiveFile As Boolean

Private Sub CheckIfKloakk3DIsActiveFile()
    Dim filename As String
   
    filename = ActiveDesignFile.Name
   
    If Right(filename, 4) = ".klo" Then
        IsKloakk3DActiveFile = True
    Else
        IsKloakk3DActiveFile = False
    End If
End Sub

Public Function IsKloakk3DAttached()
    Dim noa, nok, nol(500) As Integer
    Dim reffilename As String
    Dim intI, intJ As Integer
    nok = 0
    noa = ActiveModelReference.Attachments.Count
    intJ = 1
   
    If noa = 0 Then
        CadInputQueue.SendKeyin ("ddhmapman execute klo_ATT")
        For intI = 1 To ActiveModelReference.Attachments.Count
            If (Right(ActiveModelReference.Attachments(intI).DesignFile.Name, 4) = ".klo") Then
                nok = nok + 1
            End If
        Next intI
        For intI = 1 To nok
            nol(intI) = ActiveModelReference.Attachments(intI).Levels.Count
            MsgBox nol(intI)
        Next intI
        For intI = 1 To nok
            For a = 1 To nol(intI)
                ActiveModelReference.Attachments(intI).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = False
            Next a
        Next intI
        Exit Function
    Else
        For a = 1 To noa
            reffilename = ActiveModelReference.Attachments(a).DesignFile.Name
            If Right(reffilename, 4) = ".klo" Then
                nok = nok + 1
            End If
        Next a
       
        CadInputQueue.SendCommand ("ddhmapman execute klo_ATT")
       
        noa = ActiveModelReference.Attachments.Count
       
        For a = 1 To noa
            reffilename = ActiveModelReference.Attachments(a).DesignFile.Name
            If Right(reffilename, 4) = ".klo" Then
                nok = nok + 1
            End If
        Next a
       
        'For intI = 1 To nok
            'nol(intI) = ActiveModelReference.Attachments(intI).Levels.Count
            'For a = 1 To nol(intI)
                'ActiveModelReference.Attachments(intI).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = False
            'Next a
        'Next intI
    End If
End Function
Public Sub AlterLevelsKloakk3D(ByVal OnOrOff As Boolean, ByVal Tema As String)
   
    Dim Thing(500)
    Dim noa, nok As Integer
    noa = ActiveModelReference.Attachments.Count
    nok = 0
    intJ = 1
    For a = 1 To noa
        If (Right(ActiveModelReference.Attachments(a).DesignFile.Name, 4) = ".klo") Then
            nok = nok + 1
        End If
    Next a
    CheckIfKloakk3DIsActiveFile
   
    If Not IsKloakk3DActiveFile Then
        IsKloakk3DAttached
    End If
   
    If IsKloakk3DActiveFile Then
        Set intJ = Nothing
        Set Thing(1) = ActiveDesignFile
    Else
        noa = ActiveModelReference.Attachments.Count
        For intI = 1 To noa
            If (Right(ActiveModelReference.Attachments(intI).DesignFile.Name, 4) = ".klo") Then
                Set Thing(intJ) = ActiveModelReference.Attachments(intI)
                intJ = intJ + 1
            End If
        Next intI
    End If
    intJ = 1
    For intI = 1 To nok
   
        Select Case Tema
            Case "SlokkAlt":
                For a = 1 To Thing(intJ).Levels.Count
                    Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                Next a
            Case "skittvatnsleiding":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn spildevand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn spildevand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "ledn spildevand tryk", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn spildevand tryk").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "stik spildevand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("stik spildevand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "skittvatnsleidingTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn-txt spildevand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn-txt spildevand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "regnvatnsleiding":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn regnvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn regnvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "stik regnvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("stik regnvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "ledn vandløb", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn vandløb").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "ledn drænvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn drænvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "stik drænvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("stik drænvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "regnvatnsleidingTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn-txt regnvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn-txt regnvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "ledn-txt drænvand", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn-txt drænvand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "felagsleiding":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn fælles", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn fælles").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "ledn fælles tryk", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn fælles tryk").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf (InStr(1, Thing(intJ).Levels(a).Name, "stik fælles", vbBinaryCompare)) Then
                        Thing(intJ).Levels("stik fælles").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "felagsleidingTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If (InStr(1, Thing(intJ).Levels(a).Name, "ledn-txt fælles", vbBinaryCompare)) Then
                        Thing(intJ).Levels("ledn-txt fælles").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "skittvatnslutir":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn ", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "spild", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "hustank", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "renseanlæg", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "udledning t jord", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "skittvatnslutirTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn-txt", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "spild", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "regnvatnslutir":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn ", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "regn", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "drænvand", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "regnvatnslutirTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn-txt", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "regn", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "dræn", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "felagslutir":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn ", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "fælles", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        ElseIf InStr(1, Thing(intJ).Levels(a).Name, "samletank", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "felagslutirTekst":
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn-txt", vbBinaryCompare) Then
                        If InStr(1, Thing(intJ).Levels(a).Name, "fælles", vbBinaryCompare) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    End If
                Next a
            Case "annadnedlagt"
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "ledn Nedlagt-død", vbBinaryCompare) Then
                        Thing(intJ).Levels("ledn Nedlagt-død").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "stik nedlagt", vbBinaryCompare) Then
                        Thing(intJ).Levels("stik nedlagt").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "kn Nedlagt brønd spildevand", vbBinaryCompare) Then
                        Thing(intJ).Levels("kn Nedlagt brønd spildevand").IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
            Case "annadTekstoglutir"
                For a = 1 To Thing(intJ).Levels.Count
                    If InStr(1, Thing(intJ).Levels(a).Name, "kn-txt", vbBinaryCompare) Then
                        If (InStr(1, Thing(intJ).Levels(a).Name, "andet", vbBinaryCompare)) Or _
                          (InStr(1, Thing(intJ).Levels(a).Name, "drænvand", vbBinaryCompare)) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "ledn-txt", vbBinaryCompare) Then
                        If (InStr(1, Thing(intJ).Levels(a).Name, "drænvand", vbBinaryCompare)) Then
                            Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                        End If
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "Nedlagt", vbBinaryCompare) Then
                        Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "kn punkt", vbBinaryCompare) Then
                        Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "kn brønd andet", vbBinaryCompare) Then
                        Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "Ivamál", vbBinaryCompare) Then
                        Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    ElseIf InStr(1, Thing(intJ).Levels(a).Name, "_MA_KANNAST_", vbBinaryCompare) Then
                        Thing(intJ).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = OnOrOff
                    End If
                Next a
        End Select
        intJ = intJ + 1
    Next intI
End Sub

Mit problem er at jeg vil have koden at virke for alle "*.klo" filer som er ude - uden at arbejde alt for langsomt.. den virker som den skal, bortset fra at den er alt for langsom og når jeg slukker for en level, tændes alle andre levels. så jeg kan ikke slukke for alle på noget tidspunkt, siden det virker som om at når en level slukkes, kalder den en kode et eller andet sted fra (hvor??) som tænder alle levels..

den udkommenterede del:
-
        'For intI = 1 To nok
            'nol(intI) = ActiveModelReference.Attachments(intI).Levels.Count
            'For a = 1 To nol(intI)
                'ActiveModelReference.Attachments(intI).Levels(a).IsDisplayedInView(ActiveDesignFile.Views(1)) = False
            'Next a
        'Next intI
-
vil jeg egentligt også gerne have at virke, men hvis jeg prøver at fjerne kommentarene, giver den fejl i linjen:
nol(intI) = ActiveModelReference.Attachments(intI).Levels.Count
(selv om den linje virker fint alle andre steder i koden)

Ja det kan du have ret i - men nu kan andre måske være behjælpelige...

skal nok lige nævne at jeg går ud fra at det med at levels tænder hver gang jeg slukker for en level kan fikses ved at fjerne kommentarene (og få det til at virke alligevel) ved den udkommenterede del. det ville jeg mene skulle være relativt nemt for eksperterne her. ;-)

Ellers ville det større stykke arbejde være at optimere koden sådan at den ikke bruger ~1 min hver gang jeg vælger at tænde/slukke for levels.

lukker..