Jump to content

Offer advise on this application please, comments and criticism welcome


Bhull1985

Recommended Posts

Hey all, I'm getting really close to taking this program up the way and allowing the I&E guys to use it, as intended. They are not programmers, so I'm adding all of the error checking and user input checking that I can think of, in order to prevent the program from crapping out. It's pretty verbose, in some areas, and I've spent a lot of time trying to find problem areas and fix them. I feel that I've done an alright job.

If there was one thing I could say about it, I don't feel great about all of the repeated code but there are subfunctions that are modular, I'm not quite as experienced as to be able to manipulate my one function for each of the needs, you will see these down in the DCL coding the (cond) statement that directs the program to use which subfunction. Currently they are all the same with slight modifications depending on the users needs but I feel as though there would be a way to code this once, but still allowing the stipulations that are accomplished in created separate subfunctions.

 

So please, break this sucker, let me know what I need to work on, let me know what needs to be completely reworked, what's fine....I need all the comments I can get on this one please, trying to take my coding one step further than brute force and quick and dirty. I know I'm posting this in the right place. Thanks in advance, and let me preface the posting of the app by saying that it was originally terry millers GetExcel, so that's what you will see at the top of the app.

Snippets by Lee Mac, Marc Anotonio Alexsi as well as my own code are all below Terry's GetExcel functions and subfunctions....I have modified and adapted this code greatly, please let me know what you think I should do to further it's progression to a complete program.

 


(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



(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




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



(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



(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



(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


(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



(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

(defun Cell-p (Cell$)
 (and (= (type Cell$) 'STR)
   (or (= (strcase Cell$) "A1")
     (not (equal (ColumnRow Cell$) '(1 1)))
   );or
 );and
);defun Cell-p

(defun Row+n (Cell$ Num#)
 (setq Cell$ (ColumnRow Cell$))
 (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n

(defun Column+n (Cell$ Num#)
 (setq Cell$ (ColumnRow Cell$))
 (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n

(defun rtosr (RealNum~ / DimZin# ShortReal$)
 (setq DimZin# (getvar "DIMZIN"))
 (setvar "DIMZIN" 
 (setq ShortReal$ (rtos RealNum~ 2 )
 (setvar "DIMZIN" DimZin#)
 ShortReal$
);defun rtosr

(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))
 )
;;--------------------------------




(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  -  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 *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  
(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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
(setq cell (strcat "B" (itoa (vl-bb-ref 'excelrow))))
;;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))
);if
(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.
(setq *error* nil)
);defun

Link to comment
Share on other sites

  • Replies 21
  • Created
  • Last Reply

Top Posters In This Topic

  • Bhull1985

    14

  • ReMark

    3

  • troggarf

    2

  • tzframpton

    1

Top Posters In This Topic

;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-name subfunction;;;;;;;;;;;;;;;;
(defun doname ( vallist / c cell namedata *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  
(if
(setq cell (strcat "E" (itoa (vl-bb-ref 'excelrow))))
(acet-ui-progress-init "Writing drawing NAMES to Excel." (length vallist))
);if
(setq c 0)
(setq len (length vallist))
(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
(setq *error* nil)
);defun doname

;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-item subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doitem ( vallist / itemcell itemdata c *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  
(if
(setq itemcell (strcat "A" (itoa (vl-bb-ref 'excelrow))))
(acet-ui-progress-init "Writing row COUNT to Excel." (length vallist))
);if
(setq c 0)
(setq len (length vallist))
(setq itemcell (string_ itemcell))
(cond
((= @appendfile T)(setq itemdata (getenv "lastitem")))
((and (= @newfile T)(= @excel_row "8"))(progn (setenv "lastitem" "0")(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))
(setenv "lastitem" itemdata)
);repeat
(acet-ui-progress-done)
(if (= c len)(dotype vallist))
;;goto type subfunction
(setq *error* nil)
);defun doitem

;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-type subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dotype ( vallist / cell c data adata *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  

(if
(setq cell (strcat "C" (itoa (vl-bb-ref 'excelrow))))
(acet-ui-progress-init "Writing Instrument TYPE information to Excel." (length vallist))
);if
(setq c 0)
(setq len (length vallist))
(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
(setq *error* nil)
);defun dotype

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;do-tag subfunction;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dotag ( vallist / c d cell data adata aitem bitem lst count *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  
(if
(setq cell (strcat "D" (itoa (vl-bb-ref 'excelrow))))
(acet-ui-progress-init "Writing TAG VALUES to Excel." (length vallist))
);if
(setq c 0)
(setq len (length vallist))
(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
(setvar "cmdecho" 0)
(princ "\n\t\t*************************************************************")(princ)
(princ "\n\t\t***\tAutoExcel Report \t*******************************")(princ)
(princ (strcat "\n\t\t***\t" (itoa (length @dupeslist)) " unique items duplicated in excel file \t\t***"))(princ)
(princ "\n\t\t***\t")
(princ lst)
(princ "\n\t\t***\tThese items have had their cells colored Grey\t***")(princ)
(princ "\n\t\t***\tFinished!\t\t\t\t\t*****************************")(princ)
(princ "\n\t\t*************************************************************")(princ)
(if vallist (setq svflg 1))
;(if svflg (quicksave svflg))
;;un-comment out this line when program is finished. commented out to avoid prompt during testing and development.
(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)
(setq *error* nil)
(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)))
);defun

(defun quicksave ( svflg /)
;;adapted from (closeExcel) function at the top of this file
;;made as subfunction to be able to call throughout application.
;;only instance at the moment is at finish.
;;4/1/14 COMMENTS BY BRANDON HULL- QUICKSAVE WILL NEED TO BE REWORKED WHEN A DIRECTORY TO
;;STORE THE INDEXES IS ESTABLISHED. VL-FILE-RENAME REQUIRES THE FILE TO BE CLOSED TO BE SUCCESFUL 
;;SO IN ORDER TO SAVE THE EXCEL SHEET PROGRAMATICALLY IT WILL NEED TO BE CLOSED BEFOREHAND.
;;PERHAPS ANOTHER TOGGLE IN THE DCL TO "SAVE AND CLOSE" AFTER RUNNING OR "KEEP OPEN" AFTER RUNNING
;;MAY BE THE BEST WAY TO HANDLE THIS.

;(if (findfile @excel_file)
;(vl-file-rename @excel_file (strcat "autoexcel-"(vl-filename-base @excel_file))))
 (if svflg
   (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
     "SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
   );vlax-invoke-method
 );if
 (princ "\nExcel File Saved.")
 (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
 ;;initial / default settings
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (not (null @dupeslist))
(setq @dupeslist nil))
(if (not (null vallist))
(setq vallist nil))


;(if (and (equal @newfile T)(not (vlax-object-released-p *ExcelApp%)))
;(progn
;(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
;(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
;      (vlax-invoke-method *ExcelApp% 'Quit)
;      (vlax-release-object *ExcelApp%)(gc)));progn if



(if (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(openexcel @excel_file "INDEX" T)(princ "\n\t*** Could not establish pointer to Excel. Contact Brandon Hull.\t***"));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 *ExcelApp%)(createvallist ss));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)));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)))

(princ)
(setvar "cmdecho" oldecho)(setq @newfile nil)(princ)
);defun


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

(defun folderdia ()
;; Browse for Folder  -  Lee Mac

(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


;;;;;;;;;;;;;;;;;;;;;;;;create vallist function;;;;;;;;;;


(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 *error*)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  


 ;;initial / default settings
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (not (null @dupeslist))
(setq @dupeslist nil))
(if (not (null vallist))
(setq vallist nil))

(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\t\t***\tExcel must be running to use APPEND option. \t***")(princ)
));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)));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)
(setvar "cmdecho" oldecho)(setq @newfile nil)
(princ)
);defun
(princ)

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

(defun getexcelblocks (/ TAGROW VALROW EDATA E I SS TAGLIST TEMPLIST REVLIST vallist *error* oldecho)
(defun *error* (msg)
   (cond
     ((not msg))
     ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
     (T (princ (strcat "\n Error: " msg)))
   )
(acet-ui-progress-done)
(if (eq (vlax-object-released-p *ExcelApp%) nil)
    (progn
 (vlax-release-object *ExcelApp%)(setq *excelapp% nil)(gc));progn
    );if  
   (princ)
 );end error  

 ;;initial / default settings
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (not (null @dupeslist))
(setq @dupeslist nil))
(if (not (null vallist))
(setq vallist nil))

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

(cond
((and (= nil @appendfile)(= T @newfile))(openexcel @excel_file "INDEX" T))
((and (= T @appendfile)(= nil @newfile))(setq *ExcelApp% (vlax-get-object "Excel.Application")))
);cond

(if (and *ExcelApp% ss) 
(createvallist ss)
(princ "\n\t\t***\tMust have Instrument Index Excel file open to continue.")
);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)));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)
(setq *error* nil)(setvar "cmdecho" oldecho)
(if (= @newfile T)(setq @appendfile nil))
(if (= @appendfile T)(setq @newfile nil))
(princ)
);defun

Link to comment
Share on other sites


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


(defun c:AutoExcel (/ Dcl_Id% *start_excel@ *MyRadios@ Radio1$ Radio2$ Radio3$ Radio4$ Return# ptx $VALUE)
  (princ "\nAutoExcel...")(princ)
  (vl-load-com)  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Set Default Variables
(if (not @excel_row)         ;start excel row
   (setq @excel_row "8"))        ;if 
(if (not ptx)          ;start excel row
   (setq ptx "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 @newfile nil));if

(if *ExcelApp%
(setq @appendfile T
@newfile nil));if


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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" "AutoExcel - AutoCAD to Excel for Instrument Index")
  (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")
  (if (set_tile "Rad103" "1")(setq @newfile T));if
  (if (= (get_tile "Rad100") "Rad101")(mode_tile "But102" 1) );if

   ; Dialog Actions
  (action_tile "Rad101" "(mode_tile \"But102\" 1)") 
  (action_tile "eb1" "(setq ptx (vl-bb-set 'excelrow (atoi $value)))")
  (action_tile "dir" "(setq @excel_file (atoi $value))")
  (action_tile "accept" 
(strcat
"(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%)
  (vl-bb-set 'excelrow 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)

);defun c:MyToggles 
(princ)



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

);defun




(princ "\n\t\t***\ttype \"AutoExcel\" to run program. \t***")
(princ)

Link to comment
Share on other sites

And the DCL code

//---------------------------------------------------------------------------------------------------------
// Autoexcel
//---------------------------------------------------------------------------------------------------------
 GetExcel : dialog {
  key = "Title";
  label = "";//Title$ from lsp file
  spacer;
  
//    : boxed_row { label = "Parameters"; width = 30; height = 4; fixed_width = false; 
   : row { label = "Block Selection" ; fixed_width = false; alignment = left; width = 50 ;
: row { alignment = top; height = 1; spacer;}
 : edit_box { key = "eb1"; alignment = left ; label = "&Starting Row:     "; width = 4; fixed_width = true; } 
: radio_button { key = "Rad101"; label = "*ALL* Blocks"; alignment = middle; }
: button { label = "Pick Blocks>>"; key = "But102"; width = 12; fixed_width = true; alignment = right ; mnemonic = "P"; }
: spacer { width= 5.0; height = 2.0;}
}


//   :spacer {height=1.0;}
   : boxed_row { width = 50; fixed_width = true; label = " ";
: row { label = "Excel File Location" ; fixed_width = true; width = 60; 
: spacer { width= 5.0; height = 1.0;}
: edit_box { key = "Dir" ; edit_width = 55 ; fixed_width = true; edit_limit = 256 ; alignment = left ; } 
 : spacer { width= 2.0; height = 1.0;}
: button { key = "Browse" ; label = "Browse>>" ; mnemonic = "B" ; width = 15 ; alignment = middle ; } 
 : spacer { width= 2.0; height = 1.0;}
      } 
: column { label = "File Status" ; width = 12;
: radio_button { key = "Rad102"; label = "Append (Following)"; }
   : radio_button { key = "Rad103"; label = "New (Leading)"; }
}
}
  spacer;
  ok_cancel;
}//Autoexcel

 

 

Very long routine, over 60000 characters. Had to split it up *shakes fist*

Link to comment
Share on other sites

Brandon,

I will look into testing it in a little while. From my initial launch everything seemed to work. But can you load a sample excel file to test?

~Greg

Link to comment
Share on other sites

Absolutely.

And thanks....however, upload manager doesn't seem to work for me.

I can email if you'll pm your addr.

Link to comment
Share on other sites

What exactly is the purpose of the program for those of us to lazy to read all the code? Lazy = me.:lol:

 

It's a custom data extraction program with additional functionality.

AutoCAD to Excel

Link to comment
Share on other sites

We do get many requests for extracting data from a drawing to an Excel spreadsheet so I would venture to guess your program could become quite popular. Hope all goes well.

Link to comment
Share on other sites

(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
 ;;initial / default settings
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (not (null @dupeslist))
(setq @dupeslist nil))
(if (not (null vallist))
(setq vallist nil))


;(if (and (equal @newfile T)(not (vlax-object-released-p *ExcelApp%)))
;(progn
;(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
;(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
;      (vlax-invoke-method *ExcelApp% 'Quit)
;      (vlax-release-object *ExcelApp%)(gc)));progn if



(if (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(openexcel @excel_file "INDEX" T)(princ "\n\t*** Could not establish pointer to Excel. Contact Brandon Hull.\t***"));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 *ExcelApp%)(createvallist ss));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)));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)))

(princ)
(setvar "cmdecho" oldecho)(setq @newfile nil)(princ)
);defun

 

So the taglist and the ssget filter are the two areas that would be modified in order to change to any blocks/tags. These changes would need to be replicated within the similar subfunctions. A "find" on "taglist" works well for this.

The commented out code near the top of the routine was for this, which I was unsuccessful in coding correctly thus far..

I wanted to account for users messing up, i.e. choosing "Append File" option without an excel file open. Program alerts to open excel file first.

I also wanted to account for the opposite, user choosing "New File" while an excel file was open already.

I'm on the fence about this because it's very feasible that the users would want to set up the header properly and then run the program, which I could check for in the code via checking the open excel document name vs @excel_file variable, i.e. the one that they've chosen to be the instrument index. If the open file is the chosen file, then new file should work when excel is open. If the open excel file does NOT equal @excel_file, then I want the program to very simply close that document before opening @excel_file document.

If I knew how to code this correctly that is what would be in place atm, but I do not.

 

Just wanted to explain some.

 

Another known issue:

Dcl is not in a while loop which I heard could cause some issues. I've used it before like the way it's set up so I'm familiar with that, but I've heard it's not the best way to code it.

Link to comment
Share on other sites

Anyone care to take a crack at this?

A good way to accomplish what was stated in the previous post in this thread?

Thank you

Link to comment
Share on other sites

I am able to pick one or more blocks, but the "data" isn't indicated on the Excel file which is blank when opened. If you could provide a sample spreadsheet, it would perhaps indicate what me and others are doing right or wrong. Rename the .xls file to .txt and upload it. We can rename it to xls after download.

HTH

Steve

Link to comment
Share on other sites

Yeah, even after renaming it to .jpg and .txt it's still not uploading....

I can email the xls though, if you'd pm me your addr.

Link to comment
Share on other sites

Brandon,

I checked it with the test dwg's and excel file that you sent and everything is working fine as long as the specific blocks & Atts are in the drawing.

 

Should there be a warning or alert if a user tries to run AutoExcel on a drawing that doesn't have the needed blocks/Atts?

 

~Greg

Link to comment
Share on other sites

Yes! There should be, and I am actually working on that earlier and will be again after I finish the client work my boss just gave to me.

Offer a suggestion a code sample as to how you'd do it?

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...