Make a macro to resize sketch images

jviendu13 · September 16, 2016, 11:38am

Hello

Not yet done VBA, thirst for learning, knowledge of Matlab (= knowledge of everything that is looped...).

Objective:

-I have several materials (=1700 materials) to put on a plate with each one its photo (=1700 photos). So I planned to do some configurations with sketch images.

Working basis:

-I went back to my "equipment. SLDPRT" all the images and I renamed the sketches (from those sketch images).

-After seeing a lot of forums, I still can't see a semblance of a solution :'(.

Desired macro:

-Today I would like to resize the sketch images and create a configuration for each one.

-Of course 1700 times to resize an X position, a Y position, a width and a height + the configuration to be created of the name of the sketch = xD years.

-It is impossible (unless I am mistaken) to select all the sketch images and edit them at once, and moreover the sketch images are not subject to snapping.

Could you help me create this macro and/or share another solution,

Thank you in advance:D

Azrod · September 16, 2016, 12:10pm

Hello

That's a big thing. Good luck to whoever makes it:)

I imagine that not all photos have the same dimensions?

remrem · September 16, 2016, 12:42pm

Hello

To start VBA:

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

Then to insert an image into your sketch you need to use the InsertSketchPicture method described here: http://help.solidworks.com/2016/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~insertsketchpicture.html

An example in VBA is available here: http://help.solidworks.com/2016/english/api/sldworksapi/flip_sketch_picture_example_vb.htm

Break down your project into several steps: open the room, insert a single image, loop the images...

Otherwise it will be too complicated. Then come back to us...

jviendu13 · September 16, 2016, 5:36pm

Hello genius, here is my wish:

Let's say I have 2 images: KTT212.bmp and PPT213.bmp of the same size: 90mmx75mm

I would like: Create 2 sketch images on my "4mm Plan" with Sketch Name: KTT212 and PPT213 (not the name of "Sketch Image")

Here are the steps to be performed:

- Open my part "E:\user\Documents\Materials.sldprt"

- VariableName1 = Name "E:\user\Documents\KTT212.bmp" (= KTT212)

- Create a sketch

-> On "Plan at 4mm"

-> Sketched Name = NameVariable1

Create a configuration

-> Configuration Name = VariableName1

- Create a sketch image via "E:\user\Documents\KTT212.bmp"

-> Image Dimension 60mm x 50mm

- Loop on VariableName*

Thank you for your time, here is my challenge;D

remrem · September 19, 2016, 7:31am

Hi @jviendu13,

I will try to be clear. We are not here to make your code for you and deliver it to you functionally.

We're all here to help each other but not to do your job.

Try to start by reading the tutorials and other help and sketching out a code bourt. Then tell us your worries or problems and we will help you...

Learning to code takes time and commitment. If you are given ready-made things. You won't learn anything. S

Have a nice day.

jviendu13 · September 19, 2016, 8:49am

So that was easy.

Before I tackle the code as you stipulate, it's better to ask if the steps are suitable.

And contrary to what you think, I have eaten tutorials and other forums to provide me as an example. And this before, after and still now. By the way, the community around the VBA seems to be very welcoming to xD newbies.

By the way, I discovered that I have to list my folder where the images are located and thus the increment from one image to another will be done by itself. -> What you probably know. I'm not here to ask for a code but rather the commands from Solidworks.

Anyway, as I said, I'm just taking it in hand, try not to break my enthusiasm please.

My worries:

-Increment on 50 images of a folder : solved = you have to list the folder

Dir command it seems to me, I still have to learn how to use it on my side

-Access the properties of a sketch image : In search (Height, Width, Horizontal, Vertical)

This command below doesn't seem to work or more likely that I can't use it correctly

   swSketchPicture. GetSize width, height
    Debug.Print " Width: " & width * 1000 & " mm "
    Debug.Print " Height: " & height * 1000 & " mm"

-Retrieve the name of the image I insert and use it to rename the sketch + configuration: In search

Useful Note : The tutorials are for excel, and the Solidworks help does not show the "commands", so to find what I am looking for is a real headache.

jviendu13 · September 19, 2016, 8:50am

And here is My snippet of code with which I am trying to move forward:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Open Room
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
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

'Loop for i=1 to 50(=NbrFic)... child if
'Plan

boolstatus = Part.Extension.SelectByID2("Plan 4mm", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
'Equisse image
Part.SketchManager.InsertSketch True
Dim SkPicture As Object

'List, not insert: Dir command

'You have to get the name of the image as soon as you insert it
Set SkPicture = Part.SketchManager.InsertSketchPicture("C:\Users\ad36aaen\Documents\Usage\Design SdC\1300\Basic Structures\Structures\Hardware\Hardware Photos\P01\HO\TPL_REA390TL.png")
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Sketch220", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Sketch220", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

'Name sketched
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "1")
boolstatus = Part.Extension.SelectByID2("Sketch Image1577", "SKETCHBITMAP", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Sketch Image1577", "SKETCHBITMAP", 0, 0, 0, False, 0, Nothing, 0)

'Name Sketch Picture
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "2")
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

'Dossier
Dim myFeature As Object
Set myFeature = Part.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_Containing)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "3")
'Configuration
boolstatus = Part.Extension.SelectByID2("Default", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("4", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("4", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)

'Configuration Name
boolstatus = Part.SelectedFeatureProperties(15651274, 1, 1, 0.5, 0.400000005960464, 0, 0, 0, 0, "5")
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("2", "SKETCHBITMAP", 2.22464985227471E-02, 4.00000000000191E-03, -5.56639089934266E-02, False, 0, Nothing, 0)
Part.ClearSelection2 True
End Sub

remrem · September 19, 2016, 11:39am

Well, with your code and your explanations it's already much simpler and shows the work already done.

For your question:

-Access the properties of a sketch image : In search (Height, Width, Horizontal, Vertical)

This command below doesn't seem to work or more likely that I can't use it correctly

   swSketchPicture.GetSize width, height
    Debug.Print " Width: " & width * 1000 & " mm "
    Debug.Print " Height: " & height * 1000 & " mm"

The debug.print is only used to know the values for debugging, but not to modify them.

jviendu13 · September 19, 2016, 11:47am

Yes I saw my stupidity, it's just an xD value display, like a "plot". So I'm going for "setsize".

I thought I could get what I wanted with the code below, but no. The code only adds the sketch image to me without changing the dimensions = Sadness :'(

-> Solved = Joy:D

SkPicture.SetSize Width, Height, AspectRatioLocked <- Must put the values there --'
Width = 50/1000
Height = 60/1000 NOT A xD
AspectRatioLocked = False

Now that I've successfully resized, I need to tackle the renaming and the xD loop.

So the goal is to

-Make a Dir + loop to list all my images in a folder

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*?

-Each time retrieve the name of the image we are processing: Here I look for the "command" that calls the name of the image I just inserted. Just like I was looking for the setsize command ;D.

It's too good the VBA when the code works \o/

remrem · September 19, 2016, 12:19pm

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

jviendu13 · September 19, 2016, 12:37pm

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^^

remrem · September 19, 2016, 12:52pm

For the name try this:;-)

swSketchPicture.GetFeature.SetImportedFileName ("Name")

As for the list of files by extension.

I'll come back a little later...

jviendu13 · September 19, 2016, 1:04pm

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

remrem · September 19, 2016, 3:42pm

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

macro1.swp

jviendu13 · September 19, 2016, 4:07pm

Great, thank you.

remrem · September 20, 2016, 6:24am

Hello

I forgot: You have to add the Microsoft Scripting Runtime reference to the project in Tools / References

Good day.

jviendu13 · September 20, 2016, 8:36am

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

jviendu13 · September 20, 2016, 8:52am

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

remrem · September 20, 2016, 9:02am

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?

remrem · September 20, 2016, 9:20am

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