Autocad Script Generator 2

screenshot_1-8-2016_1

https://msdn.microsoft.com/en-us/library/aa219843(v=office.11).aspx
https://msdn.microsoft.com/en-us/library/aa219840(v=office.11).aspx

The FileDialog object is called in FilePicker mode, AllowMultiSelect as True. The Show method brings up the dialog, and returns either a 0 if user pressed cancel, or a -1 if user pressed the button for select. The still current FileDialog object has a SelectedItems property that returns a collection of strings, names of filenames in our case. The collection has an index and count properties that we use to iterate through the collection and save the strings into an array. We use the count to dimension the array.

The public dynamic array, now saved with selected files, is loaded into the listbox with a single Listbox.List property.

Sub ChooseFiles()
    Dim FileChosen As Integer
    Dim i As Integer
    
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    'i cant get initialview to do anything
    'it comes up in windows last used mode period
    fd.InitialView = msoFileDialogViewDetails
    
    fd.Filters.Add "DWG file", "*.dwg"
    fd.InitialFileName = str_dir
    fd.Title = "Choose Drawings"
    fd.ButtonName = "Select DWGs"
    fd.AllowMultiSelect = True
    
    FileChosen = fd.Show
    
    If FileChosen = -1 Then
        ReDim ar_x(1 To fd.SelectedItems.Count)
        For i = 1 To fd.SelectedItems.Count
           ar_x(i) = fd.SelectedItems.Item(i)
        Next i
        
        frm_acad_script.lb_file_list.List = ar_x
                
        str_dir = FolderFromPath(fd.SelectedItems(1))
        frm_acad_script.txt_job_folder = str_dir
        With Sheets("Job_List")
            .Range("B1").Value = str_dir
        End With
    Else
     'nothing to do, user pressed cancel
    End If

Set fd = Nothing
End Sub

http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/
https://msdn.microsoft.com/en-us/library/314cz14s(v=vs.84).aspx
https://technet.microsoft.com/en-us/library/ee198742.aspx
https://technet.microsoft.com/en-us/library/ee198716.aspx

The FileSystemObject is used to create, open, write and close a text file.
The file list and the script body are both prepared in public arrays so they can be manipulated with a loop in a loop.
This is where the script file is made.


  Public ar_alpha() As String 'string array of alpha script titles
  
  Public str_alpha As String 'string of currently selected alpha script title
  Public str_title As String 'string of currently selected descriptive script title
  Public ar_script() As String 'string array of currently selected script body
   
  Public FSO As New FileSystemObject

'form button make acad_scr in job folder
Sub make_acad_scr()
    Dim i As Integer, j As Integer
    Dim file_str As String, script_str As String, str As String
    Dim str_scr_filename As String
    Dim fso_txtstream As TextStream

   'read the array not contents of listbox
   'check for file list and array list
   'all public vars should be initialized
    If IsArrayAllocated(ar_x) And IsArray(ar_x) And _
    IsArrayAllocated(ar_script) And str_alpha <> "" And str_dir <> "" Then
        'ok nothing
        Else
        MsgBox "File list empty or script not selected"
        Exit Sub
    End If
     
    str_scr_filename = str_dir & "acad_script.scr" 'name of file to be created
    
    Set fso_txtstream = FSO.CreateTextFile(str_scr_filename, True) 'True to overwrite existing
    fso_txtstream.Close
    Set fso_txtstream = FSO.OpenTextFile(str_scr_filename, ForAppending, False, False)
    'open for writing, do not create if does not exist, open as ascii
               
     'read the file array
       For i = LBound(ar_x) To UBound(ar_x)
            file_str = ar_x(i)
            
            For j = 1 To UBound(ar_script)
                script_str = ar_script(j)
            
                    Select Case script_str
                      Case "<path_filename_ext>"
                             'quotations around string to read names with spaces
                             fso_txtstream.WriteLine Chr(34) & file_str & Chr(34)
                             
                      Case "<path_filename>"
                             str = Left(file_str, InStrRev(file_str, ".") - 1)
                             fso_txtstream.WriteLine Chr(34) & str & Chr(34)
                             
                      Case Else
                             fso_txtstream.WriteLine script_str
                   End Select
            Next j
       Next i
      
    fso_txtstream.Close
End Sub


Sub get_script_body()
    'uses str_alpha public var to fill array ar_script with body text
    Dim lastrow As Long
    Dim rng As Range
    Dim i As Integer

    With Sheets("Script-Template")
          lastrow = .Cells(.Rows.Count, str_alpha).End(xlUp).row
     Set rng = .Range(str_alpha & "2", str_alpha & lastrow)
      'Debug.Print rng.Address
    End With
    
    ReDim ar_script(1 To rng.Rows.Count)
    
    For i = 1 To rng.Rows.Count
     'Debug.Print rng.Cells(i, 1)
       ar_script(i) = rng.Cells(i, 1)
    Next i
End Sub


Sub get_alpha_list()
    'fills array ar_alpha with alpha script titles from spreadsheet
    'called by form initialize
    Dim lastalpha As Long
    Dim str As String
    Dim i As Integer
             
    With Sheets("Script-Template")
        lastalpha = .Range("A1").End(xlToRight).Column
    End With
 
    ReDim ar_alpha(1 To lastalpha)
           
    For i = 1 To lastalpha
        str = Chr(i + 64)
        ar_alpha(i) = str
    Next i
End Sub

a little bit of code in the form


Private Sub cbo_script_select_Change()
    
    'sets str_alpha public var
    str_alpha = frm_acad_script.cbo_script_select.Text
    
    'fills ar_script public array with script body
    Call get_script_body
    With frm_acad_script.LB_Script_list
        .Clear
        .List = ar_script
    End With
    
    'sets public str_title from spreadsheet
    With Sheets("Script-Template")
        str_title = .Range(str_alpha & "1")
    End With
    frm_acad_script.txt_Script_Title = str_title
        
End Sub


Private Sub UserForm_Initialize()

'gets the value from spreadsheet, writes it to public var
'then writes it to form
str_dir = ActiveWorkbook.Worksheets("Job_List").Range("B1").Value
Me.txt_job_folder.Text = str_dir

'fills public array with list of alpha script titles
'fill script select combo.List with array
Call get_alpha_list
cbo_script_select.List = ar_alpha

End Sub

that is everything shown on the form in part 1 except the hardwired run scripts.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s