---

Hallo Forum,

ich möchte mir ein Formular erstellen zum Abspeichern von Zeichnungen.
Über eine Einschränkung sollen nur ausgewählte Ordner angezeigt werden.
(z.B. alle Pfade die das Wort "See" enthalten)
Wird nun das Verzeichniss "Seestraße" ausgewählt, soll danach ein Dateiname "Seestraße-Entwurf" vorgeschlagen werden.

Besteht die Möglichkeit so etwas zurealisieren. Ich konnte im Forum nichts finden.

Gruß Björn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Björn,

was hast du denn schon gemacht ?

Hier mal ein Beispiel wie du die Verzeichnisse auslesen könntest.
Am besten erzeugts du dir ein Formular in dem z.b. zwei List Controls drin sind.
Eines ist halt für die Verzeichnisse und eines für die vorhandenen Dateien.

Code:

---

    Dim vlst_RootDir As String
    vlst_RootDir = "C:\Temp\"
   
    Dim vlst_Folder As String
    vlst_Folder = Dir(vlst_RootDir & "ID*", vbDirectory)
    While Not vlst_Folder = ""
        Debug.Print vlst_Folder
        lst_DirList.AddItem vlst_Folder
        vlst_Folder = Dir
    Wend

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Wilfried,

danke für deine schnelle Antwort, sie hat mein Problem gelöst.
Nun habe ich ein Formular zus Speicherhilfe geschrieben.

Aber ich hab noch eine Frage: mit dem Befehl
Dir(vlst_RootDir & "ID*", vbDirectory)
werden ja sowohl Dateien als auch Ordner aufgelistet, kann ich das auf Ordner begrenzen?

Gruß Björn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ich mag die DIR Methode nicht wirklich (vor allem weil man damit nicht rekursiv in Unterverzeichnissen suchen kann)

Ich verwende dazu gerne das Microsoft Scripting
Unter Extras -> Verweise -> Hakerl auf Microsoft Scripting Runtime (scrrun.dll)

Dann geht das so

    Dim tSc As New Scripting.FileSystemObject
   
    Dim tFo As Folder
    Set tFo = sc.GetFolder("c:\temp")
   
    Dim tFile As File
    For Each tFile In tFo.Files
        Debug.Print tFile.Name
    Next
   
    Dim tFolder As Folder
    For Each tFolder In tFo.SubFolders
        Debug.Print tFolder.Name
    Next

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Anton,

besten Dank, Dein Tipp ist in den Code schon eingeflossen.

Noch zwei Fragen zu den Verweisen:
- Gibt es ein Listing aller Verweise und je eine Dokumentation?
- Ist es egal wie viele Verweise an einer DBV hängen?

Dir und allen anderen Nutzern schöne Weihnachten und einen Guten Rutsch

Gruß Björn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Björn,

die Verweise gelten je DVB Datei.

Du kannst IMHO beliebig viele Verweise einbinden, solltest dich aber auf das notwendige beschränken. Alles was du unter Verweisen angegeben hast muss auch auf dem Rechner auf dem das Script läuft vorhanden sein. Also unnötige Verweise auf Datenbanken, Office etc. vermeiden da dein Script sonst eventl. nicht auf dem anderen Rechner läuft. Die Ausführung von "Microsoft Scripting Runtime" z.b. kann auf einem Rechner unterbunden sein. Diese DLL stammt aus dem IE.

Die besten Wünsche für die Feiertage zurück

Wilfried Stelberg

PS: Was machen eure Radien in TB

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Wilfried,

Wenn Du die Radien in der ALK meinst, dafür hab ich noch keine Lösung erhalten.
Bei Neueinlesung soll das Problem behoben sein, aber für Alt-Daten harre ich der Dinge die da Kommen.

Gruß Björn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Björn,

fehlerhafte Radien kannst du im SQL Sheet ermitteln.

Code:

---

-- Beispiel für Grenzen
select fid,seq_param1 from AL_F_GRENZE_TBS_GEO where abs(SEQ_PARAM1) >1;

---

Ich habe dir mal ein wenig Programmcode angehängt mit dem du die Linien mal probeweise in AutoCAD prüfen/korregieren kannst. Ich vermute mal, dass die Linien den Gegenbogen darstellen.
Lade den Code doch mal in ein VBA Modul und bearbeite die Linien damit. Zu beachten ist, dass eventuell mehrere Linien 2*Grenze, 2* Nutzung etc. übereinander liegen. Wenn es nicht so viele Linien sind, sollest du die so korregieren können. Andernfalls kann man da auch ein Proggi machen, welches die Linien direkt in Oracle ändert.

Code:

---

Type Punkt2D
    Rechts As Double
    Hoch As Double
    Bulge As Double
End Type

Sub polytest()
   
    Dim sset As AcadSelectionSet
    Dim Entity As AcadEntity
    Dim LWPolyline As AcadLWPolyline
   
    Set sset = ThisDrawing.PickfirstSelectionSet
    If sset.Count = 0 Then
        sset.Clear
        sset.SelectOnScreen
    End If
   
    Dim var_Punkte As Variant
    Dim z_Punkte() As Punkt2D
    Dim MaxPunkte As Long
   
    For Each Entity In sset
        If Entity.ObjectName = "AcDbPolyline" Then
            Set LWPolyline = Entity
           
            var_Punkte = LWPolyline.Coordinates
            MaxPunkte = (UBound(var_Punkte) + 1) / 2
            MaxPunkte = MaxPunkte + 1
            ReDim z_Punkte(1 To MaxPunkte)
           
            For i = 0 To UBound(var_Punkte) - 1 Step 2
                z_Punkte(i / 2 + 1).Rechts = var_Punkte(i)
                z_Punkte(i / 2 + 1).Hoch = var_Punkte(i + 1)
                z_Punkte(i / 2 + 1).Bulge = LWPolyline.GetBulge(i / 2)
            Next i
            ' Ersten als letzten Punkt anhängen
            z_Punkte(MaxPunkte).Rechts = var_Punkte(0)
            z_Punkte(MaxPunkte).Hoch = var_Punkte(1)
           
            Dim Sehne As Double
            Dim Pfeilhöhe As Double
            Dim Radius As Double
           
            For i = 1 To MaxPunkte - 1
                If Abs(z_Punkte(i).Bulge) > 1 Then
                    dy = z_Punkte(i + 1).Rechts - z_Punkte(i).Rechts
                    dx = z_Punkte(i + 1).Hoch - z_Punkte(i).Hoch
                    Sehne = Sqr(dy ^ 2 + dx ^ 2)
                    Alpha = 4# * Atn(z_Punkte(i).Bulge)
                    Radius = Sehne / (2# * Sin(Alpha / 2#))
                    Pfeilhöhe = (Sehne * z_Punkte(i).Bulge) / 2#
                    ' Pfeilhöhe des Gegenbogens
                    Pfeilhöhe = (Radius * 2# - Pfeilhöhe) * -1#
                    Bulge = (2# * Pfeilhöhe) / Sehne
                    LWPolyline.SetBulge i - 1, Bulge
                End If
            Next
            LWPolyline.color = acBlue
            LWPolyline.Update
        End If
    Next Entity
End Sub

---

Viel Erfolg
Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht. 
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP