Jump to content

Browse for an existing excel file?


fathihvac

Recommended Posts

HELLO,

I have posted this in theswamp.org

 

I am looking for a code that allow me to browse for an existing excel file and create a new worksheet and give it a predetermined name to put some data generated by a calculating autolisp program.

Link to comment
Share on other sites

Give that a try

For the test select some blocks on screen

 
(vl-load-com)
(defun C:XLDEMO  (/ *error* colm defName ExcelApp exc_data fcol fdata filepath ftype ins_point
                   ins_record Lngcount newName pfset row Sheets Sht ShtNames Wbk x xlCell xlCells XlLastsheet xlNewSheet)
 
(defun *error*  (msg)
   (if (vl-position
msg
'("console break"
  "Function cancelled"
  "quit / exit abort"
  )
)
     (princ msg)
      (princ "Error!")
      
      )
(vl-catch-all-apply
  'vlax-invoke-method
  (list ExcelApp "Quit")
)
 (mapcar
   (function (lambda (x)(vl-catch-all-apply(function (lambda()
 (if (not (vlax-object-released-p x))
   (progn
   (vlax-release-object x)
   (setq x nil))
 )
      )
   )
     )
 )
      )
   (list xlCells Sht Sheets Wbk ExcelApp)
 )  
 (gc)
 (gc) 
   (princ)
   )
 
 
(setq pfset(vla-get-pickfirstselectionset
            (vla-get-activedocument
              (vlax-get-acad-object))))
 
(vla-clear pfset)
 (setq ftype (list 0  410)
fdata (list "insert"  (getvar 'ctab)))

 (setq ftype (vlax-safearray-fill
               (vlax-make-safearray vlax-vbinteger
                 (cons 0 (1- (length ftype)))) ftype)
       fdata (vlax-safearray-fill
               (vlax-make-safearray vlax-vbvariant
                 (cons 0 (1- (length fdata)))) fdata)
 )
;;select all:
;;(vla-select pfset acselectionsetall nil nil ftype fdata)
;;or select on screen
(prompt "\nSelect blocks that you want to write in Excel")
(vla-selectonscreen pfset ftype fdata)
(if (> (vla-get-count pfset) 0)
 (progn (vlax-for block_obj pfset
          (setq ins_point  (vlax-get block_obj 'insertionpoint)
                ins_record (list (cons "BlockName" (vla-get-effectivename block_obj))
                                 (cons "Position X" (car ins_point))
                                 (cons "Position Y" (cadr ins_point))
                                 (cons "Position Z" (caddr ins_point))
                           )
          )
          (setq exc_data (cons ins_record exc_data))
        )
        ;;  Eof acad part  ;;
        (setq newName "PutYourNameHere") ;<-- change a sheet name here
        (setq filepath (getfiled "Data File" (getvar "dwgprefix") "xls;xlsx" 2))
        (setq ExcelApp (vl-catch-all-apply (function (lambda () (vlax-get-or-create-object "Excel.Application")))))
        (vlax-put-property ExcelApp 'visible :vlax-true)
        (vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)
        (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)
        (setq Wbk (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp 'workbooks) filepath)))
        (setq Sheets (vl-catch-all-apply 'vlax-get-property (list Wbk 'sheets)))
        (vlax-for itemSheet Sheets (setq shtNames (cons (vlax-get itemSheet 'name) shtNames)))
        ;; check if sheet already exist
        (if (vl-position newName shtNames)
          (progn (alert (strcat "Sheet named " (vl-prin1-to-string newName) " already exist.\nExiting program"))
                 (exit)
          )
        )
        (setq lngCount (vl-catch-all-apply 'vlax-get-property (list Sheets 'count)))
        (setq xlLastSheet (vl-catch-all-apply 'vlax-get-property (list Sheets 'item lngCount)))
        ;;add new sheet
        (vl-catch-all-apply 'vlax-invoke-method (list Sheets 'Add nil nil nil))
        (setq defName (vlax-get (vlax-get ExcelApp 'activesheet) 'name))
        (setq xlNewSheet (vl-catch-all-apply 'vlax-get-property (list Sheets 'Item defName)))
        (vl-cmdf "delay" 300)          ;optional delay 0.3 sec
        (vlax-invoke xlNewSheet 'move nil xlLastSheet)
        (vlax-put-property xlNewSheet 'name newName)
        (vlax-invoke xlNewSheet 'activate)
        ;; refresh XL screen
        (setq Wbk (vl-catch-all-apply (function (lambda () (vlax-get-property ExcelApp 'ActiveWorkBook)))))
        (setq Sht (vl-catch-all-apply (function (lambda () (vlax-get-property ExcelApp 'ActiveSheet)))))
        (setq xlCells (vl-catch-all-apply (function (lambda () (vlax-get-property Sht 'cells)))))
        ;;write the headers
        (setq row 1
              colm 1
        )
        (foreach header (list "Block Name" "X" "Y" "Z")
          (setq xlCell (variant-value (vlax-get-property xlCells 'item row colm)))
          (vlax-put-property xlCell 'value2 (vlax-make-variant header )
          (setq colm (1+ colm))
        )
       ;;write the rest data
        (setq row 1)
        (foreach line exc_data
          (setq row (1+ row))
          (setq colm 1)
          (foreach single line
            (setq xlCell (variant-value (vlax-get-property xlCells 'item row colm)))
            (vlax-put-property xlCell 'value2 (vlax-make-variant (cdr single)))
            (setq colm (1+ colm))
          )
        )
        ;; add some format
        (setq frow (vlax-get-property Sht 'Range "A1:A4"))
        (vlax-put-property frow 'NumberFormat "@")
        (setq fcol (vlax-get-property Sht 'Range "A:A"))
        (vlax-put-property fcol 'NumberFormat "@")
        (setq fcol (vlax-get-property Sht 'Range "B:D"))
        (vlax-put-property fcol 'NumberFormat "#0.000")
        (vlax-invoke (vlax-get-property Sht 'Columns) 'AutoFit)
        (vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)
        (vl-catch-all-apply 'vlax-invoke-method (list Wbk 'Save))
        (vl-catch-all-apply 'vlax-invoke-method (list Wbk 'Close))
 )
)
       (*error* nil)
       (princ)
)

(prompt "\n   >>   Start command with XLDEMO   <<")
(prin1)

Link to comment
Share on other sites

Hiya, Steve,

Perhaps you need to change on thisthis line

(setq filepath (getfiled "Data File" (getvar "dwgprefix") "xls" 2))

in Office 2000 just "xls" extension I think

You could be also add

(C:XLDEMO) at the very end of code and the run lisp from console,

after the error will be ooccurs go to menu Debug-->Last error source,

the problem line will be highlighted

Link to comment
Share on other sites

Hiya, Steve,

Perhaps you need to change on thisthis line

(setq filepath (getfiled "Data File" (getvar "dwgprefix") "xls" 2))

in Office 2000 just "xls" extension I think

You could be also add

(C:XLDEMO) at the very end of code and the run lisp from console,

after the error will be ooccurs go to menu Debug-->Last error source,

the problem line will be highlighted

 

when I pick a block in the drawing, following message occurs at command line:

Command: xldemo

Select blocks that you want to write in Excel

Select objects: 0 found

Select objects:

 

debug is no help, because no definite error message is available yet.

Steve

TIA

Link to comment
Share on other sites

My bad,

You have to select blocks then press Enter as usual

 

nada

program does not recognize block that is picked on screen, says

Command: XLDEMO

Select blocks that you want to write in Excel

Select objects: 0 found

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