;;===========================================;;
;; local defun
;; read used range of Excel sheet
;; ========================================= ;;


(defun EXD (/ ExcelApp ExcData FilePath Sht ShtNum UsdRange Wbk)

  (or (vl-load-com))
  (setq	FilePath (getfiled "Select file to read data :"
			   "C:\\TEMP\\"
			   "xlsx"
			   16
		 )
  )

  (setq ShtNum (getint "\nEnter sheet number : \n"))

  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vlax-put-property ExcelApp "DisplayAlerts" :vlax-false)
  (vla-put-Visible ExcelApp :vlax-true)
  (setq	Wbk (vl-catch-all-apply
	      'vla-open
	      (list (vlax-get-property ExcelApp "WorkBooks") FilePath)
	    )
  )
  (setq	Sht (vl-catch-all-apply
	      'vlax-get-property
	      (list (vlax-get-property Wbk "Sheets")
		    "Item"
		    ShtNum
	      )
	    )
  )
  (vlax-invoke-method Sht "Activate")
  (setq	UsdRange (vlax-get-property Sht 'UsedRange)
;;;    (setq	UsdRange (vlax-get-property Sht "Range" "A1:M1006")
	ExcData	 (vlax-safearray->list
		   (vlax-variant-value
		     (vlax-get-property UsdRange 'Value2)
		   )
		 )
  )
  (setq
    ExcData (mapcar
	      (function	(lambda	(x)
			  (mapcar 'vl-princ-to-string
				  (mapcar 'vlax-variant-value x)
			  )
			)
	      )
	      ExcData
	    )
  )
  (vlax-put-property ExcelApp "DisplayAlerts" :vlax-true)
;;;  (vl-catch-all-apply
;;;    'vlax-invoke-method
;;;    (list Wbk "close" )
;;;  )
;;;
;;;  (vl-catch-all-apply
;;;    'vlax-invoke-method
;;;    (list ExcelApp "quit" )
;;;  )

  (mapcar
    (function
      (lambda (x)
	(vl-catch-all-apply
	  (function (lambda ()
		      (progn
			(if (not (vlax-object-released-p x))
			  (progn
			    (vlax-release-object x)
			    (setq x nil)
			  )
			)
		      )
		    )
	  )
	)
      )
    )
    (list UsdRange Sht Wbk ExcelApp)
  )

  (gc)
  (gc)
  ExcData

)







;; main programm

(defun C:LISTIN	(/	 adoc	 at	 atts	 attvalues
		 axss	 blkinfo blkobj	 cnt	 data	 osm
		 ss	 ZEILE	 SPALTE	 ZEILEN	 DATEN	 HEADER
		 DAT
		)

  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
  )
  (vla-endundomark adoc)
  (vla-startundomark adoc)


  (setq blkinfo (exd))
;;;   (setq headerlist (cadr(cddddr blkinfo)))
  (setq headerlist (mapcar 'strcase (cadr (cddddr blkinfo))))
;;;   (setq blkinfo (mapcar
;;;                   (function (lambda (x)
;;;                               (vl-remove-if 	(function (lambda (y)
;;;                                                         (eq "lululululululululululululul" y)) )
;;;                   x)))
;;;                   (cdr blkinfo);<--remove headers
;;;                 ) 
;;;   )

  (setq blkinfo (cdr blkinfo))
  (setq handle-pos (vl-position "HANDLE" headerlist))

;;;   (setq blkinfo (vl-remove-if (function (lambda(x)
;;;                               (or (not x)(wcmatch (car x) "T*"))));<-- remove 'TOTAL' row
;;;                   blkinfo
;;;                 ) 
;;;   )
  ;;   (vl-cmdf "zoom" "a")
  ;;   (vl-cmdf "zoom" ".85x")

  (setq	blkinfo	(mapcar	'(lambda (data)
			   (cons (nth handle-pos data)
				 (mapcar 'list headerlist data)
			   )
			 )
			blkinfo
		)
  )

  (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 66 1))))
  (setq axss (vla-get-activeselectionset adoc))
   (vlax-for a axss
;;;  (vlax-for blkobj axss
    (if
      (setq data (assoc (vla-get-handle a) blkinfo))
       (progn
	 (setq blkobj (vlax-ename->vla-object (handent (car data))))
	 (setq atts (vlax-invoke blkobj 'GetAttributes))
;;;     (setq attvalues (cddr data))
	 (foreach ATT atts
	   (if
	     (setq
	       DAT (assoc (strcase (vla-get-TagString)) (cdr data))
	     )
	      (vla-put-TextString ATT (cadr DAT))
	   )
	 )
       )
    )
  )

;;;    (setq taglist nil)
;;;
;;;	(setq Handle (cons 0 (nth 0 headerlist)))
;;;        (setq Blockname (cons 1 (nth 1 headerlist)))
;;;	(setq Att1 (cons 2 (nth 2 headerlist)))
;;;     	(setq Att2 (cons 3 (nth 3 headerlist)))
;;;     	(setq Att3 (cons 4 (nth 4 headerlist)))
;;;     	(setq Att4 (cons 5 (nth 5 headerlist)))
;;;     	(setq Att5 (cons 6 (nth 6 headerlist)))
;;;     	(setq Att6 (cons 7 (nth 7 headerlist)))
;;;     	(setq Att7 (cons 8 (nth 8 headerlist)))
;;;     	(setq Att8 (cons 9 (nth 9 headerlist)))
;;;     	(setq Att9 (cons 10 (nth 10 headerlist)))
;;;     	(setq Att10 (cons 11 (nth 11 headerlist)))
;;;     	(setq Att11 (cons 12 (nth 12 headerlist)))
;;;     	(setq Att12 (cons 13 (nth 13 headerlist)))
;;;     	(setq Att13 (cons 14 (nth 14 headerlist)))
;;;     	(setq Att14 (cons 15 (nth 15 headerlist)))
;;;     	(setq Att15 (cons 16 (nth 16 headerlist)))
;;;     	(setq Att16 (cons 17 (nth 17 headerlist)))
;;;     	(setq Att17 (cons 18 (nth 18 headerlist)))
;;;     	(setq Att18 (cons 19 (nth 19 headerlist)))
;;;     	(setq Att19 (cons 20 (nth 20 headerlist)))
;;;     	(setq Att20 (cons 21 (nth 21 headerlist)))
;;;     	(setq Att21 (cons 22 (nth 22 headerlist)))
;;;     	(setq Att22 (cons 23 (nth 23 headerlist)))
;;;     	(setq Att23 (cons 24 (nth 24 headerlist)))
;;;     	(setq Att24 (cons 25 (nth 25 headerlist)))
;;;     	(setq Att25 (cons 26 (nth 26 headerlist)))
;;;     	(setq Att26 (cons 27 (nth 27 headerlist)))
;;;     
;;;	(setq HEADER (list Handle Blockname Att1 Att2 Att3 Att4 Att5 Att6 Att7 Att8 Att9 Att10 Att11 Att12 Att13 Att14 Att15 Att16 Att17 Att18 Att19 Att20 Att21 Att22 Att23 Att24 Att25 Att26))
;;;
;;;
;;;        (setq cnt 0)
;;;     	(repeat (length data)
;;;       		(setq Attv (cons cnt (nth cnt data)))
;;;       		(setq cnt (1+ cnt))
;;;       		(setq ZEILEN (reverse(cons Attv (reverse ZEILEN))))
;;;       		(if (= cnt (length headerlist))
;;;	 		(setq cnt 0)
;;;	 	)
;;;       	)
;;;     	(setq ZEILEN (list ZEILEN))
;;;
;;;     
;;;;;;        (setq ZEILEN '(
;;;;;;		       ((0 . "HANDLE-1")(1 . "BLOCKNAME-1")(2 . "ATTRIBUTWERT-1")(3 . "ATTRIBUTWERT-2"))
;;;;;;	      	       ((0 . "HANDLE-2")(1 . "BLOCKNAME-2")(2 . "ATTRIBUTWERT-3")(3 . "ATTRIBUTWERT-4"))))
;;;     
;;;	(setq DATEN (mapcar
;;;		      '(lambda (ZEILE)
;;;			 (mapcar
;;;			   '(lambda (SPALTE)
;;;			      (cons (cdr(assoc (car SPALTE) HEADER)) (cdr SPALTE))
;;;			      )
;;;			   
;;;			   ZEILE
;;;			   )
;;;			 )
;;;		      ZEILEN
;;;		      )
;;;	      )
;;;     
;;;;;;(foreach ATT atts
;;;;;;  (setq tag (vla-get-TagString ATT))
;;;;;;  (setq taglist (cons tag taglist))
;;;;;;  (if (setq DAT (assoc((tag)) (car DATEN)))
;;;;;;      (vla-put-TextString ATT (cdr DAT))
;;;;;;  )
;;;;;;)
;;;;;;(setq taglist (reverse taglist))     ;; zum testen
;;;
;;;     (princ headerlist) ;;zum testen
;;;
;;;     (setq ZEILEN nil)
;;;     (setq DATEN nil)
;;;

;;;   )
;;;     )
;;;     )
  (vla-endundomark adoc)
  (princ)
)
;;)
(princ "\n\t\t***\tStart command with LISTIN...\t***")
(princ)
;;;(C:LISTIN)