Erstellen eines Makros zum Ändern der Größe von Skizzenbildern

3D Design Volume Model
1

Hallo

Noch nicht erledigt VBA, Lernhunger, Kenntnisse in Matlab (= Wissen über alles, was geloopt wird...).

 

Objektiv:

-Ich habe mehrere Materialien (=1700 Materialien), die ich auf einen Teller legen kann, mit jedem Foto (=1700 Fotos). Also hatte ich vor, einige Konfigurationen mit Skizzenbildern zu machen.

 

Arbeitsgrundlage:

-Ich ging zurück zu meiner "Ausrüstung. SLDPRT" und ich habe die Skizzen (aus diesen Skizzenbildern) umbenannt.

-Nachdem ich viele Foren gesehen habe, kann ich immer noch nicht den Anschein einer Lösung sehen :'(.

 

Gewünschtes Makro:

-Heute möchte ich die Größe der Skizzenbilder ändern und für jedes eine Konfiguration erstellen.

-Natürlich 1700 mal, um die Größe einer X-Position, einer Y-Position, einer Breite und einer Höhe zu ändern + die zu erstellende Konfiguration des Namens der Skizze = xD Jahre.

-Es ist unmöglich (es sei denn, ich irre mich), alle Skizzenbilder auszuwählen und sie auf einmal zu bearbeiten, und außerdem können die Skizzenbilder nicht eingerastet werden.

 

Könnten Sie mir helfen, dieses Makro zu erstellen und/oder eine andere Lösung zu teilen?

Vielen Dank im Voraus:D

2

Hallo

Das ist eine große Sache. Viel Glück demjenigen, der es schafft:)

Ich kann mir vorstellen, dass nicht alle Fotos die gleichen Abmessungen haben?

1 „Gefällt mir“
3

Hallo

So starten Sie VBA:

  1. http://didier-gonard.developpez.com/tutoriels/office/vba-qu-est-que-c-est/
  2. http://heureuxoli.developpez.com/office/word/vba-all/

 Um dann ein Bild in Ihre Skizze einzufügen, müssen Sie die hier beschriebene InsertSketchPicture-Methode verwenden: http://help.solidworks.com/2016/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~insertsketchpicture.html

Ein Beispiel in VBA finden Sie hier: http://help.solidworks.com/2016/english/api/sldworksapi/flip_sketch_picture_example_vb.htm

Unterteilen Sie Ihr Projekt in mehrere Schritte: Öffnen Sie den Raum, fügen Sie ein einzelnes Bild ein, wiederholen Sie die Bilder...

Sonst wird es zu kompliziert. Dann kommen Sie wieder zu uns...

2 „Gefällt mir“
4

Hallo Genie, hier ist mein Wunsch:

Nehmen wir an, ich habe 2 Bilder: KTT212.bmp und PPT213.bmp in der gleichen Größe: 90 mm x 75 mm

Ich möchte: Erstellen Sie 2 Skizzenbilder auf meinem "4mm Plan" mit dem Skizzennamen: KTT212 und PPT213 (nicht der Name von "Skizzenbild")

 

Hier sind die Schritte, die durchgeführt werden müssen:

- Öffnen Sie meinen Teil "E:\Benutzer\Dokumente\Materials.sldprt"

- VariableName1 = Name "E:\Benutzer\Dokumente\KTT212.bmp" (= KTT212)

- Erstellen einer Skizze

     -> auf "Plan bei 4mm"

     -> Skizzierter Name = NameVariable1

Erstellen einer Konfiguration

     -> Konfigurationsname = VariableName1

- Erstellen Sie ein Skizzenbild über "E:\Benutzer\Dokumente\KTT212.bmp"

     -> Bildmaß 60 mm x 50 mm

- Schleife für Variablenname*

 

Vielen Dank für deine Zeit, hier ist meine Herausforderung;D

 

5

Hallo @jviendu13,

Ich werde versuchen, es klar zu sagen. Wir sind nicht hier, um Ihren Code für Sie zu erstellen und ihn Ihnen funktional zu liefern.

Wir sind alle hier, um uns gegenseitig zu helfen, aber nicht, um deinen Job zu machen.

Versuchen Sie damit zu beginnen, die Tutorials und andere Hilfen zu lesen und einen Code-Artikel zu skizzieren. Dann teilen Sie uns Ihre Sorgen oder Probleme mit und wir helfen Ihnen weiter...

Das Erlernen des Programmierens erfordert Zeit und Engagement. Wenn man fertige Dinge bekommt. Du wirst nichts lernen. S

Schönen Tag.

2 „Gefällt mir“
6

Das war  also einfach.

Bevor ich den Code wie von Ihnen vorgegeben angehe, ist es besser zu fragen, ob die Schritte geeignet sind.

Und im Gegensatz zu dem, was Sie denken, habe ich Tutorials und andere Foren gegessen, um mir als Beispiel zu dienen. Und das vorher, nachher und auch heute noch. Übrigens, die Community rund um die VBA scheint xD-Neulingen gegenüber sehr gastfreundlich zu sein.

 

Übrigens habe ich festgestellt, dass ich meinen Ordner auflisten muss, in dem sich die Bilder befinden, und somit wird das Inkrement von einem Bild zum anderen von selbst durchgeführt. -> Was Sie wahrscheinlich wissen. Ich bin nicht hier, um nach einem Code zu fragen, sondern um die Befehle von Solidworks zu erhalten.

 

Wie auch immer, wie gesagt, ich nehme es nur in die Hand, versuche bitte, meinen Enthusiasmus nicht zu brechen.

 

Meine Sorgen:

-Inkrement auf 50 Bilder eines Ordners : gelöst = Sie müssen den Ordner auflisten

Dir-Befehl, so scheint es mir, ich muss noch lernen, wie ich ihn auf meiner Seite verwenden kann

 

-Greifen Sie auf die Eigenschaften eines Skizzenbildes zu : In der Suche (Höhe, Breite, Horizontal, Vertikal)

Dieser Befehl unten scheint nicht zu funktionieren oder es ist wahrscheinlicher, dass ich ihn nicht richtig verwenden kann

   swSketchPicture. GetSize Breite, Höhe
    Debug.Print "  Breite: " & Breite * 1000 & " mm "
    Debug.Print "  Höhe: " & Höhe * 1000 & " mm"

-Rufen Sie den Namen des eingefügten Bildes ab und verwenden Sie ihn, um die Skizze + Konfiguration umzubenennen: In der Suche

 

Nützlicher Hinweis : Die Tutorials sind für Excel, und die Solidworks-Hilfe zeigt die "Befehle" nicht an, so dass es ein echtes Kopfzerbrechen bereitet, das zu finden, wonach ich suche.

7

Und hier ist mein Code-Schnipsel, mit dem ich versuche, voranzukommen:

 

Dimmen swApp als Objekt
Teil als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim longstatus As Long, longwarnings As Long

Sub main()

swApp = _ setzen
Anwendung.SldWorks


Offener Raum
Set Part = swApp.OpenDoc6("C:\Benutzer\ad36aaen\Dokumente\Verwendung\Design SdC\1300\Grundstrukturen\Strukturen\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Hardware.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
myModelView als Objekt dimmen
Festlegen von myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Festlegen von myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Festlegen von myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized


'Schleife für i=1 bis 50(=NbrFic)... Kind, wenn
»Plan

boolstatus = Part.Extension.SelectByID2("Plan 4mm", "PLANE", 0, 0, 0, Falsch, 0, Nichts, 0)
"Equisse image
Part.SketchManager.InsertSketch True
SkBild als Objekt dimmen


'Liste, nicht einfügen: Befehl Dir

"Sie müssen den Namen des Bildes sofort abrufen, wenn Sie es einfügen
Set SkPicture = Part.SketchManager.InsertSketchPicture("C:\Benutzer\ad36aaen\Dokumente\Verwendung\Design SdC\1300\Grundstrukturen\Strukturen\Hardware\Hardware-Fotos\P01\HO\TPL_REA390TL.png")
Part.ClearSelection2 Wahr
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Skizze220", "SKIZZE", 0, 0, 0, Falsch, 0, Nichts, 0)
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("Skizze220", "SKIZZE", 0, 0, 0, Falsch, 0, Nichts, 0)


"Name skizziert
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, "1")
boolstatus = Part.Extension.SelectByID2("Sketch Image1577", "SKETCHBITMAP", 0, 0, 0, Falsch, 0, Nichts, 0)
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("Sketch Image1577", "SKETCHBITMAP", 0, 0, 0, Falsch, 0, Nichts, 0)


'Name Skizze Bild
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, "2")
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)


"Dossier
MyFeature als Objekt dimmen
Set myFeature = Part.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_Containing)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, "3")
"Konfiguration
boolstatus = Part.Extension.SelectByID2("Standard", "KONFIGURATIONEN", 0, 0, 0, Falsch, 0, Nichts, 0)
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("4", "KONFIGURATIONEN", 0, 0, 0, Falsch, 0, Nichts, 0)
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("4", "KONFIGURATIONEN", 0, 0, 0, Falsch, 0, Nichts, 0)


'Name der Konfiguration
boolstatus = Part.SelectedFeatureProperties(15651274, 1, 1, 0.5, 0.400000005960464, 0, 0, 0, 0, "5")
Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("2", "SKETCHBITMAP", 2.22464985227471E-02, 4.0000000000191E-03, -5.56639089934266E-02, Falsch, 0, Nichts, 0)
Part.ClearSelection2 Wahr
Ende Sub

8

Nun, mit deinem Code und deinen Erklärungen ist es schon viel einfacher und zeigt die bereits geleistete Arbeit.

 

Für Ihre Frage:

-Greifen Sie auf die Eigenschaften eines Skizzenbildes zu : In der Suche (Höhe, Breite, Horizontal, Vertikal)

Dieser Befehl unten scheint nicht zu funktionieren oder es ist wahrscheinlicher, dass ich ihn nicht richtig verwenden kann

   swSketchPicture.GetSize Breite, Höhe
    Debug.Print "  Breite: " & Breite * 1000 & " mm "
    Debug.Print "  Höhe: " & Höhe * 1000 & " mm"

Die debug.print wird nur verwendet, um die Werte für das Debuggen zu kennen, aber nicht, um sie zu ändern.

 

 

9

Ja ich habe meine Dummheit gesehen, es ist nur eine xD-Wertanzeige, wie ein "Plot". Also entscheide ich mich für "setsize".

Ich dachte, ich könnte mit dem folgenden Code bekommen, was ich wollte, aber nein. Der Code fügt mir nur das Skizzenbild hinzu, ohne die Abmessungen zu ändern = Traurigkeit :'(

-> Gelöst = Freude:D

SkPicture.SetSize Width, Height, AspectRatioLocked              <- Die Werte müssen dort eingefügt werden --'
Breite = 50/1000
Höhe = 60/1000                  NICHT ein  xD
AspectRatioLocked = Falsch

 

Nachdem ich die Größe erfolgreich geändert habe, muss ich mich mit der Umbenennung und der xD-Schleife befassen.

Das Ziel ist es also,

-Erstellen Sie eine Dir + Schleife, um alle meine Bilder in einem Ordner aufzulisten

Frage : Ich habe gesehen, dass es möglich ist, nur die *.ini, *bmp aufzulisten, aber ist es möglich, nur den Anfang zu berücksichtigen? wie KT*?

-Jedes Mal den Namen des Bildes abrufen, das wir gerade verarbeiten: Hier suche ich nach dem "Befehl", der den Namen des Bildes aufruft, das ich gerade eingefügt habe. Genau wie ich nach dem setsize-Befehl ;D gesucht habe.

 

Es ist zu gut, das VBA, wenn der Code funktioniert \o/

1 „Gefällt mir“
10

Genau das habe ich auch auf meiner Seite beobachten können.

Wenn ich in die SW-Hilfe schaue, enthält sie nichts! Das erste Mal, dass ich darauf stoße.

Also habe ich einen Umweg genommen:

So ändern Sie die Größe:

Sie müssen die setsize-Methode verwenden.

Im width-Parameter, dann der height-Parameter und schließlich true oder false, um das Seitenverhältnis zu blockieren

 

 

11

Haha^^

Ja, es hat funktioniert, ich hatte es kurz zuvor gefunden, und ich habe auch herausgefunden, warum mein Code nichts geändert hat. Die Werte an den richtigen Stellen zu platzieren hilft sehr xD.

Hier möchte ich mit dem Namen des Bildes umbenennen:

- Ich suche nach dem Befehl, um den Namen des letzten Bildes insert/use/ abzurufen, das vor meinen Augen liegt xD

- Für die Schleife: Ist es der Dir-Befehl, um alle Bilder eines Ordners nacheinander in einer Schleife hinzuzufügen?

Frage: Ich habe gesehen, dass es möglich ist, nur die *.ini, *bmp aufzulisten, aber ist es möglich, nur den Anfang zu berücksichtigen? wie KT*?

Nochmals vielen Dank für Ihre Zeit^^

12

Für den Namen mal so:;-)

swSketchPicture.GetFeature.SetImportedFileName ("Name")

 

Was die Liste der Dateien nach Erweiterung betrifft.

Ich komme etwas später zurück...

13

Für die Schleife habe ich diesen Code ausprobiert, aber er stürzt solidworks ab :'(

MyImage = Dir("C:\Benutzer\ad36aaen\Dokumente\P01\HO\")

Für i = 1 bis 3

..

Set SkPicture = Part.SketchManager.InsertSketchPicture(MyImage)

..

MyImage = Verzeichnis
Weiter i

14

Ich füge eine Makrodatei an, die die Dateien in einem Verzeichnis auflistet, dessen Name mit KT beginnt.

Ich denke, wir sollten einige Tests durchführen, um zu überprüfen, ob es sich um ein Bild handelt, indem  wir die Methode verwenden: oFl.Type


Makro1.swp
15

Großartig, danke.

16

Hallo

Ich habe vergessen: Sie müssen die Microsoft Scripting Runtime Referenz zum Projekt in Tools / Referenzen hinzufügen

Guten Tag.

17

Es geht gut voran,

-Größe ändern ok,

-Schlaufe ok,

-Der Name ist fast ok:

Wenn ich den Punkt nicht bis zum Ende belasse, wird Nom_EsquisseAP nicht berücksichtigt, es funktioniert nur, wenn es den Punkt gibt...

 

Ich schaue mir die von xD abgeleiteten Konfigurationen an

 

Mein Code:

Dimmen swApp als Objekt
Teil als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim longstatus As Long, longwarnings As Long
SkBild als Objekt dimmen
Dim-Instanz als ISketchPicture
Dim-Breite als Doppelt
Dim Höhe als Doppelt
Dim AspectRatioLocked als boolescher Wert
Dimmwert: Als boolescher Wert
Dim X Ace Doppelt
Dim Y As Double
System als Objekt          dimmen ' Dateisystem
Dim-Ordner als Objekt          ' Verzeichnis
Dim Files As Object          'Sammlung von Dateien aus dem Verzeichnis
Dim File As Object          ' File (Teil der Files-Sammlung)
Dim Nom_Dossier As String      ' Verzeichnisname
Dim Nom_Fichier As String      ' Dateiname
Dim Nom_EsquisseAV As String     ' Name der Frontskizze
Dimmen Nom_EsquisseAP als Zeichenfolge     ' Skizzenname nach
Dim k Als Ganzzahl

Sub main()

swApp = _ setzen
Anwendung.SldWorks

Set Part = swApp.OpenDoc6("C:\Benutzer\ad36aaen\Dokumente\Verwendung\Design SdC\1300\Grundstrukturen\Strukturen\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Hardware.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc

k = 1

'Lesen des Verzeichnisses
Nom_Dossier = "C:\Benutzer\ad36aaen\Dokumente\Nutzung\Design SdC\1300\Grundstrukturen\Strukturen\Hardware\Hardware-Fotos\P01\HO\Test"
Systemsatz = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
Set Files = Ordner.Dateien

'Schleife
Für jede Datei in Dateien
    "Namen erstellen
    Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
    Nom_EsquisseAV = "Skizze" & k
    Nom_EsquisseAP = Links(Fichier.Name, Len(Fichier.Name) - 3)
   

    "Auswahlplan
    boolstatus = Part.Extension.SelectByID2("Plan bis 4mm", "PLANE", 0, 0, 0, Falsch, 0, Nichts, 0)
    

    'Skizzenbild erstellen
    Part.SketchManager.InsertSketch True
    Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)
    

    'Größe ändern
    SkPicture.SetSize 50 / 1000, 60 / 1000, False
    SkPicture.SetOrigin -25/1000, -20/1000
    
    Part.ClearSelection2 Wahr
    

    Wählen Sie Skizze + Namen ändern
    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAV, "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)
    boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)
    

    Löschen Sie den Skizzenstatus = > wird heller, wenn wir bei der 1000. Skizze sind
    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)
    Teil.BearbeitenUnterdrücken2
    
    Part.ClearSelection2 Wahr

    k = k + 1
    
Nächste Datei
Ende Sub

18

Das war's, ich bin fertig,

Trotz dieses Problems des Stickens direkt nach dem Nomp funktioniert alles \o/

 

Code für Personen, die sehen / haben möchten:

Dimmen swApp als Objekt
Teil als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim longstatus As Long, longwarnings As Long
SkBild als Objekt dimmen
Dim-Instanz als ISketchPicture
Dim-Breite als Doppelt
Dim Höhe als Doppelt
Dim AspectRatioLocked als boolescher Wert
Dimmwert: Als boolescher Wert
Dim X Ace Doppelt
Dim Y As Double
System als Objekt          dimmen ' Dateisystem
Dim-Ordner als Objekt          ' Verzeichnis
Dim Files As Object          'Sammlung von Dateien aus dem Verzeichnis
Dim File As Object          ' File (Teil der Files-Sammlung)
Dim Nom_Dossier As String      ' Verzeichnisname
Dim Nom_Fichier As String      ' Dateiname
Dim Nom_EsquisseAV As String     ' Name der Frontskizze
Dimmen Nom_EsquisseAP als Zeichenfolge     ' Skizzenname nach

Sub main()

swApp = _ setzen
Anwendung.SldWorks

Set Part = swApp.OpenDoc6("C:\Benutzer\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Hardware.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc

k = 2

'Lesen des Verzeichnisses
Nom_Dossier = "C:\Benutzer\Hardware\Hardware-Fotos\P01\HO\Test"
Systemsatz = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
Set Files = Ordner.Dateien

'Kontrollieren Sie jede Datei im Verzeichnis
Für jede Datei in Dateien
    Erstellen eines Skizzenbilds und Aktualisieren der Bemaßungen
    Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
    Nom_EsquisseAP = Links(Fichier.Name, Len(Fichier.Name) - 3)
    
    boolstatus = Part.Extension.SelectByID2("Plan bis 4mm", "PLANE", 0, 0, 0, Falsch, 0, Nichts, 0)
    
    Part.SketchManager.InsertSketch True
    Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)
    
    SkPicture.SetSize 50 / 1000, 60 / 1000, False
    SkPicture.SetOrigin -25/1000, -20/1000
    
    Part.ClearSelection2 Wahr
    
    boolstatus = Part.Extension.SelectByID2("Skizze1", "SKIZZE", 0, 0, 0, Falsch, 0, Nichts, 0)
    boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)
    
    boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)
    Teil.BearbeitenUnterdrücken2
    
    boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "KONFIGURATIONEN", 0, 0, 0, Falsch, 0, Nichts, 0)
    boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", Falsch, Falsch, Falsch, Wahr, 256)
    
    Part.ClearSelection2 Wahr
    
Nächste Datei
Ende Sub

19

Ich verstehe nicht, warum es am Anfang zwei Mal Set Part gibt. Bei mir öffnest du den Raum und füllst die Variable Part aus. Dann sagen Sie ihm, dass die Variable Part gleich der aktuellen Datei ist.

Was den Namen angeht, verstehe ich das Problem nicht. Sie müssen den Punkt verlassen, wo?

20

Ich habe ein bisschen Hausarbeit gemacht. ;-)

Seien Sie vorsichtig, Sie müssen Objektvariablendeklarationen mit Vorsicht verwenden.

Im Grunde genommen passt es, im Programm zu sagen, ich weiß nicht, was es sein wird, es kann von einem Bolzen zu einem Elefanten werden, es liegt an Ihnen, es zu managen...

Probieren Sie das aus: ZUM TESTEN

Dimmen swApp als Objekt
Teil als Objekt dimmen
Dim boolstatus als boolescher Wert
Dim longstatus As Long, longwarnings As Long
SkBild als Objekt dimmen
Dim System As Scripting.FileSystemObject       'Dateisystem
Dim-Ordner als Ordner                            'Verzeichnis'
Dim-Datei als Datei                              ' Datei (Teil der Dateisammlung)
Dim Nom_Dossier As String                      ' Verzeichnisname
Dim Nom_Fichier As String                      ' Dateiname
Dim Nom_EsquisseAV As String                     ' Name der Frontskizze
Dim Nom_EsquisseAP As String                     ' Skizzenname nach

Sub main()
    Legen Sie swApp = Application.SldWorks fest
    Set Part = swApp.OpenDoc6("C:\Benutzer\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)

    'Lesen des Verzeichnisses
    Nom_Dossier="C:\Benutzer\Hardware\Hardware-Fotos\P01\HO\Test"
    Systemsatz = CreateObject("Scripting.FileSystemObject")
    Set Folder = System.GetFolder(Nom_Dossier)

    'Kontrollieren Sie jede Datei im Verzeichnis
    k = 2
    Für jede Datei in Folder.Files
        Erstellen eines Skizzenbilds und Aktualisieren der Bemaßungen
        Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
        Nom_EsquisseAP = Links(Fichier.Name, Länge(Fichier.Name) - 3)
        
        boolstatus = Part.Extension.SelectByID2("Plan bis 4mm", "PLANE", 0, 0, 0, Falsch, 0, Nichts, 0)
        
        Part.SketchManager.InsertSketch True
        Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)
        
        SkPicture.SetSize 50 / 1000, 60 / 1000, False
        SkPicture.SetOrigin -25/1000, -20/1000
        
        Part.ClearSelection2 Wahr
        
        boolstatus = Part.Extension.SelectByID2("Skizze1", "SKIZZE", 0, 0, 0, Falsch, 0, Nichts, 0)
        boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)
        
        boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, Falsch, 0, Nichts, 0)
        Teil.BearbeitenUnterdrücken2
        
        boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "KONFIGURATIONEN", 0, 0, 0, Falsch, 0, Nichts, 0)
        boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", Falsch, Falsch, Falsch, Wahr, 256)
        
        Part.ClearSelection2 Wahr
        
    Nächste Datei
Ende Sub