Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Correct Method to Handle Errors in Cad-to-Excel application

0 REPLIES 0
Reply
Message 1 of 1
bhull1985
585 Views, 0 Replies

Correct Method to Handle Errors in Cad-to-Excel application

 

Hey all, getting pretty close to having a working and completed application for transferring attribute information from autocad into excel.

The program is very modular, about 15 subfunctions working with main defuns that share information via global variables, arguments, and via the blackboard vla method.

I'm having very slight problems with the routine at the moment, and i'm just trying to find out a way to best handle errors.

At first I had found and replicated code similar to the following:

 

 (defun *error* (msg)
    (cond
      ((not msg))
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
      (T (princ (strcat "\n Error: " msg)))
    )
    (if (not (vlax-object-released-p *ExcelApp%))
      (vlax-release-object *ExcelApp%)
    )  
	(and (eq (type *ExcelApp%) 'VLA-OBJECT)
       (vl-catch-all-apply 'vlax-release-object (list *ExcelApp%))
  )
    (princ)
  ) ;end error

(setq *error* MyExit)

 Which appears to be quite handy but was actually creating more problems than it was solving. In case of an error this will shut down the excel application, but honestly I don't want excel to close in case of an error in the program. I want to locate the cause of the error and debug.

I do need the error handler to release the excel application so that the next time the program is ran, it can append or create new file correctly.

There are a myriad of calls to release-object, checks to see if a pointer is established.....it can all be sort of overwhelming.

 

Simply, I need an error handler to display the message if error, to display user Cancelled/Quit if cancelled/quit out, to reset any system variables that have been modified by my routine to their original state (i can take care of this portion), as well as release but not close the Excel Application.

If there's a problem with releasing but not closing please inform, my ignorance tells me that this may be possible.

 

I am having difficulty as well in establishing a good method to determine if excel is open and running at the beginning of one of the subfunctions.

Each time I try a different check, they're simply not closing excel, even though the condition is satisfied.

If anyone knows a reliable method to see if any occurance if excel is running in the background and the method to close it properly so that a call to (openExcel) immediately after works correctly, and would share it with me along with the error handler hints I would be greatly appreciative.

I'll post my routine for completeness...

;-------------------------------------------------------------------------------
; Program Name: GetExcel.lsp [GetExcel R4]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 9-20-03
; Function:     Several functions to get and put values into Excel cells.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   9-20-03   Initial version
; 2    TM   8-20-07   Rewrote GetExcel.lsp and added several new sub-functions
;                     including ColumnRow, Alpha2Number and Number2Alpha written
;                     by Gilles Chanteau from Marseille, France.
; 3    TM   12-1-07   Added several sub-functions written by Gilles Chanteau
;                     including Cell-p, Row+n, and Column+n. Also added his
;                     revision of the PutCell function.
; 4    GC   9-20-08   Revised the GetExcel argument MaxRange$ to accept a nil
;                     and get the current region from cell A1.
;-------------------------------------------------------------------------------
; Overview of Main functions
;-------------------------------------------------------------------------------
; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list
;   Syntax:  (GetExcel ExcelFile$ SheetName$ MaxRange$)
;   Example: (GetExcel "Y:\\Bhull\\Attributes.csv" "Sheet1" "B49")
; GetCell - Returns the cell value from the *ExcelData@ list
;   Syntax:  (GetCell Cell$)
;   Example: (GetCell "H15")
; Function example of usage:
; (defun c:Get-Example ()
;   (GetExcel "C:\\Folder\\Filename.xls" "Sheet1" "L30");<-- Edit Filename.xls
;   (GetCell "H21");Or you can just use the global *ExcelData@ list
; );defun
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
;   Syntax:  (OpenExcel ExcelFile$ SheetName$ Visible)
;   Example: (OpenExcel "C:\\Folder\\Filename.xls" "Sheet1" nil)
; PutCell - Put values into Excel cells
;   Syntax:  (PutCell StartCell$ Data$) or (PutCell StartCell$ DataList@)
;   Example: (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\""))
; CloseExcel - Closes Excel session
;   Syntax:  (CloseExcel ExcelFile$)
;   Example: (CloseExcel "C:\\Folder\\Filename.xls")
; Function example of usage:
; (defun c:Put-Example ()
;   (OpenExcel "C:\\Folder\\Filename.xls" "Sheet1" nil);<-- Edit Filename.xls
;   (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\""));Repeat as required
;   (CloseExcel "C:\\Folder\\Filename.xls");<-- Edit Filename.xls
;   (princ)
; );defun
;-------------------------------------------------------------------------------
; Note: Review the conditions of each argument in the function headings
;-------------------------------------------------------------------------------
; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list
; Arguments: 3
;   ExcelFile$ = Path and filename
;   SheetName$ = Sheet name or nil for not specified
;   MaxRange$ = Maximum cell ID range to include or nil to get the current region from cell A1
; Syntax examples:
; (GetExcel "C:\\Temp\\Temp.xls" "Sheet1" "E19") = Open C:\Temp\Temp.xls on Sheet1 and read up to cell E19
; (GetExcel "C:\\Temp\\Temp.xls" nil "XYZ123") = Open C:\Temp\Temp.xls on current sheet and read up to cell XYZ123
;-------------------------------------------------------------------------------
(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Column# ColumnRow@ Data@ ExcelRange^
  ExcelValue ExcelValue ExcelVariant^ MaxColumn# MaxRow# Range$ Row# Worksheet)
  (if (= (type ExcelFile$) 'STR)
    (if (not (findfile ExcelFile$))
      (progn
        (alert (strcat "Excel file " ExcelFile$ " not found."))
        (exit)
      );progn
    );if
    (progn
      (alert "Excel file not specified.")
      (exit)
    );progn
  );if
  (gc)
  (if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
    (progn
      (alert "Close all Excel spreadsheets to continue!")
      (vlax-release-object *ExcelApp%)(gc)
    );progn
  );if
  (setq ExcelFile$ (findfile ExcelFile$))
  (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
  (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
  (if SheetName$
    (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
      (if (= (vlax-get-property Worksheet "Name") SheetName$)
        (vlax-invoke-method Worksheet "Activate")
      );if
    );vlax-for
  );if
  (if MaxRange$
    (progn
      (setq ColumnRow@ (ColumnRow MaxRange$))
      (setq MaxColumn# (nth 0 ColumnRow@))
      (setq MaxRow# (nth 1 ColumnRow@))
    );progn
    (progn
      (setq CurRegion (vlax-get-property (vlax-get-property
        (vlax-get-property *ExcelApp% "ActiveSheet") "Range" "A1") "CurrentRegion")
      );setq
      (setq MaxRow# (vlax-get-property (vlax-get-property CurRegion "Rows") "Count"))
      (setq MaxColumn# (vlax-get-property (vlax-get-property CurRegion "Columns") "Count"))
    );progn
  );if
  (setq *ExcelData@ nil)
  (setq Row# 1)
  (repeat MaxRow#
    (setq Data@ nil)
    (setq Column# 1)
    (repeat MaxColumn#
      (setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
      (setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
      (setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
      (setq ExcelValue (vlax-variant-value ExcelVariant^))
      (setq ExcelValue
        (cond
          ((= (type ExcelValue) 'INT) (itoa ExcelValue))
          ((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
          ((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
          ((/= (type ExcelValue) 'STR) "")
        );cond
      );setq
      (setq Data@ (append Data@ (list ExcelValue)))
      (setq Column# (1+ Column#))
    );repeat
    (setq *ExcelData@ (append *ExcelData@ (list Data@)))
    (setq Row# (1+ Row#))
  );repeat
  (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
  (vlax-invoke-method *ExcelApp% 'Quit)
  (vlax-release-object *ExcelApp%)(gc)
  (setq *ExcelApp% nil)
  *ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
  (setq ColumnRow@ (ColumnRow Cell$))
  (setq Column# (1- (nth 0 ColumnRow@)))
  (setq Row# (1- (nth 1 ColumnRow@)))
  (setq Return "")
  (if *ExcelData@
    (if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
      (setq Return (nth Column# (nth Row# *ExcelData@)))
    );if
  );if
  Return
);defun GetCell
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
;   ExcelFile$ = Excel filename or nil for new spreadsheet
;   SheetName$ = Sheet name or nil for not specified
;   Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) =  Opens a new spreadsheet and creates a Part List sheet as hidden session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Worksheet)
  (if (= (type ExcelFile$) 'STR)
    (if (findfile ExcelFile$)
      (setq *ExcelFile$ ExcelFile$)
      (progn
        (alert (strcat "Excel file " ExcelFile$ " not found."))
        (exit)
      );progn
    );if
    (setq *ExcelFile$ "")
  );if
  (gc)
  (if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
    (progn
;      (alert "Close all Excel spreadsheets to continue!")
      (vlax-release-object *ExcelApp%)(gc)
    );progn
  );if
  (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
  (if ExcelFile$
    (if (findfile ExcelFile$)
      (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
      (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
    );if
    (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
  );if
  (if Visible
    (vla-put-visible *ExcelApp% :vlax-true)
  );if
  (if (= (type SheetName$) 'STR)
    (progn
      (vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
        (setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
      );vlax-for

      (if (member SheetName$ Sheets@)
        (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
          (if (= (vlax-get-property Worksheet "Name") SheetName$)
            (vlax-invoke-method Worksheet "Activate")
          );if
        );vlax-for
        (vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
      );if
    );progn
  );if
  (princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
;   StartCell$ = Starting Cell ID
;   Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
  (if (= (type Data@) 'STR)
    (setq Data@ (list Data@))
  )
  (setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
  (if (Cell-p StartCell$)
    (setq Column# (car (ColumnRow StartCell$))
          Row# (cadr (ColumnRow StartCell$))
    );setq
    (if (vl-catch-all-error-p
          (setq Cell$ (vl-catch-all-apply 'vlax-get-property
            (list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
          );setq
        );vl-catch-all-error-p
        (alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
        (setq Column# (vlax-get-property Cell$ "Column")
              Row# (vlax-get-property Cell$ "Row")
        );setq
    );if
  );if
  (if (and Column# Row#)
    (foreach Item Data@
      (vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
      (setq Column# (1+ Column#))
    );foreach
  );if
  (princ)
);defun PutCell
;-------------------------------------------------------------------------------

; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
;   ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
  (if ExcelFile$
    (if (= (strcase ExcelFile$) (strcase *ExcelFile$))
      (if (findfile ExcelFile$)
        (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
        (setq Saveas t)
      );if
      (if (findfile ExcelFile$)
        (progn
          (vl-file-delete (findfile ExcelFile$))
          (setq Saveas t)
        );progn
        (setq Saveas t)
      );if
    );if
  );if
  (if Saveas
    (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
      "SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
    );vlax-invoke-method
  );if
  (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
  (vlax-invoke-method *ExcelApp% 'Quit)
  (vlax-release-object *ExcelApp%)(gc)
  (setq *ExcelApp% nil *ExcelFile$ nil)
  (princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    );setq
  );while
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1);default to "A1" if there's a problem
  );if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    );+
  );if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    );if
  );if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
  (and (= (type Cell$) 'STR)
    (or (= (strcase Cell$) "A1")
      (not (equal (ColumnRow Cell$) '(1 1)))
    );or
  );and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
;   Cell$ = Starting cell ID
;   Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
  (setq Cell$ (ColumnRow Cell$))
  (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
;   Cell$ = Starting cell ID
;   Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
  (setq Cell$ (ColumnRow Cell$))
  (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
;   RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
  (setq DimZin# (getvar "DIMZIN"))
  (setvar "DIMZIN" 8)
  (setq ShortReal$ (rtos RealNum~ 2 8))
  (setvar "DIMZIN" DimZin#)
  ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp

;;--------------------------------
(defun List2String  (Alist)
  (setq NumStr (length Alist))
  (foreach Item  AList
    (if (= Item (car AList))
      ;;first item
      (setq LongString (car AList))
      (setq LongString (strcat LongString ";" Item))
      )
    )
  LongString
  ) ;defun
;;--------------------------------
(defun Dxf  (code pairs)
  (cdr (assoc code pairs))
  )
;;--------------------------------


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;RUNNING PROCESSES SUBFUNCTION;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun runningprocesses ( / qry rtn srv wmi )
    (if (setq wmi (vlax-create-object "wbemscripting.swbemlocator"))
        (progn
            (setq rtn
                (vl-catch-all-apply
                   '(lambda ( / lst )
                        (setq srv (vlax-invoke wmi 'connectserver)
                              qry (vlax-invoke srv 'execquery "Select * from Win32_Process")
                        )
                        (vlax-for itm qry
                            (vlax-for prp (vlax-get itm 'properties_)
                                (if (= "name" (strcase (vlax-get prp 'name) t))
                                    (setq lst (cons (vlax-get prp 'value) lst))
                                )
                            )
                        )
                        lst
                    )
                )
            )
            (foreach obj (list qry srv wmi)
                (if (= 'vla-object (type obj))
                    (vlax-release-object obj)
                )
            )
            (if (vl-catch-all-error-p rtn)
                (prompt (vl-catch-all-error-message rtn))
                rtn
            )
        )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;DUPLICATE TAG CELL COLOR SUBFUNCTION;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(DEFUN PutColor	(RNG COL)
  (VLAX-PUT-PROPERTY
    (VLAX-GET-PROPERTY
      (VLAX-GET-PROPERTY (VLAX-GET-OR-CREATE-OBJECT "Excel.Application") "Range" RNG)
      "Interior"
    )
    "Colorindex"
    (VLAX-MAKE-VARIANT COL)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;list duplicates subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; List Duplicates  -  Lee Mac
;; Returns a list of items appearing more than once in a supplied list

(defun LM:ListDupes ( l )
    (if l
        (if (member (car l) (cdr l))
            (cons (car l) (LM:ListDupes (vl-remove (car l) (cdr l))))
            (LM:ListDupes (vl-remove (car l) (cdr l)))
        )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;string increment subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;Credits Marc Antonio Alexsi;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun String_ (In_Str / OutStr AddFlg DecFlg TmpLst)
(setq OutStr
(vl-list->string
(foreach ForElm (reverse (vl-string->list In_Str))
(if AddFlg
(setq TmpLst (cons ForElm TmpLst))
(cond
( (= 57 ForElm) ;(chr 57)=> "9"
(setq DecFlg T TmpLst (cons 48 TmpLst))
)
( (> 57 ForElm 47) ;"8"->-"0" (chr 47)=> "/"
(setq AddFlg T TmpLst (cons (1+ ForElm) TmpLst))
)
( (if DecFlg ; (chr 49)=> "1"
(setq AddFlg T TmpLst (cons ForElm (cons 49 TmpLst)))
(setq TmpLst (cons ForElm TmpLst))
)
)
)
)
)
)
)
(if AddFlg OutStr (strcat "1" OutStr))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;PUTEXCELLS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun putexcells ( vallist / c data adata bdata fdata ldata cell)


(if
(not
(member "acetutil.arx" (arx)))
(princ "\nExpress tools must be loaded.")
);if

;;main subfunction that will process the selection set gathered by C:Putex
;;this subfunction will place tag strings into excel columns and rows
;;then will number all of the items in excel in column "A", listing only
;;a number that increments for each tag in the list.
;;the program will then put the drawing number beside the tag values within excel

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "B";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-tag# subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;putex-->tag#-->name;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq cell (strcat "B" @excel_row))
;;starting cell value to leave one line from the top for a column header
;;subfunction (string_ cell) will increment to "A2" and then
;;"A3", incrementing each pass of the repeat loop until the end of the list.

(acet-ui-progress-init "Writing TAGS to Excel." (length vallist))
(setq c 0)
(setq len (length vallist))
(repeat len
(setq data (nth c vallist))
(setq adata (cadr data))
(setq bdata (car data))
(if (not fdata)
(setq fdata (strcat adata "-" bdata)))
(setq cell (string_ cell))
(putcell cell fdata)

(setq ldata (list bdata adata))
(setq @dupeslist (vl-bb-ref 'dupeslist))
(if
(member ldata @dupeslist)
(putcolor cell 15)
);if
(setq fdata nil)
(acet-ui-progress-safe c)
(setq c (1+ c))
);repeat
(acet-ui-progress-done)

(if 
(= c len)(doname vallist)
);if
;;passes number of items entered to next subroutine to enter
;;information into the next column of excel. This time it's
;;the dwg-name, which should be the same per dwg.
);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "E";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-name subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tag#-->name-->item;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doname ( vallist / c cell namedata)
(acet-ui-progress-init "Writing drawing NAMES to Excel." (length vallist))
(setq c 0)
(setq len (length vallist))
(setq cell (strcat "E" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq namedata (getname))
(putcell cell namedata)
(setq cell (string_ cell))
(acet-ui-progress-safe c)
(setq c (1+ c))
);repeat
(acet-ui-progress-done)
(if (= c len)(doitem vallist))
;;goto item subfunction
);defun doname

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "A";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-item subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;name-->item-->type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun doitem ( vallist / itemcell itemdata c)
(acet-ui-progress-init "Writing row COUNT to Excel." (length vallist))
(setq c 0)
(setq len (length vallist))
(setq itemcell (strcat "A" @excel_row))
(setq itemcell (string_ itemcell))
(cond
((= appendfile T)(setq itemdata (vl-bb-ref 'lastitem)))
((and (= newfile T)(= @excel_row "8"))(setq itemdata "0"))
);cond
(repeat len
(setq itemdata (string_ itemdata))
(putcell itemcell itemdata)
(setq itemcell (string_ itemcell))
(acet-ui-progress-safe c)
(setq c (1+ c))
(vl-bb-set 'lastitem itemdata)
);repeat
(acet-ui-progress-done)
(if (= c len)(dotype vallist))
;;goto type subfunction
);defun doitem

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "C";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-type subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;item-->type-->tag;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dotype ( vallist / cell c data adata)
(acet-ui-progress-init "Writing Instrument TYPE information to Excel." (length vallist))
(setq c 0)
(setq len (length vallist))
(setq cell (strcat "C" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq data (nth c vallist))
(setq adata (cadr data))
(putcell cell adata)
(setq cell (string_ cell))
(acet-ui-progress-safe c)
(setq c (1+ c))
);repeat
(acet-ui-progress-done)
(if (= c len)(dotag vallist))
;;goto tag subfunction
);defun dotype

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;COL "D";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-tag subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;type-->tag-->end;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dotag ( vallist / c d cell data adata aitem bitem lst count)
(acet-ui-progress-init "Writing TAG VALUES to Excel." (length vallist))
(setq c 0)
(setq len (length vallist))
(setq cell (strcat "D" @excel_row))
(setq cell (string_ cell))
(repeat len
(setq data (nth c vallist))
(setq adata (car data))
(putcell cell adata)
(setq cell (string_ cell))
(acet-ui-progress-safe c)
(setq c (1+ c))
);repeat
(acet-ui-progress-done)


(setq @dupeslist (vl-bb-ref 'dupeslist))
(setq count (length @dupeslist))
(setq d 0)
(repeat count
(setq aitem (nth d @dupeslist))
(setq bitem (reverse aitem))
(setq lst (cons bitem lst))
(setq d (1+ d))
);repeat

(princ (strcat "\n..........." (itoa (length @dupeslist)) " unique items duplicated in excel file>>>"))
(princ "\n...........")
(princ lst)
(princ "\n...........These items have had their cells colored Grey>>>")
(princ "\n...........Finished!>>>")
(if vallist (setq svflg 1))
(setq vallist nil)
(vl-bb-set 'dupeslist nil)
(setq @dupeslist nil)
(setq @excel_row "8")
(setq *excelApp% nil)
(princ "\n")
;;end of excel input, routine will alert to user that it is complete
(princ)
(gc)
);defun dotype

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;getname subfunction for col "E";;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun getname (/ dwgname tempname1)
;;subfunction that returns simply the last 5 characters of a dwg name before the ".dwg"
;;ex output on "213035-PIPE-PID-00000500-00.DWG" returns "00500"
;;bhull 2/27/14
(setq dwgname (getvar "dwgname"))
(setq tempname1 (substr dwgname (+ -7 (vl-string-search ".dwg" dwgname))))
(setq dwgname1 (substr tempname1 1 (- (strlen tempname1) 7)))
;(princ dwgname1)
;(princ)

);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;put-excel main function;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:putex (/ TAGROW VALROW EDATA E I SS TAGLIST TEMPLIST REVLIST vallist *error*)
(vl-load-com)
;;custom routine to search drawing for listed tags in listed blocks
;;and write the values to an instrument index in excel as a .csv



 (defun *error* (msg)
    (cond
      ((not msg))
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
      (T (princ (strcat "\n Error: " msg)))
    )
    (if (not (vlax-object-released-p *ExcelApp%))
      (vlax-release-object *ExcelApp%)
    )  
	(and (eq (type *ExcelApp%) 'VLA-OBJECT)
       (vl-catch-all-apply 'vlax-release-object (list *ExcelApp%))
  )
    (princ)
  ) ;end error

(setq *error* MyExit)




(openexcel @excel_file "INDEX" T)
;(openexcel "Y:\\Bhull\\213035-INST-IND-00000001-00.xls" "INDEX" T)
;;one and final call to (openexcel) that opens "attributes.csv" for
;;programatically editing with this routine

(if @dupeslist
  (setq @dupeslist nil)
)

(setq TagList '("TAG00" "TAG10"))
(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 "CE001,CE007,CE013,CE023,CE021"))))
(setq i -1)
(repeat (sslength ss)
 (setq TagRow nil
       ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
      (if
        (and
          (= (Dxf 0 Edata) "ATTRIB")
          (member (dxf 2 Edata) TagList)
          ;;if tag is on list
           ) ;and
         (progn
           (setq TagRow (cons (Dxf 2 Edata) TagRow))
           (setq valRow (cons (Dxf 1 Edata) ValRow))
           ) ;progn
	)
      (setq Edata (entget (setq e (entnext e))))
      ) ;while
	(setq vallist (cons valrow vallist))
) ;repeat 

(foreach sublist vallist
  (setq templist (list (vl-string-trim " " (car sublist)) (vl-string-trim " " (cadr sublist))))
    (if (not (equal templist '("" ""))); had other than space(s)-only content
      (setq revlist (cons templist revlist))
    ); if
); foreach

  (setq vallist (reverse revlist))
  (setq revlist nil)
;;code is to remove empty strings and spaces from the items within vallist

(vl-bb-set 'dupeslist (reverse (lm:listdupes vallist)))
;;creates list of duplicate items in order to flag and color excel cells 
;;for duplicate items, and writes them to the blackboard using 'dupeslist
(princ)


(if vallist
(putexcells vallist)
;;command to execute next part of routine, putexcells, to put all items
;;in vallist into excel spreadsheet as .csv file
);if

(setq newfile nil)
(setq *error* nil)
(princ)
);defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;browse-for-folder function;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun folderdia ()
;; Browse for Folder  -  Lee Mac
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; bit - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.

(defun LM:browseforfolder ( msg dir bit / err fld shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              @pth (vlax-get-property slf 'path)
                              @pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" @pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        @pth
    )
(setq @excel_file @pth)
(princ @pth)
(princ)
)
(LM:browseforfolder "Select Excel File:" "Z:,Y:" 16384)
(princ)
);defun



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;run-put-excel;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;dcl driven version of routine to allow for appended excel index instead of new;;
;;same exact routine as putex, except this does not open the excel file;;;;;;;;;;;
;;it operates off of an opened excel file, for appending index;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun createvallist ( ss / taglist tagrow valrow edata e i)
(setq i -1)
(setq TagList '("TAG00" "TAG10"))
(repeat (sslength ss)
 (setq TagRow nil
       ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
      (if
        (and
          (= (Dxf 0 Edata) "ATTRIB")
          (member (dxf 2 Edata) TagList)
          ;;if tag is on list
           ) ;and
         (progn
           (setq TagRow (cons (Dxf 2 Edata) TagRow))
           (setq valRow (cons (Dxf 1 Edata) ValRow))
           ) ;progn
	)
      (setq Edata (entget (setq e (entnext e))))
      ) ;while
	(setq vallist (cons valrow vallist))
) ;repeat 
);defun 


(defun runputexcel (/ oldecho TAGROW VALROW EDATA E I SS TAGLIST TEMPLIST REVLIST vallist)

(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if @dupeslist
(setq @dupeslist nil)
);if
(if vallist
(setq vallist nil)
);if


(setq TagList '("TAG00" "TAG10"))
(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 "CE001,CE007,CE013,CE023,CE021"))))
(setq i -1)



(if
(and
ss
(setq *ExcelApp% (vlax-get-object "Excel.Application")))
(createvallist ss)
(progn
(princ "\n...Excel must be running to append.")
(princ)
);progn
);if



(if vallist (progn
(foreach sublist vallist
  (setq templist (list (vl-string-trim " " (car sublist)) (vl-string-trim " " (cadr sublist))))
  (if (not (equal templist '("" ""))); had other than space(s)-only content
    (setq revlist (cons templist revlist))
  ); if
); foreach
(setq vallist (reverse revlist))
(setq revlist nil)
);progn
);if
;;code is to remove empty strings and spaces from the items within vallist

(if vallist (progn
(vl-bb-set 'dupeslist (reverse (lm:listdupes vallist)))
(putexcells vallist)))
;;creates list of duplicate items in order to flag and color excel cells 
;;for duplicate items, and writes them to the blackboard using 'dupeslist
(princ)

;;command to execute next part of routine, putexcells, to put all items
;;in vallist into excel spreadsheet as .csv file


(setvar "cmdecho" oldecho)
(princ)
);defun
(princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;pick blocks subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun createcustomvallist ( ss / tagrow valrow edata e i)

(setq i -1)
(repeat (sslength ss)
 (setq TagRow nil
       ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
      (if
        (and
          (= (Dxf 0 Edata) "ATTRIB")
          (member (dxf 2 Edata) TagList)
          ;;if tag is on list
           ) ;and
         (progn
           (setq TagRow (cons (Dxf 2 Edata) TagRow))
           (setq valRow (cons (Dxf 1 Edata) ValRow))
           ) ;progn
	)
      (setq Edata (entget (setq e (entnext e))))
      ) ;while
	(setq vallist (cons valrow vallist))
) ;repeat 
);defun


(defun getexcelblocks (/ TAGROW VALROW EDATA E I SS TAGLIST TEMPLIST REVLIST vallist)


(if @dupeslist
  (setq @dupeslist nil)
);if
(if vallist
  (setq vallist nil)
);if


(setq TagList '("TAG00" "TAG10"))
(princ "\nSelect Instruments:")
	(setq ss (ssget '((0 . "INSERT"))))


(if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(createcustomvallist ss)
(princ "\nMust have Instrument Index Excel file open to continue.")
);if



(foreach sublist vallist
  (setq templist (list (vl-string-trim " " (car sublist)) (vl-string-trim " " (cadr sublist))))
    (if (not (equal templist '("" ""))); had other than space(s)-only content
      (setq revlist (cons templist revlist))
    ); if
); foreach

(setq vallist (reverse revlist))
(setq revlist nil)
;;code is to remove empty strings and spaces from the items within vallist


(vl-bb-set 'dupeslist (reverse (lm:listdupes vallist)))
;;creates list of duplicate items in order to flag and color excel cells 
;;for duplicate items, and writes them to the blackboard using 'dupeslist
(princ)


(if vallist
(putexcells vallist)
;;command to execute next part of routine, putexcells, to put all items
;;in vallist into excel spreadsheet as .csv file
);if

(princ)
);defun






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;DCL coding;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


 (defun c:MyToggles (/ Dcl_Id% *start_excel@ *MyRadios@ Radio1$ Radio2$ Radio3$ Radio4$ Return# ptx pty *error*)
   (princ "\nGetExcel...")(princ)

  (vl-load-com)
  (defun *error* (msg)
    (cond
      ((not msg))
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
      (T (princ (strcat "\n Error: " msg)))
    )
    (if (not (vlax-object-released-p *ExcelApp%))
      (vlax-release-object *ExcelApp%)
    )  
	(and (eq (type *ExcelApp%) 'VLA-OBJECT)
       (vl-catch-all-apply 'vlax-release-object (list *ExcelApp%))
  )
    (princ)
  ) ;end error


   
   
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Set Default Variables
(if (not *MyRadios@)						;Unique global variable name to store dialog info
    (setq *MyRadios@ (list nil "1" "0" "1" )))			;if				
(if (not @excel_row)						;start excel row
    (setq @excel_row "8"))					;if	
(if (not @excel_file)						;start excel file name
    (setq @excel_file 						

"Y:\\bhull\\_LispBox\\_In_Works\\213035-INST-IND-00000001-00.xls"

							       ));if
								   
(if (and (null Appendfile)
		 (null Newfile))
		 (setq newfile T))
(if (equal appendfile T)
(setq appendfile nil)
);if
(setq Radio1$ (nth 1 *MyRadios@)
      Radio2$ (nth 2 *MyRadios@)
      Radio3$ (nth 3 *MyRadios@)
	 ptx "8"						
	 )
	 
	 

	 

	 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Done Set Default Variables
	



   (if (not (setq Dcl_Id% (load_dialog "GetExcel.dcl")))
       (progn
	   (princ "\nDCL file not loaded. Notify Brandon Hull.")
	   (exit)
	   );progn
	     (progn
	(if (not (new_dialog "GetExcel" Dcl_Id%))
	     (progn
	     (princ "\nThe DCL file failed to load, please notify Brandon Hull")
	     (exit)
	     );progn
	 )));dialog default setup
	 
	 

    ; Set Dialog Initial Settings
   (set_tile "Title" "GetExcel - AutoCAD to Excel for Instrument Index")
   (set_tile "Dir" @excel_file)
   (set_tile "eb1" @excel_row)
   (set_tile "dir" @excel_file)
   (mode_tile "eb1" 2)
   (mode_tile "eb1" 3)
   (set_tile "Rad101" "1")
   (set_tile "Rad102" "0")
   (set_tile "Rad103" "1")
   (if (= (get_tile "Rad100") "Rad101")(mode_tile "But102" 1) );if


    ; Dialog Actions
   (action_tile "Rad101" "(mode_tile \"But102\" 1)") 
   (action_tile "eb1" "(setq ptx (atoi $value))")
   (action_tile "dir" "(setq @excel_file (atoi $value))")
   (action_tile "accept" 
	(strcat
	"(progn
	"(setq @Excel_ROW (get_tile \"eb1\"))"
	" (done_dialog 1))"
	);strcat
	);action tile
   (action_tile "cancel" "(done_dialog 0)(setq result nil)")
   (action_tile "But102" "(done_dialog 4)")
   (action_tile "Browse" "(folderdia)(done_dialog 5)")
   (action_tile "Rad102" "(mode_tile \"Rad103\" 0)(setq appendfile T)(setq newfile nil)") 
   (action_tile "Rad103" "(mode_tile \"Rad102\" 0)(setq newfile T)(setq appendfile nil)")
   (setq Return# (start_dialog))



    ; Unload Dialog
   (unload_dialog Dcl_Id%)
   (setq *MyRadios@ (list nil Radio1$ Radio2$ Radio3$))
   (setq *start_excel@ (list nil ptx))
   (if @excel_file
   (vl-bb-set 'excel_file @excel_file)
   (vl-bb-set 'excel_file nil)
   );if

(cond
((= return# 0)(exit))
((= return# 1)(checktype))
((= return# 4)(getexcelblocks))
((= return# 5)(C:putex))
);cond


   (princ)
   
  (setq *error* nil)
 );defun c:MyToggles 
(princ)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;checktype subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun checktype ()
	(cond
	 ((= appendfile t)(runputexcel))		;cond1
	 ((= newfile t)(C:putex))				;cond2
	);cond
		
);defun




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;end of file;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(princ)

 

 

 

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Please use code tags and credit where credit is due. Accept as solution, if solved. Let's keep it trim people!
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost