Jump to content

Question

bradb

By bradb
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

bradb Enthusiast

bradb

Posted
Posted

I was just looking at the thread by firsrate_caduser (Routine Lisp) I too like the idea of pulling attribute info and pasting in excel. Since I use excel as a database for our drawing numbers and who they corrispond to. I would like to know:

 

I like the attexp2xl lisp pasted in the thread. It is not exactly what i need. When the command is executed it just opens a new excel file and paste it in the top cells. Since I have a file specified for one company I would like to open that excel file execute command and have it paste to the next cell available.

 

Sorry if I'm not making since. I wish I could write the lisp myself but I am not that advanced. Maybe one day.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Yes, I should think it could be modified to suit your needs :)

 

*Shall see what I can do*

Lee Mac Grand Master

Lee Mac

Posted
Posted

This will work on CSV files... (another format of Excel files) - it is a much shorter version of the code in the other thread.

 

Give it a shot and see what you think.

 

 (if (and (setq file (getfiled "Select Excel File" "C:\\" "csv" 9)
        ss (ssget "X" (list (cons 0 "INSERT") (cons 66 1)
   (if (getvar "CTAB") (cons 410 (getvar "CTAB"))
          (cons 67 (- 1 (getvar "TILEMODE"))))))))
   (progn
     (setq file (open file "a") ss (mapcar 'entnext (mapcar 'cadr (ssnamex ss))))
     (foreach e ss
   (while (not (eq "SEQEND" (cdadr (entget e))))
     (setq att (strcat (cdr (assoc 2 (entget e))) (chr 44) (cdr (assoc 1 (entget e))))
       attLst (cons att attLst) e (entnext e))))
     (alert (vl-princ-to-string attLst))
     (mapcar '(lambda (x) (write-line x file)) attLst)
     (close file))
   (princ "\n<!> No File Selected or No Attributed Blocks Found <!>"))
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted

I suppose if push came to shove, you could save your file as a csv file and then run the LISP and then save it as an xls file... only downside is that csv doesn't support multiple sheets.

fixo Mentor

fixo

Posted
Posted
I suppose if push came to shove, you could save your file as a csv file and then run the LISP and then save it as an xls file... only downside is that csv doesn't support multiple sheets.

Sorry, have you seen this question:

...I would like to open that excel file execute command and have it paste to the next cell available.

 

Just a thoughts

 

~'J'~

Lee Mac Grand Master

Lee Mac

Posted
Posted

Thanks for the heads-up Fixo, but yes, I did see that.

 

In the LISP I open the file for "appending" and so the information is inserted into the next available cells.

 

But I am using commas to separate tags from attribute strings, and this only works with csv files.

 

How does one write information into the adjacent cell of an xls file?

fixo Mentor

fixo

Posted
Posted
Thanks for the heads-up Fixo, but yes, I did see that.

 

In the LISP I open the file for "appending" and so the information is inserted into the next available cells.

 

But I am using commas to separate tags from attribute strings, and this only works with csv files.

 

How does one write information into the adjacent cell of an xls file?

Perhaps something like this

I was rewriting it from my old code

so I can't test it extensively

If you can, please, do spell all of the prompts

inside the code

 

;;  Groups elements in sublist by test expression

(defun subtrack	 (test lst)
 (apply 'append
 (mapcar '(lambda (x)
	    (if	(eq (car x) test)
	      (list x))
	    )
	 lst
	 )
 )
 )


;;  Counts equivalent items in list

(defun countsub	(lst sub)
 (cond	((null lst) 0)
((and (equal (caar lst) (car sub) 0.00001)
      (equal (cadar lst) (cadr sub) 0.00001)
 )
 (1+ (countsub (cdr lst) sub))
)
(T (countsub (cdr lst) sub))
 )
)
;;  Get info from block include from constant attributes in following form:
;; (("TAG1" . "VALUE1") ("TAG2" . "VALUE2") ...("*CONSTANT*: TAGN" . "VALUEN"))

 (defun get-all-atts (obj / atts att_list const_atts const_list ent)
   (and
 (if (and obj 
	  (vlax-property-available-p obj 'Hasattributes)
	  (eq :vlax-true (vla-get-hasattributes obj))
     )
   (progn
     (setq atts (vlax-invoke obj 'Getattributes))
     (foreach att atts
       (setq att_list
	      (cons (cons (vla-get-tagstring att)
			  (vla-get-textstring att)
		    )
		    att_list
	      )
       )
     )
   )
 )
   )
   (cond ((vlax-method-applicable-p obj 'Getconstantattributes)
   (setq const_atts (vlax-invoke obj 'Getconstantattributes))
   (foreach att	const_atts
     (setq const_list
	    (cons (cons	(vla-get-tagstring att)
			(vla-get-textstring att)
		  )
		  const_list
	    )
     )
   )
   (setq att_list (reverse (append const_list att_list)))
  )
  (T (reverse att_list))
   )
 )


(vl-load-com)
;;			Main part			;;
 (defun C:ATOUT (/ adoc aexc awb axss cll colm com_data csht data exc_data
	  fcol fcopy fn fname info itm lastcell lastrow nwb row sht
	  ss str1 str2 subtot tmp_data tmp_get tmp_snip tot)

   (alert "Be patience...\nWorks slowly...")
   (setq adoc (vla-get-activedocument
	 (vlax-get-acad-object)
       ))


   (vl-cmdf "zoom" "a")
   (vl-cmdf "zoom" ".9x")
   ;;  some variations of the selection
   ;;  All blocks with attributes:
       (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1))))
   ;;	Blocks blocks with attributes selected on screen:
;;;(setq ss (ssget (list (cons 0 "INSERT")(cons 66 1))))
   ;; All blocks with attributes selected by block name:
;;;    (setq bname (getstring "\n	***	Block name:\n"))
;;;    (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1) (cons 2 bname))))
   (setq axss (vla-get-activeselectionset adoc))
   (setq com_data nil)				  ;for debug only

   (vlax-for a	axss
     (setq tmp_get (get-all-atts a))
     (setq tmp_data (append (list (vla-get-name a)(vla-get-handle a)) tmp_get))
     (setq com_data (cons tmp_data com_data))
     (setq tmp_data nil)
   )						  
   (setq tot (length com_data))
   (setq exc_data nil)				  ;for debug only
   (while com_data
     (setq tmp_snip
     (subtrack (caar com_data) com_data)
     )
     (setq str1 (strcat "Subtotal blocks "
		 "\"" (caar com_data) "\""
                        ": "
	 )
    str2
	 (itoa (length tmp_snip))
     )
     (setq exc_data (append exc_data
		     (list (append tmp_snip (list (list str2 str1))))
	     )
    com_data (vl-remove-if
	       (function not)
	       (mapcar (function (lambda (x)
				   (if (not (member x tmp_snip))
				     x
				   )
				 )
		       )
		       com_data
	       )
	     )
    tmp_snip nil
     )
   )
   (setq exc_data
          (mapcar (function (lambda (x)
              (mapcar (function (lambda (y)                
                  (append (list (cadr y)(car y))(cddr y))))
                      x
                      )
                              )
                            )
                  exc_data)
                  )
   ;;		Eof count part		;;

   ;;	***	Excel part	***	;;
   
   ;;;    Excel part based on code that was written by  ALEJANDRO LEGUIZAMON
   ;;;    http://arquingen.tripod.com.co  

   (setq fname (getfiled "Select Your Working Excel Spreadsheet File:" "" "XLS" )
   (setq fname (findfile fname))   
   ;; remove the following code block if you don't need it
   ;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>;;
   ;; reserve an Excel file copy before you ran programm:
   (setq fcopy (strcat (getvar "dwgprefix")(vl-filename-base fname) "-COPY-"
		 (menucmd "M=$(edtime,$(getvar,date),HH-MM)") ".xls"))
   (vl-catch-all-apply
     (function (lambda()
	  (vl-file-copy fname fcopy))))
   (alert (strcat "Excel file copy saved as:\n"
		 "\"" fcopy "\"")
   )
   ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<;;
   
   ;; define Excel objects
   (setq aexc (vlax-get-or-create-object "Excel.Application")
  awb  (vlax-get-property aexc "Workbooks")
  nwb  (vlax-invoke-method awb "Open" fname)
  sht  (vlax-get-property nwb "Sheets")
  csht (vlax-get-property sht "Item" 1)
  cll  (vlax-get-property csht "Cells")
   )
;;;    (vlax-put-property csht 'Name "AttOut-AttIn");;-->> not used in this context
   (vla-put-visible aexc :vlax-true)


     ;; Find the last cell :

     ;; Invoke SpecialCells method:
     (setq lastCell (vlax-invoke-method cll
	       "SpecialCells"
	       (vlax-make-variant 11 3));--> you can get this Excel constant (11=xlDown? - don't remember it) from VBA editor-->Object Browser
    )
     (vlax-invoke-method lastCell "Activate")
     (setq lastRow (vlax-get-property
	       lastCell "Row"))
;;;      (setq lastColumn (vlax-get-property lastCell "Column"));->> if you need it
       (setq row (1+ lastRow);-->get the next row after
  colm 1
   )
   ;;; this will write data in the following order:
   ;;  handle | block name | attribute value #1 | ....| attribute value #N |
   (repeat (length exc_data)
     (setq data   (reverse (cdr (reverse (car exc_data))))
    subtot (last (car exc_data))
     )
     (repeat (length data)
(setq info (car data))
(repeat	(length info)
  (vlax-put-property
    cll
    "Item"
    row
    colm
           (if (< colm 3)
    (vl-princ-to-string (car info))
           (vl-princ-to-string (cdar info)))
  )
  (setq colm (1+ colm))
  (setq info (cdr info))
)
       (setq data (cdr data))
(setq row  (1+ row)
      colm 1
)
     )

     (vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (car subtot))
     )
     (setq colm (1+ colm))
     (vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (cadr subtot))
     )

     (setq exc_data (cdr exc_data))
     (setq row	 (1+ row)
    colm 1
     )
   )

   (setq row  (1+ row)
  colm 1
   )
   (vlax-put-property
     cll
     "Item"
     row
     colm
     (vl-princ-to-string "TOTAL BLOCKS:")
   )
   (setq colm (1+ colm))
   (vlax-put-property
     cll
     "Item"
     row
     colm
     (vl-princ-to-string tot)
   )
  (setq fcol (vlax-get-property csht "Range" "A:Z"))
  (vlax-put-property fcol "NumberFormat" "@")
;;;    (vlax-invoke (vlax-get-property csht "Columns") "AutoFit");-->>optional
   (mapcar (function (lambda(item)
		(vlax-release-object item)
		(setq itm nil)))
    (list lastCell cll fcol csht sht nwb awb aexc))

   (vla-clear axss)
   (vlax-release-object axss)
   (gc)
   (gc)
   (alert "Save Excel manually")
   (princ)
   )
(princ "\n\t\t***\tStart command with ATOUT...\t***")
(princ)

 

~'J'~

bradb Enthusiast

bradb

Posted
  • Author
Posted

Thanks Fixo that work nicely. And hopefully I can read the lisp a learn a little more about writing them.

 

Thanks again and you to Lee Mac you have helped me in the past so thanks again

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.

×
 Share
Go to topic listing
×
×
  • Create New...