Jump to content

how to replace nil in matrix list, for import excel table

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted

I need a function of table import, like old version. 

 

routine = command "XSS" -> pick point for table -> set excel range -> Input row height = output table in cad

 

just for one time paste for edit existed drawing, in certain line spacing (=row height).

 

so, I merge some codes 

;; local defun
(defun RefSelection (/ *error* addr c2 c2 Excelapp Sel Sht r1 r2 Rng Vl Wbk pt)
 (setq pt (getpoint "\nSpecify point for table: "))
  (vl-load-com)
  (defun *error*  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
            (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()
		(if (not (vlax-object-released-p x))
		  (progn
		  (vlax-release-object x)
		  (setq x nil))
		)
	      )
    )
			   )
		)
	      )
    (list Sel Sht Wbk ExcelApp)
  )  
  (gc)
  (gc) 
    (princ)
    )
  

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "Excel WorkBook Must Be Open Before!")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "Select a Range: "
				    "Range Selection Example"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r1 (vlax-get-property Rng 'row))
    (setq c1 (vlax-get-property Rng 'column))
    (setq r2 (vlax-get-property (vlax-get-property Rng 'rows) 'count))
    (setq c2 (vlax-get-property (vlax-get-property Rng 'columns) 'count))

    (setq addr (strcat (chr (+ 64 c1))
		       (itoa r1)
		       ":"
		       (chr (+ (ascii (chr (+ 64 c1))) (1- c2)))
		       (itoa (+ r1 (1- r2)))))

    (setq Rng (vlax-get-property sht 'Range addr))

    (vlax-invoke Rng 'Select)
    )
  )

(if Rng
  (progn
	(setq vl (mapcar (function (lambda (x)
				 (mapcar 'vlax-variant-value x)))
		     (vlax-safearray->list
		       (vlax-variant-value
			 (vlax-get-property Rng 'value2)))))
	(princ "\n")
            
	;(alert (vl-princ-to-string vl))

 	                  (LM:startundo (LM:acdoc))
                    (SETVAR "CTABLESTYLE" "Standard")
                    (LM:addtable2  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (trans pt 1 0) nil vl nil)
                    (LM:endundo   (LM:acdoc))

  )
    (progn
      (alert "Select Excel Range Before!")
      (exit)
      (*error* nil)
      (princ)
      )

    )



(*error* nil)
)

;;Usage:
(defun C:Xss ()

(RefSelection)

(princ)
)
(princ)



;; (warning! not original pure code)
;; Add Table2  -  Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtable2 ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid scalefactor)
    (setq sty
        (vlax-ename->vla-object
            (cdr
                (assoc -1
                    (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
                        (getvar 'ctablestyle)
                    )
                )
            )
        )
    )
    (setq hgt (vla-gettextheight sty acdatarow))
    (setq scalefactor (/ (getint "\nInput Row height : ") (/ hgt 2)))
    (if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
        (setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
    )
    (setq wid
        (mapcar
           '(lambda ( col )
                (apply 'max
                    (mapcar
                       '(lambda ( str )
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 str)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                        )
                        col
                    )
                )
            )
            (apply 'mapcar (cons 'list lst))
        )
    )
    (if 
        (and ttl
            (< 0.0
                (setq dif
                    (/
                        (-
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 ttl)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                            (apply '+ wid)
                        )
                        (length wid)
                    )
                )
            )
        )
        (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
    )
    (setq obj
        (vla-addtable spc
            (vlax-3D-point ins)
            (1+ (length lst))
            (length (car lst))
            (* 2.0 hgt)
            (if eqc
                (apply 'max wid)
                (/ (apply '+ wid) (float (length (car lst))))
            )
        )
    )
    (vla-put-regeneratetablesuppressed obj :vlax-true)
    (vla-put-stylename obj (getvar 'ctablestyle))
    (setq i -1)
    (if (null eqc)
        (foreach col wid
            (vla-setcolumnwidth obj (setq i (1+ i)) col)
        )
    )
    (if ttl
        (progn
            (vla-settext obj 0 0 ttl)
            (setq i 1)
        )
        (progn
            (vla-deleterows obj 0 1)
            (setq i 0)
        )
    )
    (foreach row lst
        (setq j 0)
        (foreach val row
            (vla-settext obj i j val)
            (setq j (1+ j))
        )
        (setq i (1+ i))
    )
    (vla-put-regeneratetablesuppressed obj :vlax-false)
    obj




 (initget 6)
 (if(setq ss (ssget "L" '((0 . "ACAD_TABLE"))))
        (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                   (vla-scaleentity obj 
                       ;(vlax-3D-point
                        ;   (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                         ;      (vlax-safearray->list ll)
                          ;     (vlax-safearray->list ur)
                          ; )
                       ;)
                       (vlax-3D-point ins)
                       (/ scalefactor 4)
                   )
               )
           )
           (vla-delete sel)
       )
)
(princ)

)



;; Annotative-p  -  Lee Mac
;; Predicate function to determine whether a Text Style is annotative.
;; sty - [str] Name of Text Style

(defun LM:annotative-p ( sty )
    (and (setq sty (tblobjname "style" sty))
         (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse sty))))
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)



(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

 

 

It works in normal condition, but has 2 problems.

 

1. if range has nil value (null cell). get error.

    ->  so, I want to replace nil to "  " in matrix list. (list name is "vl")

         ex) ((a b c) (a nil nil) (a nil c)) -> ((a b c) (a "  " "  ") (a "  " c)) 

         convert list to string, then replace, then convert string to list? I tried that and failed just before........ so, now I replace that in excel before this routine.

 

2. no need to use title or header row in table. because text align is slightly incorrect with data row in standard tablestyle.

 

how can I correct that?

 

paste special does not have those 2 problem.

so is there anyway to use paste special acad object and then scale it by row height, in one-time procedure?

I heard that it is difficult, because paste special is out of control by lisp. I don't know exactly about that..

 

or datalink with like this short routine. I know datalink is good function, but take some time to make it newly.

Link to comment
Share on other sites
rlx Veteran

rlx

Posted
Posted

like this? 

(defun tmp ( / vl rl)
  (setq vl '((a b c) (a nil nil) (a nil c))) ;;; -> ((a b c) (a "  " "  ") (a "  " c))
  (foreach l vl (setq rl (cons (mapcar '(lambda (x)(if (null x) " " x)) l) rl)))
  (reverse rl)
)

 

  • Like 2
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted
3 hours ago, rlx said:

like this? 


(defun tmp ( / vl rl)
  (setq vl '((a b c) (a nil nil) (a nil c))) ;;; -> ((a b c) (a "  " "  ") (a "  " c))
  (foreach l vl (setq rl (cons (mapcar '(lambda (x)(if (null x) " " x)) l) rl)))
  (reverse rl)
)

 

 

oh, genius! that's what I want!

thank you very much for your help

 

 

 

now I can develop this routine  

;; local defun
(defun RefSelection (/ *error* addr c2 c2 Excelapp Sel Sht r1 r2 Rng Vl Wbk pt rl)
 (vl-load-com)
(setq vl '())
 (setq rl '())
 (setq pt (getpoint "\nSpecify point for table: "))
 
  (defun *error*  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
            (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()
		(if (not (vlax-object-released-p x))
		  (progn
		  (vlax-release-object x)
		  (setq x nil))
		)
	      )
    )
			   )
		)
	      )
    (list Sel Sht Wbk ExcelApp)
  )  
  (gc)
  (gc) 
    (princ)
    )
  

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "Excel WorkBook Must Be Open Before!")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "Select a Range: "
				    "Range Selection Example"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r1 (vlax-get-property Rng 'row))
    (setq c1 (vlax-get-property Rng 'column))
    (setq r2 (vlax-get-property (vlax-get-property Rng 'rows) 'count))
    (setq c2 (vlax-get-property (vlax-get-property Rng 'columns) 'count))

    (setq addr (strcat (chr (+ 64 c1))
		       (itoa r1)
		       ":"
		       (chr (+ (ascii (chr (+ 64 c1))) (1- c2)))
		       (itoa (+ r1 (1- r2)))))

    (setq Rng (vlax-get-property sht 'Range addr))

    (vlax-invoke Rng 'Select)
    )
  )

(if Rng
  (progn
	(setq vl (mapcar (function (lambda (x)
				 (mapcar 'vlax-variant-value x)))
		     (vlax-safearray->list
		       (vlax-variant-value
			 (vlax-get-property Rng 'value2)))))
	(princ "\n")
            
	;(alert (vl-princ-to-string vl))
	(foreach l vl (setq rl (cons (mapcar '(lambda (x)(if (null x) " " x)) l) rl)))
	(setq vl (reverse rl))

 	                  (LM:startundo (LM:acdoc))
                    (SETVAR "CTABLESTYLE" "Standard")
                    (LM:addtable2  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (trans pt 1 0) nil vl nil)
                    (LM:endundo   (LM:acdoc))
      (command "_.explode" "_L")

  )
    (progn
      (alert "Select Excel Range Before!")
      (exit)
      (*error* nil)
      (princ)
      )

    )



(*error* nil)
)

;;Usage:
(defun C:Xss ()

(RefSelection)

(princ)
)
(princ)



;; (warning! not original pure code)
;; Add Table2  -  Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtable2 ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid scalefactor)
    (setq sty
        (vlax-ename->vla-object
            (cdr
                (assoc -1
                    (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
                        (getvar 'ctablestyle)
                    )
                )
            )
        )
    )
    (setq hgt (vla-gettextheight sty acdatarow))
    (setq scalefactor (/ (getint "\nInput Row height : ") (/ hgt 2)))
    (if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
        (setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
    )
    (setq wid
        (mapcar
           '(lambda ( col )
                (apply 'max
                    (mapcar
                       '(lambda ( str )
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 str)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                        )
                        col
                    )
                )
            )
            (apply 'mapcar (cons 'list lst))
        )
    )
    (if 
        (and ttl
            (< 0.0
                (setq dif
                    (/
                        (-
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 ttl)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                            (apply '+ wid)
                        )
                        (length wid)
                    )
                )
            )
        )
        (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
    )
    (setq obj
        (vla-addtable spc
            (vlax-3D-point ins)
            (1+ (length lst))
            (length (car lst))
            (* 2.0 hgt)
            (if eqc
                (apply 'max wid)
                (/ (apply '+ wid) (float (length (car lst))))
            )
        )
    )
    (vla-put-regeneratetablesuppressed obj :vlax-true)
    (vla-put-stylename obj (getvar 'ctablestyle))
(vla-put-titlesuppressed obj :vlax-true)
(vla-put-headersuppressed obj :vlax-true)
    (setq i -1)
    (if (null eqc)
        (foreach col wid
            (vla-setcolumnwidth obj (setq i (1+ i)) col)
        )
    )
    (if ttl
        (progn
            (vla-settext obj 0 0 ttl)
            (setq i 1)
        )
        (progn
            (vla-deleterows obj 0 1)
            (setq i 0)
        )
    )
    (foreach row lst
        (setq j 0)
        (foreach val row
            (vla-settext obj i j val)
            (setq j (1+ j))
        )
        (setq i (1+ i))
    )
    (vla-put-regeneratetablesuppressed obj :vlax-false)
    obj




 (initget 6)
 (if(setq ss (ssget "L" '((0 . "ACAD_TABLE"))))
        (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                   (vla-scaleentity obj 
                       ;(vlax-3D-point
                        ;   (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                         ;      (vlax-safearray->list ll)
                          ;     (vlax-safearray->list ur)
                          ; )
                       ;)
                       (vlax-3D-point ins)
                       (/ scalefactor 4)
                   )
               )
           )
           (vla-delete sel)
       )
)
(princ)

)



;; Annotative-p  -  Lee Mac
;; Predicate function to determine whether a Text Style is annotative.
;; sty - [str] Name of Text Style

(defun LM:annotative-p ( sty )
    (and (setq sty (tblobjname "style" sty))
         (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse sty))))
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)



(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

 

1. now this routine can import empty or merged cell.

[merged cell -> separated cells] problem is remained... that's ok

 

2. 2nd problem with table style (without title & header) is solved by add 2 lines in LM:addtable2 module

(vla-put-titlesuppressed obj :vlax-true)
(vla-put-headersuppressed obj :vlax-true)

now first line of table has same text-align like other rows'

 

3. add list initialize for continuous import

(setq vl '())
(setq rl '())

 

 

 

 

6 hours ago, hosneyalaa said:

Hi

For better help 

Attached example excel file

 

as you say

Hi, like this attachment excel,

small table scattered in a drawing randomly

and has some empty row by revision footprints

 

and also index list has some empty row for tell them apart

BEFORE.PNG

AFTER.PNG

Table1.xlsx

Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted (edited) 
;; local defun
(defun RefSelection (/ *error* addr c2 c2 Excelapp Sel Sht r1 r2 Rng Vl Wbk pt rl)
 (vl-load-com)
(setq vl '())
 (setq rl '())
 (setq pt (getpoint "\nSpecify point for table: "))
 
  (defun *error*  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
            (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()
		(if (not (vlax-object-released-p x))
		  (progn
		  (vlax-release-object x)
		  (setq x nil))
		)
	      )
    )
			   )
		)
	      )
    (list Sel Sht Wbk ExcelApp)
  )  
  (gc)
  (gc) 
    (princ)
    )
  

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "Excel WorkBook Must Be Open Before!")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "Select a Range: "
				    "Range Selection Example"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r1 (vlax-get-property Rng 'row))
    (setq c1 (vlax-get-property Rng 'column))
    (setq r2 (vlax-get-property (vlax-get-property Rng 'rows) 'count))
    (setq c2 (vlax-get-property (vlax-get-property Rng 'columns) 'count))

    (setq addr (strcat (chr (+ 64 c1))
		       (itoa r1)
		       ":"
		       (chr (+ (ascii (chr (+ 64 c1))) (1- c2)))
		       (itoa (+ r1 (1- r2)))))

    (setq Rng (vlax-get-property sht 'Range addr))

    (vlax-invoke Rng 'Select)
    )
  )

(if Rng
  (progn
	(setq vl (mapcar (function (lambda (x)
				 (mapcar 'vlax-variant-value x)))
		     (vlax-safearray->list
		       (vlax-variant-value
			 (vlax-get-property Rng 'value2)))))
	(princ "\n")
            
	;(alert (vl-princ-to-string vl))
	(foreach l vl (setq rl (cons (mapcar '(lambda (x)(if (null x) " " x)) l) rl)))
	(setq vl (reverse rl))

 	                  (LM:startundo (LM:acdoc))
                    (SETVAR "CTABLESTYLE" "Standard")
                    (LM:addtable2  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (trans pt 1 0) nil vl nil)
                    (LM:endundo   (LM:acdoc))

  )
    (progn
      (alert "Select Excel Range Before!")
      (exit)
      (*error* nil)
      (princ)
      )

    )



(*error* nil)
)

;;Usage:
(defun C:XST ()

(RefSelection)

(princ)
)

(defun C:XSTX ()

(RefSelection)
            ;-----this code for explode twice--------
	(setq flags (getvar "qaflags"))
	(setvar "qaflags" 1)
	(command "explode" ss "")
	(command "explode" "p" "")
	(setvar "qaflags" flags)
            ;-----this code for explode twice--------


(princ)
)



;; (warning! not original pure code)
;; Add Table2  -  Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtable2 ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid scalefactor flags)
    (setq sty
        (vlax-ename->vla-object
            (cdr
                (assoc -1
                    (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
                        (getvar 'ctablestyle)
                    )
                )
            )
        )
    )
    (setq hgt (vla-gettextheight sty acdatarow))

    (initget 6) ; to prevent negative and zero input 
    (setq scalefactor (/ (getint "\nInput Row height : ") (/ hgt 2)))
    (if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
        (setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
    )
    (setq wid
        (mapcar
           '(lambda ( col )
                (apply 'max
                    (mapcar
                       '(lambda ( str )
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 str)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                        )
                        col
                    )
                )
            )
            (apply 'mapcar (cons 'list lst))
        )
    )
    (if 
        (and ttl
            (< 0.0
                (setq dif
                    (/
                        (-
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 ttl)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                            (apply '+ wid)
                        )
                        (length wid)
                    )
                )
            )
        )
        (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
    )
    (setq obj
        (vla-addtable spc
            (vlax-3D-point ins)
            (1+ (length lst))
            (length (car lst))
            (* 2.0 hgt)
            (if eqc
                (apply 'max wid)
                (/ (apply '+ wid) (float (length (car lst))))
            )
        )
    )
    (vla-put-regeneratetablesuppressed obj :vlax-true)
    (vla-put-stylename obj (getvar 'ctablestyle))
(vla-put-titlesuppressed obj :vlax-true)
(vla-put-headersuppressed obj :vlax-true)
    (setq i -1)
    (if (null eqc)
        (foreach col wid
            (vla-setcolumnwidth obj (setq i (1+ i)) col)
        )
    )
    (if ttl
        (progn
            (vla-settext obj 0 0 ttl)
            (setq i 1)
        )
        (progn
            (vla-deleterows obj 0 1)
            (setq i 0)
        )
    )
    (foreach row lst
        (setq j 0)
        (foreach val row
            (vla-settext obj i j val)
            (setq j (1+ j))
        )
        (setq i (1+ i))
    )
    (vla-put-regeneratetablesuppressed obj :vlax-false)
    obj




 (initget 6)
 (if(setq ss (ssget "L" '((0 . "ACAD_TABLE"))))
        (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                   (vla-scaleentity obj 
                       ;(vlax-3D-point
                        ;   (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                         ;      (vlax-safearray->list ll)
                          ;     (vlax-safearray->list ur)
                          ; )
                       ;)
                       (vlax-3D-point ins)
                       (/ scalefactor 4)
                   )
               )
           )
           (vla-delete sel)

      )
      
     
)
(princ)

)



;; Annotative-p  -  Lee Mac
;; Predicate function to determine whether a Text Style is annotative.
;; sty - [str] Name of Text Style

(defun LM:annotative-p ( sty )
    (and (setq sty (tblobjname "style" sty))
         (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse sty))))
    )
)



;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)



(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

 

 

 

fully upload to enable standalone execution for other users. (startundo, endundo, acdoc modules)

 

and separate option XST and XSTX

XST - output with table

XSTX - output with text & line (explode table twice)

 

add (initget 6) before row height input

prevent error by zero or negative row height. 😀

 

and to edit text align, just edit [ command : TABLESTYLE > Standard > Data area's text align ]

Edited by exceed
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted (edited)
1 hour ago, ketxu said:

Thank for sharing. And Sorry for asking, what advantage of thi routine with Paste Special  -> AutoCAD Enities ?

 

set row height directly. for edit existed drawing. 

and autofit column make no multiline text

and without GUI windows.

but it lose merged cell information.

 

It's rarely necessary, but it's good to have I think.😅

 

 

 

 

and some edits. 


;; local defun
(defun RefSelection (/ *error* addr c2 c2 Excelapp Sel Sht r1 r2 Rng Vl Wbk pt rl)
 (vl-load-com)
(setq vl '())
 (setq rl '())

 
  (defun *error*  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
            (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()
		(if (not (vlax-object-released-p x))
		  (progn
		  (vlax-release-object x)
		  (setq x nil))
		)
	      )
    )
			   )
		)
	      )
    (list Sel Sht Wbk ExcelApp)
  )  
  (gc)
  (gc) 
    (princ)
    )
  

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "Excel WorkBook Must Be Open Before!")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(princ "\n Go to EXCEL for range selection.")

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "Select a Range: "
				    "Range Selection Example"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r1 (vlax-get-property Rng 'row))
    (setq c1 (vlax-get-property Rng 'column))
    (setq r2 (vlax-get-property (vlax-get-property Rng 'rows) 'count))
    (setq c2 (vlax-get-property (vlax-get-property Rng 'columns) 'count))

    (setq addr (strcat (chr (+ 64 c1))
		       (itoa r1)
		       ":"
		       (chr (+ (ascii (chr (+ 64 c1))) (1- c2)))
		       (itoa (+ r1 (1- r2)))))

    (setq Rng (vlax-get-property sht 'Range addr))

    (vlax-invoke Rng 'Select)
    )
  )

(if Rng
  (progn
	(setq vl (mapcar (function (lambda (x)
				 (mapcar 'vlax-variant-value x)))
		     (vlax-safearray->list
		       (vlax-variant-value
			 (vlax-get-property Rng 'value2)))))
	(princ "\n")
            
	;(alert (vl-princ-to-string vl))  ; list check (excel data by matrix)
	(foreach l vl (setq rl (cons (mapcar '(lambda (x)(if (null x) " " x)) l) rl)))
	(setq vl (reverse rl))
            (setq pt (getpoint "\nSpecify point for table: "))
 	                  (LM:startundo (LM:acdoc))
                    (SETVAR "CTABLESTYLE" "Standard")
                    (LM:addtableforXST  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (trans pt 1 0) nil vl nil)
                    (LM:endundo   (LM:acdoc))

  )
    (progn
      (alert "Select Excel Range Before!")
      (exit)
      (*error* nil)
      (princ)
      )

    )



(*error* nil)
)

;;Usage:
(defun C:XST ()

(RefSelection)

(princ)
)

(defun C:XSTX ()

(RefSelection)
            ;-----this code for explode twice--------
	(setq flags (getvar "qaflags"))
	(setvar "qaflags" 1)
	(command "explode" ss "")
	(command "explode" "p" "")
	(setvar "qaflags" flags)
            ;-----this code for explode twice--------


(princ)
)



;; (warning! not original pure code)
;; Add Table  -  Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtableforXST ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid scalefactor flags aligninput alignoutput)
    (setq sty
        (vlax-ename->vla-object
            (cdr
                (assoc -1
                    (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
                        (getvar 'ctablestyle)
                    )
                )
            )
        )
    )
    (setq hgt (vla-gettextheight sty acdatarow))

    (initget 6) ; to prevent negative and zero input 
    (setq scalefactor (/ (getint "\nInput Row height : ") (/ hgt 2)))



    (if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
        (setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
    )

    (setq wid '())
    (setq row 1)

    (setq wid
        (mapcar
           '(lambda ( col )
                (apply 'max
                    (mapcar
                       '(lambda ( str )
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 (vl-princ-to-string str))
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )

                        )
                        col
                    )
                )
            )
            (apply 'mapcar (cons 'list lst))
        )
    )
    (if 
        (and ttl
            (< 0.0
                (setq dif
                    (/
                        (-
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 ttl)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                            (apply '+ wid)
                        )
                        (length wid)
                    )
                )
            )
        )
        (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
    )
    (setq obj
        (vla-addtable spc
            (vlax-3D-point ins)
            (1+ (length lst))
            (length (car lst))
            (* 2.0 hgt)
            (if eqc
                (apply 'max wid)
                (/ (apply '+ wid) (float (length (car lst))))
            )
        )
    )
    (vla-put-regeneratetablesuppressed obj :vlax-true)
    (vla-put-stylename obj (getvar 'ctablestyle))
    (vla-put-titlesuppressed obj :vlax-true)
    (vla-put-headersuppressed obj :vlax-true)



    (setq aligninput (getstring (strcat "\nInput Text Align :   TopLeft (TL) / TopCenter (TC) / TopRight (TR) "
                                              "\n                         MiddleLeft (ML) / MiddleCenter (MC) / MiddleRight (MR)"
                                             "\n                          BottomLeft (BL) / BottomCenter (BC) / BottomRight (BR)"
                                             "\n                          [ Default = MiddleLeft (ML) ]\n")))


    (setq aligninput (strcase aligninput t)) ;convert input to downcase(lowercase)
    (cond
	((= aligninput "bc") (vla-setalignment obj acDataRow acBottomCenter) (setq alignoutput "MiddleCenter (BC) is Selected."))
	((= aligninput "bl") (vla-setalignment obj acDataRow acBottomLeft) (setq alignoutput "MiddleLeft (BL) is Selected.")) 
	((= aligninput "br") (vla-setalignment obj acDataRow acBottomRight) (setq alignoutput "MiddleRight (BR) is Selected."))
	((= aligninput "mc") (vla-setalignment obj acDataRow acMiddleCenter) (setq alignoutput "MiddleCenter (MC) is Selected."))
	((= aligninput "ml") (vla-setalignment obj acDataRow acMiddleLeft) (setq alignoutput "MiddleLeft (ML) is Selected."))
	((= aligninput "mr") (vla-setalignment obj acDataRow acMiddleRight) (setq alignoutput "MiddleRight (MR) is Selected."))
	((= aligninput "tc") (vla-setalignment obj acDataRow acTopCenter) (setq alignoutput "TopCenter (TC) is Selected."))
	((= aligninput "tl") (vla-setalignment obj acDataRow acTopLeft) (setq alignoutput "TopLeft (TL) is Selected."))
	((= aligninput "tr") (vla-setalignment obj acDataRow acTopRight) (setq alignoutput "TopRight (TR) is Selected."))
	(t (vla-setalignment obj acDataRow acMiddleLeft) (setq alignoutput "No Input. MiddleLeft (ML) is Selected."))
   )

   (princ (strcat "\n " alignoutput "\n ")) 

    (setq i -1)
    (setq eqc null)
    (foreach col wid
            ;(if (< col 20) (setq col 20))                      ;for minimum column width option
            (vla-setcolumnwidth obj (setq i (1+ i)) col )
    )
    (if ttl
        (progn
            (vla-settext obj 0 0 ttl)
            (setq i 1)
        )
        (progn
            (vla-deleterows obj 0 1)
            (setq i 0)
        )
    )
    (foreach row lst
        (setq j 0)
        (foreach val row
            (vla-settext obj i j val)
            (setq j (1+ j))
        )
        (setq i (1+ i))
    )
    (vla-put-regeneratetablesuppressed obj :vlax-false)
    obj




 (initget 6)
 (if(setq ss (ssget "L" '((0 . "ACAD_TABLE"))))
        (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                   (vla-scaleentity obj 
                       (vlax-3D-point ins)
                       (/ scalefactor 4)
                   )
               )
           )
           (vla-delete sel)

      )
      
     
)
(princ)

)



;; Annotative-p  -  Lee Mac
;; Predicate function to determine whether a Text Style is annotative.
;; sty - [str] Name of Text Style

(defun LM:annotative-p ( sty )
    (and (setq sty (tblobjname "style" sty))
         (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse sty))))
    )
)





;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

 

Sorry for the frequent edits.

 

1. Autofit option in add table module, has 1 little problem with my routine

If column has only cells with numbers. textbox column width = 0.0 ( variable name = col, list name = wid )

I don't know why. lambda and mapcar is too difficult for me.😅

but I think it cannot measure number's textbox width.

and RefSelection module takes number as a number for calculate directly. I think.

 

so I edit

(cons 01 str)

to 

(cons 01 (vl-princ-to-string str)) 

 

then It works good.😃

 

2. add text align option. 

 

(setq aligninput (getstring

~

(princ (strcat "\n " alignoutput "\n ")) 

 

now, no need to edit tablestyle format.

it was simple to use

 

 

3. move pick point sequence after excel range selection instinctively.

 

 

have a nice day

Edited by exceed
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.

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