AnsweredAssumed Answered

Stuck on QR Code Macro

Question asked by Michael Ortíz on Nov 27, 2019
Latest reply on Dec 3, 2019 by Josh Brady

Hi,

 

I have been piecing together a macro that will generate and place a qr code on every sheet in a Drawing.  The text for the qr code is linked to the name of the sheet which is being pointed to by a custom parameter.  The Macro takes the text from that custom parameter and then executes a python script via a batch file for conversion to a .png image file.  I have successfully run this a few times without any issue.  However there are times when it will only pick up the name from one of the sheets and not loop through the others and pickup the individual sheet names.   A qrcode is generated and placed on every sheet but when I go to scan it they all read the same sheet name.  This was my first crack at making a macro. I pieced allot of this together from other macros on the forum.  The goal was to put qr codes on all our drawings with an offline solution.  I'm sure that I am missing something very simple that a more experienced person will pickup on right away.  At the end of the day I just want this to work so I can move on with the rest of my life.  Thanks in advanced for your help.

 

Regards,

Mike

 

 

Dim swApp           As Object
Dim Part            As Object
Dim boolstatus      As Boolean
Dim longstatus      As Long, longwarnings As Long
Dim swModel         As SldWorks.ModelDoc2
Dim swCustPropMgr   As SldWorks.CustomPropertyManager
Dim valOut          As String
Dim evalValOut      As String
Dim strBatpath      As String
Dim strCombined     As String
Dim strCommand      As String
Dim lngErrorCode    As Long
Dim swDraw          As SldWorks.DrawingDoc
Dim swSheet         As SldWorks.Sheet
Dim vSheetProps     As Variant
Dim nErrors         As Long
Dim nWarnings       As Long
Dim Path            As String
Dim vSheetName      As Variant
Dim i               As Long
Dim strPycall       As String
Dim sngOrigX        As Single
Dim sngOrigY        As Single
Dim varPicSize      As Variant
Dim sngHeight       As Single
Dim sngWidth        As Single

 

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal milliseconds As LongPtr) 'needed for sleep pause to work on 64 bit windows

 

Sub main()

 

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set Part = swApp.ActiveDoc 'added to make force rebuild work
    vSheetName = swDraw.GetSheetNames
    
    boolstatus = Part.ForceRebuild3(True) 'force rebuild

 

   'Start of loop
   
      For i = 0 To UBound(vSheetName)

 

        swDraw.ActivateSheet vSheetName(i)
        Set swSheet = swDraw.GetCurrentSheet
        vSheetProps = swSheet.GetProperties

 

    
       'Get name of current sheet by reading custom parameter "PageName"
        Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
        swCustPropMgr.Get3 "PageName", False, valOut, evalValOut
                
       'build string for batch file
        strBatpath = "C:\Users\m_ortiz\Documents\qrcode\code_generator.bat """
        strCombined = strBatpath & evalValOut & """"
 
        PID = Shell(strCombined, vbMinimizedNoFocus) 'run batch file executing python qrcode generator
        
        Debug.Print evalValOut
        'Debug.Print strCombined
               
        Call Sleep(1500) ' 1 second delay needed
         
       'set variables defaults for qrcode location and size (current settings are default
        sngOrigX = 0.01
        sngOrigY = 0.01
        varPicSize = 0.011
        sngHeight = vSheetProps(6)
        sngWidth = vSheetProps(5)

 

       
       'If/then loop to adjust size of qrcode picture if sheet size is large
       
        If sngHeight = 0.2794 And sngWidth = 0.2159 Then      'A size Vertical
            varPicSize = 0.011
        ElseIf sngHeight = 0.2159 And sngWidth = 0.2794 Then  'A size
            varPicSize = 0.011
        ElseIf sngHeight = 0.4318 And sngWidth = 0.2794 Then  'B size Vertical
            varPicSize = 0.011
        ElseIf sngHeight = 0.2794 And sngWidth = 0.4318 Then  'B size
            varPicSize = 0.011
        ElseIf sngHeight = 0.5588 And sngWidth = 0.4318 Then  'C size Vertical
            varPicSize = 0.018
        ElseIf sngHeight = 0.4318 And sngWidth = 0.5588 Then  'C size
            varPicSize = 0.018
        ElseIf sngHeight = 0.8636 And sngWidth = 0.5588 Then  'D size Vertical
            varPicSize = 0.025
        ElseIf sngHeight = 0.5588 And sngWidth = 0.8636 Then  'D size
            varPicSize = 0.025
        ElseIf sngHeight = 1.1176 And sngWidth = 0.8636 Then  'E size Vertical
            varPicSize = 0.04
        ElseIf sngHeight = 0.8636 And sngWidth = 1.1176 Then  'E size
            varPicSize = 0.04
        Else
            varPicSize = 0.011
        End If

 

       'Insert picture into solidworks
        Set Part = swApp.ActiveDoc
        Dim SkPicture As Object
        Set SkPicture = Part.SketchManager.InsertSketchPicture("C:\Users\m_ortiz\Documents\qrcode\temp.png")
        SkPicture.SetOrigin sngOrigX, sngOrigY
        SkPicture.SetSize varPicSize, varPicSize, 1
        swApp.RunCommand swCommands_Ok_Command, ""
                     
    Next i
    
   'End of loop

 

End Sub

Attachments

Outcomes