This is exactly what I have also been able to observe on my side.
If I look in the SW help it contains nothing! The first time I encounter this.
So I used a roundabout way:
Here's how to change the size:
You need to use the setsize method.
In the width parameter, then the height parameter and finally true or false to block the aspect ratio
Haha^^
Yes it worked, I had found it just before, and I also found why my code didn't change anything. Putting the values in the right places helps a lot xD.
Here I am looking to rename with the name of the image:
- I'm looking for the command to retrieve the name of the last image insert/use/which is there in front of my eyes xD
- For the loop: Is it the Dir command to add all the images of a folder one by one in a loop?
Question: I saw that it is possible to list only the *.ini, *bmp, but is it possible to take into account only the beginning? like KT*?
Thank you again for your time^^
For the name try this:;-)
swSketchPicture.GetFeature.SetImportedFileName ("Name")
As for the list of files by extension.
I'll come back a little later...
For the loop I tried this code, but it crashes solidworks :'(
MyImage = Dir("C:\Users\ad36aaen\Documents\P01\HO\")
For i = 1 To 3
..
Set SkPicture = Part.SketchManager.InsertSketchPicture(MyImage)
..
MyImage = Dir
Next i
I'm attaching a macro file that lists the files in a directory whose name starts with KT.
I think we should do some tests to verify that it is an image using the method: oFl.Type
Great, thank you.
Hello
I forgot: You have to add the Microsoft Scripting Runtime reference to the project in Tools / References
Good day.
It's progressing well,
-Resize ok,
-Loop ok,
-The name almost ok:
If I don't leave the point to the end, Nom_EsquisseAP is not taken into account, it only works if there is the point...
I'm looking into the xD derived configurations
My code:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim instance As ISketchPicture
Dim Width As Double
Dim Height As Double
Dim AspectRatioLocked As Boolean
Dim value As Boolean
Dim X Ace Double
Dim Y As Double
Dim System As Object ' File System
Dim Folder As Object ' Directory
Dim Files As Object 'Collection of files from the directory
Dim File As Object ' File (part of the Files collection)
Dim Nom_Dossier As String ' Directory Name
Dim Nom_Fichier As String ' File Name
Dim Nom_EsquisseAV As String ' Front Sketch Name
Dim Nom_EsquisseAP As String ' Sketch Name After
Dim k As Integer
Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.OpenDoc6("C:\Users\ad36aaen\Documents\Usage\Design SdC\1300\Basic Structures\Structures\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Hardware.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
k = 1
'Reading the directory
Nom_Dossier = "C:\Users\ad36aaen\Documents\Usage\Design SdC\1300\Basic Structures\Structures\Hardware\Hardware Photos\P01\HO\Test"
System Set = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
Set Files = Folder.Files
'Loop
For Each File In Files
'Create names
Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
Nom_EsquisseAV = "Sketch" & k
Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)
'Selection Plan
boolstatus = Part.Extension.SelectByID2("Plan to 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
'Create Sketch Image
Part.SketchManager.InsertSketch True
Set SkPicture = Part.SketchManager.InsertSketchPicture(Nom_Fichier)
'Resize
SkPicture.SetSize 50 / 1000, 60 / 1000, False
SkPicture.SetOrigin -25/1000, -20/1000
Part.ClearSelection2 True
Select Sketch + Change Name
boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAV, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)
Delete sketch state => will lighten when we are at the 1000th sketch
boolstatus = Part.Extension.SelectByID2(Nom_EsquisseAP, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditSuppress2
Part.ClearSelection2 True
k = k + 1
Next File
End Sub
That's it, I'm done,
Despite this problem of stitching just after the nomp, everything works \o/
Code for people who would like to see/have:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim instance As ISketchPicture
Dim Width As Double
Dim Height As Double
Dim AspectRatioLocked As Boolean
Dim value As Boolean
Dim X Ace Double
Dim Y As Double
Dim System As Object ' File System
Dim Folder As Object ' Directory
Dim Files As Object 'Collection of files from the directory
Dim File As Object ' File (part of the Files collection)
Dim Nom_Dossier As String ' Directory Name
Dim Nom_Fichier As String ' File Name
Dim Nom_EsquisseAV As String ' Front Sketch Name
Dim Nom_EsquisseAP As String ' Sketch Name After
Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.OpenDoc6("C:\Users\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 "Hardware.SLDPRT", False, longstatus
Set Part = swApp.ActiveDoc
k = 2
'Reading the directory
Nom_Dossier = "C:\Users\Hardware\Hardware Photos\P01\HO\Test"
System Set = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
Set Files = Folder.Files
'Control each file in the directory
For Each File In Files
Create a sketch image and update the dimensions
Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)
boolstatus = Part.Extension.SelectByID2("Plan to 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 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 True
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 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, False, 0, Nothing, 0)
Part.EditSuppress2
boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", False, False, False, True, 256)
Part.ClearSelection2 True
Next File
End Sub
I don't understand why there are two times Set Part at the beginning. For me you open the room and you fill in the variable Part. Then you tell him that the Part variable is equal to the current file.
As for the name, I don't understand the problem. You have to leave the point where?
I did a bit of housework. ;-)
Be careful, you must use Object variable declarations with caution.
Basically, it suits to say in the program, I don't know what it's going to be, it can go from a bolt to an elephant, it's up to you to manage...
Try this: TO TEST
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim System As Scripting.FileSystemObject 'File System
Dim Folder As Folder 'Directory'
Dim File As File ' File (Part of the Files Collection)
Dim Nom_Dossier As String ' Directory Name
Dim Nom_Fichier As String ' File Name
Dim Nom_EsquisseAV As String ' Front Sketch Name
Dim Nom_EsquisseAP As String ' Sketch Name After
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.OpenDoc6("C:\Users\Hardware\Hardware.SLDPRT", 1, 0, "", longstatus, longwarnings)
'Reading the directory
Nom_Dossier="C:\Users\Hardware\Hardware Photos\P01\HO\Test"
System Set = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
'Control each file in the directory
k = 2
For Each File In Folder.Files
Create a sketch image and update the dimensions
Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 3)
boolstatus = Part.Extension.SelectByID2("Plan to 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 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 True
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 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, False, 0, Nothing, 0)
Part.EditSuppress2
boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", False, False, False, True, 256)
Part.ClearSelection2 True
Next File
End Sub
My name: KT211.bmp
If I take KT211(.bmp)
My Nom_EsquisseAP is equal to KT211 (cf MsgBox)
But therein lies the problem, the name of sketch does not change
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, Nom_EsquisseAP)
On the other hand, if I leave the KT211 point, then it works, the sketch name is indeed modified.
The modifications are just the double set part and the "files" that you replace directly with folder.files (instead of folder.files?) to avoid creating a set of files that is only used once. I haven't seen another one xD
Can you send me the part file as well as the folder containing some images?
So that I can test
So that's not going to be possible xD. I am a nuclear engineer.
For your information everything is in deleted state in my room, so if there are no rooms it's the same.
Quickly create a folder with 3 images in it and it will work the same way.
Indeed, it works by creating a plan.
It works perfectly for me. The name of the sketch is of the configuration do not have the point.
The code:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SkPicture As Object
Dim System As Scripting.FileSystemObject 'File System
Dim Folder As Folder 'Directory'
Dim File As File ' File (Part of the Files Collection)
Dim Nom_Dossier As String ' Directory Name
Dim Nom_Fichier As String ' File Name
Dim Nom_EsquisseAV As String ' Front Sketch Name
Sun Nom_EsquisseAP As String ' Sketch Name After
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.OpenDoc6("C:\Users\rmorel\Desktop\Part1.SLDPRT", 1, 0, "", longstatus, longwarnings)
'Reading the directory
Nom_Dossier = "C:\Users\rmorel\Desktop\Test"
System Set = CreateObject("Scripting.FileSystemObject")
Set Folder = System.GetFolder(Nom_Dossier)
'Control each file in the directory
k = 2
For Each File In Folder.Files
Create Sketch Image and Update Dimensions
Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
Nom_EsquisseAP = Left(Fichier.Name, Len(Fichier.Name) - 4)
boolstatus = Part.Extension.SelectByID2("Plan to 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 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 True
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 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, False, 0, Nothing, 0)
Part.EditSuppress2
boolstatus = Part.Extension.SelectByID2("AM_P01_HO", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.AddConfiguration2("AM_" & Nom_EsquisseAP, "", "", False, False, False, True, 256)
Part.ClearSelection2 True
Next File
End Sub
Here, I found a bug by the way.
It's related to my variable k to move on to the other sketch that I lifted because it was no longer useful.
The BUG
- Creates a sketch
- Renamed the
- Create a new sketch => it will be called sketch2
- Creates a sketch
- Renamed the
- Creates a configuration
- Create a new sketch => it will be called sketch1
To put it simply, the configuration allows for an update, so for a sketched code you will have to take into account whether you are creating configurations or not.
For my part, without I needed an increment k and to call the "sketches" & k
With configuration I just have to call the "sketch1"
Xd
Azrod
Hello
That's a big thing. Good luck to whoever makes it:)
I imagine that not all photos have the same dimensions?
\o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o / \o/ \o/ \o/ \o
Resolute
How and by what means???
You can find all the code in the discussions...
If it's to discuss a detail, don't hesitate to ask your question. Try to be a little more precise than how you did it xD.
As a reminder:
- Insert a sketch image
- Changing the dimension of the sketch image after inserting it
- Dimensioning according to the type of material
- Sketch Name = Material Name
- Create a configuration
- Configuration Name = Hardware Name
- Loop on all materials in a file