Jump to content

Export cad text/ table in excel (get Error)

Ish

By Ish
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

hanhphuc Mentor

hanhphuc

Posted
Posted
1 hour ago, Ish said:

THANKS SIR, WORKING NICELY.

THANK YOU

 

you are welcome :)

 

  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • Ish

    9

  • hosneyalaa

    5

  • devitg

    3

  • BIGAL

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

hosneyalaa
hosneyalaa

Try thiS LISP Export-Table-to-excel _ LispBox .LSP

hanhphuc
hanhphuc

If the error persists, or try this shorter routine as an alternative without using COM API. Its just a simpler algorithm merely sorting each row of TEXT from top to bottom. since it does not

devitg
devitg

The main fact is that is not any ACADTABLE . it are lines and text arranged like a TABLE, but not an ACADTABLE 

Posted Images

  • 2 years later...
exceed Proficient

exceed

Posted
Posted (edited)
On 10/27/2019 at 3:21 PM, hosneyalaa said:

이 LISP를 시도하십시오

엑셀로 테이블 내보내기 _ LispBox .LSP 18.75 kB · 74 다운로드

  

(defun c:tbltoex ()
  (pl:export-to-excel)
) ;_ end of defun

(defun c:tbltoexwithfilename ()
  (pl:export-to-excel-withfilename)
) ;_ end of defun


(defun pl:export-to-excel-withfilename (/ ccells csheet dat excel i k newbook torel wbooks wsheets next cols filename)
  (if (setq excel (vlax-get-or-create-object "Excel.Application"))
    (progn
      (setq wbooks  (vlax-get-property excel 'workbooks)
            newbook (vlax-invoke-method wbooks 'add 1)
            wsheets (vlax-get-property newbook 'worksheets)
            csheet  (vlax-get-property newbook 'activesheet)
      ) ;_ end of setq

      (while (setq dat (pl:get-tbl-data))
        (if next
          (setq torel  (cons csheet torel)
;;;		csheet (vlax-invoke-method wsheets 'add nil csheet) 
                csheet (vlax-invoke-method wsheets 'add)
          ) ;_ end of setq
        ) ;_ end of if
        (setq ccells (vlax-get-property csheet 'cells)
              cols   (vlax-get-property csheet 'columns)
              i      0
        ) ;_ end of setq
        (setq filenametxt (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) )
        (setq dat (append (list (list (strcat "Table from this drawing = ") filenametxt )) dat)) 
        (foreach y dat
          (setq i (1+ i)
                k 0
          ) ;_ end of setq
          (foreach x y
            (setq k (1+ k))
            (pl:put-val-to-cell ccells i k x)
          ) ;_ end of foreach
        ) ;_ end of foreach

        ;(princ dat)
        (vlax-invoke-method cols 'autofit)
        (vlax-release-object cols)
        (vlax-release-object ccells)
        (setq next t)
      ) ;_ end of while
      (if torel
        (vlax-invoke-method (last torel) 'activate)
      ) ;_ end of if
      (if (= (vlax-get-property excel 'visible) :vlax-false)
        (vlax-put-property excel 'visible :vlax-true)
      ) ;_ end of if
      (foreach x (cons csheet
                       (if torel
                         (append torel (list wsheets newbook wbooks excel))
                         (list wsheets newbook wbooks excel)
                       ) ;_ end of if
                 ) ;_ end of cons
        (vlax-release-object x)
      ) ;_ end of foreach
    ) ;_ end of progn
    (alert "Can not launch Excel!!")
  ) ;_ end of if
  (princ)
) ;_ end of defun



(defun pl:export-to-excel (/ ccells csheet dat excel i k newbook torel wbooks wsheets next cols)
  (if (setq excel (vlax-get-or-create-object "Excel.Application"))
    (progn
      (setq wbooks  (vlax-get-property excel 'workbooks)
            newbook (vlax-invoke-method wbooks 'add 1)
            wsheets (vlax-get-property newbook 'worksheets)
            csheet  (vlax-get-property newbook 'activesheet)
      ) ;_ end of setq
      (while (setq dat (pl:get-tbl-data))
        (if next
          (setq torel  (cons csheet torel)
                csheet (vlax-invoke-method wsheets 'add)
          ) ;_ end of setq
        ) ;_ end of if
        (setq ccells (vlax-get-property csheet 'cells)
              cols   (vlax-get-property csheet 'columns)
              i      0
        ) ;_ end of setq
        (foreach y dat
          (setq i (1+ i)
                k 0
          ) ;_ end of setq
          (foreach x y
            (setq k (1+ k))
            (pl:put-val-to-cell ccells i k x)
          ) ;_ end of foreach
        ) ;_ end of foreach
        (vlax-invoke-method cols 'autofit)
        (vlax-release-object cols)
        (vlax-release-object ccells)
        (setq next t)
      ) ;_ end of while
      (if torel
        (vlax-invoke-method (last torel) 'activate)
      ) ;_ end of if
      (if (= (vlax-get-property excel 'visible) :vlax-false)
        (vlax-put-property excel 'visible :vlax-true)
      ) ;_ end of if
      (foreach x (cons csheet
                       (if torel
                         (append torel (list wsheets newbook wbooks excel))
                         (list wsheets newbook wbooks excel)
                       ) ;_ end of if
                 ) ;_ end of cons
        (vlax-release-object x)
      ) ;_ end of foreach
    ) ;_ end of progn
    (alert "Can not launch Excel!!")
  ) ;_ end of if
  (princ)
) ;_ end of defun

(defun pl:put-val-to-cell (ccells x y val / tmp brd form)
  (setq val (vl-string-trim " " val))
  (vlax-put-property
    (setq tmp (vlax-variant-value
                (vlax-get-property
                  ccells
                  'item
                  (vlax-make-variant x vlax-vbinteger)
                  (vlax-make-variant y vlax-vbinteger)
                ) ;_ end of vlax-get-property
              ) ;_ end of vlax-variant-value
    ) ;_ end of setq
    "Value2"
    (vlax-make-variant val vlax-vbvariant)
  ) ;_ end of vlax-put-property
  (setq brd (vlax-get-property tmp 'borders))
  (vlax-put-property brd 'colorindex (vlax-make-variant -4105 3))
  (if (= (type (setq form (pl:is-real-form val))) 'str)
    (vlax-put-property
      tmp
      'numberformat
      (vlax-make-variant (strcat "# ##0" form) 8)
    ) ;_ 
  ) ;_ end of if
  (vlax-release-object brd)
  (vlax-release-object tmp)
) ;_ end of defun

(defun pl:is-real-form (val)
  (cond ((not (= (vl-string-trim "0123456789.," val) "")) nil)
        ((= (vl-string-trim "0123456789" val) "") "")
        ((< 1
            (length (vl-remove-if-not
                      (function
                        (lambda (a)
                          (or (= a 44) (= a 46))
                        ) ;_ end of lambda
                      ) ;_ end of function
                      (vl-string->list val)
                    ) ;_ end of vl-remove-if-not
            ) ;_ end of length
         ) ;_ end of <
         nil
        )
        (t
         (vl-list->string
           (mapcar (function
                     (lambda (b)
                       (if (or (= b 44) (= b 46))
                         46
                         48
                       ) ;_ end of if
                     ) ;_ end of lambda
                   ) ;_ end of function
                   (vl-string->list (vl-string-left-trim "0123456789" val))
           ) ;_ end of mapcar
         ) ;_ end of vl-list->string
        )
  ) ;_ end of cond
) ;_ end of defun

(defun pl:get-tbl-ents (/ _box)
  (setq
    _box
     (vl-catch-all-apply
       (function
         (lambda (/ corn1 corn2)
           (if
             (and (setq corn1
                         (getpoint
                           "\nSelect TopLeft Corner of Table <Exit>: "
                         ) ;_ end of getpoint
                  ) ;_ end of setq
                  (setq corn2
                         (getcorner
                           corn1
                           "\nSelect BottomRight Corner of Table <Exit>: "
                         ) ;_ end of getcorner
                  ) ;_ end of setq
                  (setq corn1 (polar corn1 (dtr 135) (/ (distance corn1 corn2) 200) ))    ; add this for leaking problem with first line
                  (setq corn2 (polar corn2 (dtr 315) (/ (distance corn1 corn2) 200) ))    ; add this for leaking problem with last line
             ) ;_ end of and
              (list corn1 corn2)
           ) ;_ end of if
         ) ;_ end of lambda
       ) ;_ end of function
       nil
     ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
  (if (cond ((not _box) (princ "\nNo selection") nil)
            ((vl-catch-all-error-p _box)
             (princ (strcat "\n" (vl-catch-all-error-message _box)))
             nil
            )
            (t
             (setq _box (list (list (min (caar _box) (caadr _box))
                                    (max (cadar _box) (cadadr _box))
                              ) ;_ end of list
                              (list (max (caar _box) (caadr _box))
                                    (min (cadar _box) (cadadr _box))
                              ) ;_ end of list
                        ) ;_ end of list
             ) ;_ end of setq
            )
      ) ;_ end of cond
    (list _box
          (ssget "_C" (car _box) (cadr _box) '((0 . "LINE")))
          (ssget "_C" (car _box) (cadr _box) '((0 . "LWPOLYLINE")))
          (ssget "_C" (car _box) (cadr _box) '((0 . "TEXT")))
    ) ;_ end of list
  ) ;_ end of if
) ;_ end of defun

(defun pl:get-tbl-data (/ _sel _texts _lhrzn _lines _lvert _lwpl _modcol _modrow _mtx)
  (if (setq _texts (last (setq _sel (pl:get-tbl-ents))))
    (progn
      (setq _lines (cadr _sel)
            _lwpl  (caddr _sel)
            _sel   (car _sel)
      ) ;_ end of setq
      (if _lines
        (setq _lines (mapcar 'pl:extr-pnt-from-line (pl:entlst-from-ss _lines)))
      ) ;_ end of if
      (if _lwpl
        (setq _lwpl (apply 'append
                           (mapcar 'pl:lwpl-to-segments (pl:entlst-from-ss _lwpl))
                    ) ;_ end of apply
        ) ;_ end of setq
      ) ;_ end of if
      (if
        (and (setq _lines (append _lines _lwpl))
             (setq _lines (vl-remove-if-not
                            (function
                              (lambda (x)
                                (pl:is-point-in-bbox (pl:get-cen-pnts-2d x) _sel)
                              ) ;_ end of lambda
                            ) ;_ end of function
                            _lines
                          ) ;_ end of vl-remove-if-not
             ) ;_ end of setq
             (setq _lines (mapcar (function
                                    (lambda (x)
                                      (pl:near-orto x 3)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                  _lines
                          ) ;_ end of mapcar
             ) ;_ end of setq
             (> (length
                  (setq _lvert (mapcar 'cdr
                                       (vl-remove-if
                                         (function
                                           (lambda (x)
                                             (or (not x)
                                                 (= (car x) 0)
                                             ) ;_ end of or
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                         _lines
                                       ) ;_ end of vl-remove-if
                               ) ;_ end of mapcar
                  ) ;_ end of setq
                ) ;_ end of length
                1
             ) ;_ end of >
             (> (length
                  (setq _lhrzn (mapcar 'cdr
                                       (vl-remove-if
                                         (function
                                           (lambda (x)
                                             (or (not x)
                                                 (= (car x) 1)
                                             ) ;_ end of or
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                         _lines
                                       ) ;_ end of vl-remove-if
                               ) ;_ end of mapcar
                  ) ;_ end of setq
                ) ;_ end of length
                1
             ) ;_ end of >
        ) ;_ end of and
         (progn
           (setq _modcol (pl:get-len-perc _lvert 1.0)
                 _modrow (* 0.5
                            (apply 'min
                                   (mapcar 'vla-get-height
                                           (setq _texts (mapcar 'vlax-ename->vla-object
                                                                (pl:entlst-from-ss _texts)
                                                        ) ;_ end of mapcar
                                           ) ;_ end of setq
                                   ) ;_ end of mapcar
                            ) ;_ end of apply
                         ) ;_ end of *
                 _lvert  (pl:clr-near-doub (pl:sort '< _lvert) _modcol)
                 _lhrzn  (pl:sort '> (pl:clr-near-doub (pl:sort '< _lhrzn) _modrow))
                 _texts  (mapcar 'list
                                 (mapcar 'pl:get-cen-pnts (mapcar 'pl:get-bbox _texts))
                                 _texts
                         ) ;_ end of mapcar
                 _mtx    (pl:mk-arr-from-lns _lhrzn _lvert)
                 _mtx    (mapcar (function (lambda (a b) (mapcar 'list a b)))
                                 _mtx
                                 (mapcar 'cdr (cdr _mtx))
                         ) ;_ end of mapcar
                 _mtx    (mapcar (function
                                   (lambda (a)
                                     (mapcar (function
                                               (lambda (b)
                                                 (pl:txts-conc
                                                   (vl-remove-if-not
                                                     (function
                                                       (lambda (c)
                                                         (pl:is-point-in-bbox (car c) b)
                                                       ) ;_ end of lambda
                                                     ) ;_ end of function
                                                     _texts
                                                   ) ;_ end of vl-remove-if-not
                                                 ) ;_ end of cadar
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                             a
                                     ) ;_ end of mapcar
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                                 _mtx
                         ) ;_ end of mapcar
           ) ;_ end of setq
           (mapcar (function (lambda (b)
                               (mapcar (function (lambda (c)
                                                   (cond (c)
                                                         (t "")
                                                   ) ;_ end of cond
                                                 ) ;_ end of lambda
                                       ) ;_ end of function
                                       b
                               ) ;_ end of mapcar
                             ) ;_ end of lambda
                   ) ;_ end of function
                   (vl-remove-if-not (function (lambda (a) (apply 'or a))) _mtx)
           ) ;_ end of mapcar
         ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(defun pl:txts-conc (i-lst)
  (pl:txtsym-chng
    (cond ((not i-lst) nil)
          ((= (length i-lst) 1) (vla-get-textstring (cadar i-lst)))
          (t
           (apply 'strcat
                  (mapcar (function
                            (lambda (c / tmp)
                              (setq tmp (vl-string-trim " " (vla-get-textstring (cadr c))))
                              (if (= (last (vl-string->list tmp)) 45)
                                (vl-string-right-trim "-" tmp)
                                (strcat tmp " ")
                              ) ;_ end of if
                            ) ;_ end of lambda
                          ) ;_ end of function
                          (pl:sort (function
                                     (lambda (a b / tmp)
                                       (setq tmp (angle (car a) (car b)))
                                       (or (< 0 tmp 0.52359878)
                                           (< 4.1887902 tmp 6.2831853)
                                       ) ;_ end of or
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                   i-lst
                          ) ;_ end of pl:sort
                  ) ;_ end of mapcar
           ) ;_ end of apply
          )
    ) ;_ end of cond
  ) ;_ end of pl:txtsym-chng
) ;_ end of defun

(defun pl:txtsym-chng (str)
  (if str
    (foreach a '(("%%d" "?)
                 ("%%c" "")
                 ("%%p" "?)
                 ("%%%" "%")
                 ("\\U+00B0" "?)
                 ("\\U+2205" "")
                 ("\\U+00B1" "?)
                 ("%%o" "")
                 ("%%u" "")
                )
      (while (vl-string-search (car a) str)
        (setq str (vl-string-subst (cadr a) (car a) str))
      ) ;_ end of while
    ) ;_ end of foreach
  ) ;_ end of if
  str
) ;_ end of defun

(defun pl:mk-arr-from-lns (col row)
  (mapcar (function
            (lambda (a)
              (mapcar (function
                        (lambda (b)
                          (list b a)
                        ) ;_ end of lambda
                      ) ;_ end of function
                      row
              ) ;_ end of mapcar
            ) ;_ end of lambda
          ) ;_ end of function
          col
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:clr-near-doub (ilst mod / el tmp)
  (if ilst
    (progn
      (setq el  (car ilst)
            tmp (pl:clr-near-doub (cdr ilst) mod)
      ) ;_ end of setq
      (if (and tmp (> el (- (car tmp) mod)))
        tmp
        (cons el tmp)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(defun pl:get-len-perc (lst perc)
  (* (abs (- (apply 'max lst) (apply 'min lst))) 0.01 perc)
) ;_ end of defun

(defun pl:extr-pnt-from-line (_line / _p1 _p2)
  (setq _line (entget _line)
        _p1   (cdr (assoc 10 _line))
        _p2   (cdr (assoc 11 _line))
  ) ;_ end of setq
  (list (list (car _p1) (cadr _p1))
        (list (car _p2) (cadr _p2))
  ) ;_ end of list
) ;_ end of defun

(defun pl:extr-pnt-from-lwline (_dxf)
  (mapcar 'cdr
          (vl-remove-if-not
            (function
              (lambda (x)
                (= 10 (car x))
              ) ;_ end of lambda
            ) ;_ end of function
            _dxf
          ) ;_ end of vl-remove-if-not
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:lwpl-to-segments (_lwline / _vert)
  (setq _lwline (entget _lwline)
        _vert   (pl:extr-pnt-from-lwline _lwline)
  ) ;_ end of setq
  (mapcar 'list
          (if (zerop (logand 1 (cdr (assoc 70 _lwline))))
            (cdr _vert)
            (cons (last _vert) _vert)
          ) ;_ end of if
          _vert
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:near-orto (_lstpnt _delta / _ang _dir)
  (setq _ang   (rem (apply 'angle _lstpnt) pi)
        _delta (rem (/ (* pi _delta) 180) (* pi 2))
        _dir   (cond ((>= (+ (/ pi 2) _delta) _ang (- (/ pi 2) _delta)) 1)
                     ((or (>= _delta _ang 0) (>= pi _ang (- pi _delta))) 0)
                     (t nil)
               ) ;_ end of cond
  ) ;_ end of setq
  (if _dir
    (cons _dir
          (/ (apply '+
                    (mapcar (if (= _dir 0)
                              'cadr
                              'car
                            ) ;_ end of if
                            _lstpnt
                    ) ;_ end of mapcar
             ) ;_ end of apply
             2
          ) ;_ end of /
    ) ;_ end of cons
  ) ;_ end of if
) ;_ end of defun

(defun pl:sort (func lst)
  (mapcar (function
            (lambda (x)
              (nth x lst)
            ) ;_ end of lambda
          ) ;_ end of function
          (vl-sort-i lst func)
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:entlst-from-ss (ss)
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of defun

(defun pl:get-bbox (obj / minpoint maxpoint)
  (vla-getboundingbox obj 'minpoint 'maxpoint)
  (mapcar 'vlax-safearray->list (list minpoint maxpoint))
) ;_ end of defun

(defun pl:is-point-in-bbox (point bbox)
  (apply 'and
         (mapcar (function
                   (lambda (x y)
                     (<= (apply 'min x) y (apply 'max x))
                   ) ;_ end of lambda
                 ) ;_ end of function
                 (apply 'mapcar (cons 'list bbox))
                 point
         ) ;_ end of mapcar
  ) ;_ end of apply
) ;_ end of defun

(defun pl:get-cen-pnts (pntlst / len)
  (setq len (length pntlst))
  (list (/ (apply '+ (mapcar 'car pntlst)) len)
        (/ (apply '+ (mapcar 'cadr pntlst)) len)
        (/ (apply '+ (mapcar 'caddr pntlst)) len)
  ) ;_ end of list
) ;_ end of defun

(defun pl:get-cen-pnts-2d (pntlst / len)
  (setq len (length pntlst))
  (list (/ (apply '+ (mapcar 'car pntlst)) len)
        (/ (apply '+ (mapcar 'cadr pntlst)) len)
  ) ;_ end of list
) ;_ end of defun

(apply
  (function
    (lambda ()
      (vl-load-com)
      (princ
       (strcat
          "\nExport Autocad Drawn Table to Excel"
          "\nAverbuh Igal Software"
          "\ntype 'tbltoex' or 'tbltoexwithfilename' to execute."
        ) ;_ end of strcat
      ) ;_ end of princ
      (princ)
    ) ;_ end of lambda
  ) ;_ end of function
  nil
) ;_ end of apply


(defun dtr (a)
(setq x (* pi (/ a 180.0)))
)

(defun rtd (a)
(setq x (/ (* a 180) pi))
)

 

this lisp is great! 

 

1.

but little little problem with my drawing. 

This sometimes misses the first or last line, so add 2 line for this 

 

(setq corn1 (polar corn1 (dtr 135) (/ (distance corn1 corn2) 200) ))    
(setq corn2 (polar corn2 (dtr 315) (/ (distance corn1 corn2) 200) ))

 

 

This increases the range by 1/200. This is a duct tape fix

 

 

2.

and add little command for export filename at first 2 cells

command : tbltoexwithfilename

 

 

3.

and I realized that if I used this with http://www.lee-mac.com/boxtext.html

can output the distributed text to the cells that fit the position.

 

bt with 0 spacing for all text

then tbltoex

then undo twice for delete bt, Excel is not undoed, so only boxtext will be deleted.

2021-12-23 16;07;40.PNG

 

2021-12-23 16;08;11.PNG

 

 

4.

 

tbltoex can only handle orthogonal box (deg 0, 90, 180, 270)

 

Therefore, for rotated texts, a function such as the red box below is required.

It seems to be possible by finding the min and max values from the vertex of tb.

I don't know about it yet, now I'm looking for it. 

I am a beginner in Lisp, so this is a very interesting for me

29739598_2021-12-23172111.PNG.e36a5efc5e19e2bf3658168d27f1b0c2.PNG

Edited by exceed
BIGAL Grand Master

BIGAL

Posted
Posted

Red box is easy its a function Bounding box.

  

(setq obj (vlax-ename->vla-object (car (entsel "pick object "))))

(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
;minpoint contains the minimum point of the bounding box
;maxpoint contains the maximum point of the bounding box

 

  • Like 1
exceed Proficient

exceed

Posted
Posted
On 12/24/2021 at 7:37 AM, BIGAL said:

Red box is easy its a function Bounding box.

  


(setq obj (vlax-ename->vla-object (car (entsel "pick object "))))

(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
;minpoint contains the minimum point of the bounding box
;maxpoint contains the maximum point of the bounding box

 

  

(defun c:tbltoex ()
(setvar 'cmdecho 0)
(command "ucs" "w")
  (pl:export-to-excel)
(command "ucs" "p")
(setvar 'cmdecho 1)
) ;_ end of defun

(defun c:tbltoexwithfilename ()
(setvar 'cmdecho 0)
(command "ucs" "w")
  (pl:export-to-excel-withfilename)
(command "ucs" "p")
(setvar 'cmdecho 1)
) ;_ end of defun


(defun c:tbltoextest ()
(princ "\n Selete Texts to Export : \n")
(setvar 'cmdecho 0)
(command "ucs" "w")
(c:bt_edited)
(princ)
(princ "\n A temporary box has been created. Please select the area you just selected again \n")
(princ)
(pl:export-to-excel-withfilename)
(command "ucs" "p")
(setvar 'cmdecho 1)
(princ)
(princ)
(LM:endundo (LM:acdoc))
(command "_u")
(princ)
(princ)
) ;_ end of defun


(defun pl:export-to-excel-withfilename (/ ccells csheet dat excel i k newbook torel wbooks wsheets next cols filename)
  (if (setq excel (vlax-get-or-create-object "Excel.Application"))
    (progn
      (setq wbooks  (vlax-get-property excel 'workbooks)
            newbook (vlax-invoke-method wbooks 'add 1)
            wsheets (vlax-get-property newbook 'worksheets)
            csheet  (vlax-get-property newbook 'activesheet)
      ) ;_ end of setq

      (while (setq dat (pl:get-tbl-data))
        (if next
          (setq torel  (cons csheet torel)
;;;		csheet (vlax-invoke-method wsheets 'add nil csheet) 
                csheet (vlax-invoke-method wsheets 'add)
          ) ;_ end of setq
        ) ;_ end of if
        (setq ccells (vlax-get-property csheet 'cells)
              cols   (vlax-get-property csheet 'columns)
              i      0
        ) ;_ end of setq
        (setq filenametxt (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) )
        (setq dat (append (list (list (strcat "Table from this drawing = ") filenametxt )) dat)) 
        (foreach y dat
          (setq i (1+ i)
                k 0
          ) ;_ end of setq
          (foreach x y
            (setq k (1+ k))
            (pl:put-val-to-cell ccells i k x)
          ) ;_ end of foreach
        ) ;_ end of foreach

        ;(princ dat)
        (vlax-invoke-method cols 'autofit)
        (vlax-release-object cols)
        (vlax-release-object ccells)
        (setq next t)
      ) ;_ end of while
      (if torel
        (vlax-invoke-method (last torel) 'activate)
      ) ;_ end of if
      (if (= (vlax-get-property excel 'visible) :vlax-false)
        (vlax-put-property excel 'visible :vlax-true)
      ) ;_ end of if
      (foreach x (cons csheet
                       (if torel
                         (append torel (list wsheets newbook wbooks excel))
                         (list wsheets newbook wbooks excel)
                       ) ;_ end of if
                 ) ;_ end of cons
        (vlax-release-object x)
      ) ;_ end of foreach
    ) ;_ end of progn
    (alert "Can not launch Excel!!")
  ) ;_ end of if
  (princ)
) ;_ end of defun



(defun pl:export-to-excel (/ ccells csheet dat excel i k newbook torel wbooks wsheets next cols)
  (if (setq excel (vlax-get-or-create-object "Excel.Application"))
    (progn
      (setq wbooks  (vlax-get-property excel 'workbooks)
            newbook (vlax-invoke-method wbooks 'add 1)
            wsheets (vlax-get-property newbook 'worksheets)
            csheet  (vlax-get-property newbook 'activesheet)
      ) ;_ end of setq
      (while (setq dat (pl:get-tbl-data))
        (if next
          (setq torel  (cons csheet torel)
                csheet (vlax-invoke-method wsheets 'add)
          ) ;_ end of setq
        ) ;_ end of if
        (setq ccells (vlax-get-property csheet 'cells)
              cols   (vlax-get-property csheet 'columns)
              i      0
        ) ;_ end of setq
        (foreach y dat
          (setq i (1+ i)
                k 0
          ) ;_ end of setq
          (foreach x y
            (setq k (1+ k))
            (pl:put-val-to-cell ccells i k x)
          ) ;_ end of foreach
        ) ;_ end of foreach
        (vlax-invoke-method cols 'autofit)
        (vlax-release-object cols)
        (vlax-release-object ccells)
        (setq next t)
      ) ;_ end of while
      (if torel
        (vlax-invoke-method (last torel) 'activate)
      ) ;_ end of if
      (if (= (vlax-get-property excel 'visible) :vlax-false)
        (vlax-put-property excel 'visible :vlax-true)
      ) ;_ end of if
      (foreach x (cons csheet
                       (if torel
                         (append torel (list wsheets newbook wbooks excel))
                         (list wsheets newbook wbooks excel)
                       ) ;_ end of if
                 ) ;_ end of cons
        (vlax-release-object x)
      ) ;_ end of foreach
    ) ;_ end of progn
    (alert "Can not launch Excel!!")
  ) ;_ end of if
  (princ)
) ;_ end of defun

(defun pl:put-val-to-cell (ccells x y val / tmp brd form)
  (setq val (vl-string-trim " " val))
  (vlax-put-property
    (setq tmp (vlax-variant-value
                (vlax-get-property
                  ccells
                  'item
                  (vlax-make-variant x vlax-vbinteger)
                  (vlax-make-variant y vlax-vbinteger)
                ) ;_ end of vlax-get-property
              ) ;_ end of vlax-variant-value
    ) ;_ end of setq
    "Value2"
    (vlax-make-variant val vlax-vbvariant)
  ) ;_ end of vlax-put-property
  (setq brd (vlax-get-property tmp 'borders))
  (vlax-put-property brd 'colorindex (vlax-make-variant -4105 3))
  (if (= (type (setq form (pl:is-real-form val))) 'str)
    (vlax-put-property
      tmp
      'numberformat
      (vlax-make-variant (strcat "# ##0" form) 8)
    ) ;_ 
  ) ;_ end of if
  (vlax-release-object brd)
  (vlax-release-object tmp)
) ;_ end of defun

(defun pl:is-real-form (val)
  (cond ((not (= (vl-string-trim "0123456789.," val) "")) nil)
        ((= (vl-string-trim "0123456789" val) "") "")
        ((< 1
            (length (vl-remove-if-not
                      (function
                        (lambda (a)
                          (or (= a 44) (= a 46))
                        ) ;_ end of lambda
                      ) ;_ end of function
                      (vl-string->list val)
                    ) ;_ end of vl-remove-if-not
            ) ;_ end of length
         ) ;_ end of <
         nil
        )
        (t
         (vl-list->string
           (mapcar (function
                     (lambda (b)
                       (if (or (= b 44) (= b 46))
                         46
                         48
                       ) ;_ end of if
                     ) ;_ end of lambda
                   ) ;_ end of function
                   (vl-string->list (vl-string-left-trim "0123456789" val))
           ) ;_ end of mapcar
         ) ;_ end of vl-list->string
        )
  ) ;_ end of cond
) ;_ end of defun

(defun pl:get-tbl-ents (/ _box)
  (setq
    _box
     (vl-catch-all-apply
       (function
         (lambda (/ corn1 corn2)
           (if
             (and (setq corn1
                         (getpoint
                           "\nSelect TopLeft Corner of Table <Input SpaceBar to Exit>: " ;edited line
                         ) ;_ end of getpoint
                  ) ;_ end of setq
                  (setq corn2
                         (getcorner
                           corn1
                           "\nSelect BottomRight Corner of Table <Input SpaceBar to Exit>: " ;edited line
                         ) ;_ end of getcorner
                  ) ;_ end of setq
                  (setq corn1 (polar corn1 (dtr 135) (/ (distance corn1 corn2) 200) ))    ; add this for leaking problem with first line
                  (setq corn2 (polar corn2 (dtr 315) (/ (distance corn1 corn2) 200) ))    ; add this for leaking problem with last line
             ) ;_ end of and
              (list corn1 corn2)
           ) ;_ end of if
         ) ;_ end of lambda
       ) ;_ end of function
       nil
     ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
  (if (cond ((not _box) (princ "\nNo selection") nil)
            ((vl-catch-all-error-p _box)
             (princ (strcat "\n" (vl-catch-all-error-message _box)))
             nil
            )
            (t
             (setq _box (list (list (min (caar _box) (caadr _box))
                                    (max (cadar _box) (cadadr _box))
                              ) ;_ end of list
                              (list (max (caar _box) (caadr _box))
                                    (min (cadar _box) (cadadr _box))
                              ) ;_ end of list
                        ) ;_ end of list
             ) ;_ end of setq
            )
      ) ;_ end of cond
    (list _box
          (ssget "_C" (car _box) (cadr _box) '((0 . "LINE")))
          (ssget "_C" (car _box) (cadr _box) '((0 . "LWPOLYLINE")))
          (ssget "_C" (car _box) (cadr _box) '((0 . "TEXT")))
    ) ;_ end of list
  ) ;_ end of if
) ;_ end of defun

(defun pl:get-tbl-data (/ _sel _texts _lhrzn _lines _lvert _lwpl _modcol _modrow _mtx)
  (if (setq _texts (last (setq _sel (pl:get-tbl-ents))))
    (progn
      (setq _lines (cadr _sel)
            _lwpl  (caddr _sel)
            _sel   (car _sel)
      ) ;_ end of setq
      (if _lines
        (setq _lines (mapcar 'pl:extr-pnt-from-line (pl:entlst-from-ss _lines)))
      ) ;_ end of if
      (if _lwpl
        (setq _lwpl (apply 'append
                           (mapcar 'pl:lwpl-to-segments (pl:entlst-from-ss _lwpl))
                    ) ;_ end of apply
        ) ;_ end of setq
      ) ;_ end of if
      (if
        (and (setq _lines (append _lines _lwpl))
             (setq _lines (vl-remove-if-not
                            (function
                              (lambda (x)
                                (pl:is-point-in-bbox (pl:get-cen-pnts-2d x) _sel)
                              ) ;_ end of lambda
                            ) ;_ end of function
                            _lines
                          ) ;_ end of vl-remove-if-not
             ) ;_ end of setq
             (setq _lines (mapcar (function
                                    (lambda (x)
                                      (pl:near-orto x 3)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                  _lines
                          ) ;_ end of mapcar
             ) ;_ end of setq
             (> (length
                  (setq _lvert (mapcar 'cdr
                                       (vl-remove-if
                                         (function
                                           (lambda (x)
                                             (or (not x)
                                                 (= (car x) 0)
                                             ) ;_ end of or
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                         _lines
                                       ) ;_ end of vl-remove-if
                               ) ;_ end of mapcar
                  ) ;_ end of setq
                ) ;_ end of length
                1
             ) ;_ end of >
             (> (length
                  (setq _lhrzn (mapcar 'cdr
                                       (vl-remove-if
                                         (function
                                           (lambda (x)
                                             (or (not x)
                                                 (= (car x) 1)
                                             ) ;_ end of or
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                         _lines
                                       ) ;_ end of vl-remove-if
                               ) ;_ end of mapcar
                  ) ;_ end of setq
                ) ;_ end of length
                1
             ) ;_ end of >
        ) ;_ end of and
         (progn
           (setq _modcol (pl:get-len-perc _lvert 1.0)
                 _modrow (* 0.5
                            (apply 'min
                                   (mapcar 'vla-get-height
                                           (setq _texts (mapcar 'vlax-ename->vla-object
                                                                (pl:entlst-from-ss _texts)
                                                        ) ;_ end of mapcar
                                           ) ;_ end of setq
                                   ) ;_ end of mapcar
                            ) ;_ end of apply
                         ) ;_ end of *
                 _lvert  (pl:clr-near-doub (pl:sort '< _lvert) _modcol)
                 _lhrzn  (pl:sort '> (pl:clr-near-doub (pl:sort '< _lhrzn) _modrow))
                 _texts  (mapcar 'list
                                 (mapcar 'pl:get-cen-pnts (mapcar 'pl:get-bbox _texts))
                                 _texts
                         ) ;_ end of mapcar
                 _mtx    (pl:mk-arr-from-lns _lhrzn _lvert)
                 _mtx    (mapcar (function (lambda (a b) (mapcar 'list a b)))
                                 _mtx
                                 (mapcar 'cdr (cdr _mtx))
                         ) ;_ end of mapcar
                 _mtx    (mapcar (function
                                   (lambda (a)
                                     (mapcar (function
                                               (lambda (b)
                                                 (pl:txts-conc
                                                   (vl-remove-if-not
                                                     (function
                                                       (lambda (c)
                                                         (pl:is-point-in-bbox (car c) b)
                                                       ) ;_ end of lambda
                                                     ) ;_ end of function
                                                     _texts
                                                   ) ;_ end of vl-remove-if-not
                                                 ) ;_ end of cadar
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                             a
                                     ) ;_ end of mapcar
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                                 _mtx
                         ) ;_ end of mapcar
           ) ;_ end of setq
           (mapcar (function (lambda (b)
                               (mapcar (function (lambda (c)
                                                   (cond (c)
                                                         (t "")
                                                   ) ;_ end of cond
                                                 ) ;_ end of lambda
                                       ) ;_ end of function
                                       b
                               ) ;_ end of mapcar
                             ) ;_ end of lambda
                   ) ;_ end of function
                   (vl-remove-if-not (function (lambda (a) (apply 'or a))) _mtx)
           ) ;_ end of mapcar
         ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(defun pl:txts-conc (i-lst)
  (pl:txtsym-chng
    (cond ((not i-lst) nil)
          ((= (length i-lst) 1) (vla-get-textstring (cadar i-lst)))
          (t
           (apply 'strcat
                  (mapcar (function
                            (lambda (c / tmp)
                              (setq tmp (vl-string-trim " " (vla-get-textstring (cadr c))))
                              (if (= (last (vl-string->list tmp)) 45)
                                (vl-string-right-trim "-" tmp)
                                (strcat tmp " ")
                              ) ;_ end of if
                            ) ;_ end of lambda
                          ) ;_ end of function
                          (pl:sort (function
                                     (lambda (a b / tmp)
                                       (setq tmp (angle (car a) (car b)))
                                       (or (< 0 tmp 0.52359878)
                                           (< 4.1887902 tmp 6.2831853)
                                       ) ;_ end of or
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                   i-lst
                          ) ;_ end of pl:sort
                  ) ;_ end of mapcar
           ) ;_ end of apply
          )
    ) ;_ end of cond
  ) ;_ end of pl:txtsym-chng
) ;_ end of defun

(defun pl:txtsym-chng (str)
  (if str
    (foreach a '(("%%d" "?)
                 ("%%c" "")
                 ("%%p" "?)
                 ("%%%" "%")
                 ("\\U+00B0" "?)
                 ("\\U+2205" "")
                 ("\\U+00B1" "?)
                 ("%%o" "")
                 ("%%u" "")
                )
      (while (vl-string-search (car a) str)
        (setq str (vl-string-subst (cadr a) (car a) str))
      ) ;_ end of while
    ) ;_ end of foreach
  ) ;_ end of if
  str
) ;_ end of defun

(defun pl:mk-arr-from-lns (col row)
  (mapcar (function
            (lambda (a)
              (mapcar (function
                        (lambda (b)
                          (list b a)
                        ) ;_ end of lambda
                      ) ;_ end of function
                      row
              ) ;_ end of mapcar
            ) ;_ end of lambda
          ) ;_ end of function
          col
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:clr-near-doub (ilst mod / el tmp)
  (if ilst
    (progn
      (setq el  (car ilst)
            tmp (pl:clr-near-doub (cdr ilst) mod)
      ) ;_ end of setq
      (if (and tmp (> el (- (car tmp) mod)))
        tmp
        (cons el tmp)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(defun pl:get-len-perc (lst perc)
  (* (abs (- (apply 'max lst) (apply 'min lst))) 0.01 perc)
) ;_ end of defun

(defun pl:extr-pnt-from-line (_line / _p1 _p2)
  (setq _line (entget _line)
        _p1   (cdr (assoc 10 _line))
        _p2   (cdr (assoc 11 _line))
  ) ;_ end of setq
  (list (list (car _p1) (cadr _p1))
        (list (car _p2) (cadr _p2))
  ) ;_ end of list
) ;_ end of defun

(defun pl:extr-pnt-from-lwline (_dxf)
  (mapcar 'cdr
          (vl-remove-if-not
            (function
              (lambda (x)
                (= 10 (car x))
              ) ;_ end of lambda
            ) ;_ end of function
            _dxf
          ) ;_ end of vl-remove-if-not
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:lwpl-to-segments (_lwline / _vert)
  (setq _lwline (entget _lwline)
        _vert   (pl:extr-pnt-from-lwline _lwline)
  ) ;_ end of setq
  (mapcar 'list
          (if (zerop (logand 1 (cdr (assoc 70 _lwline))))
            (cdr _vert)
            (cons (last _vert) _vert)
          ) ;_ end of if
          _vert
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:near-orto (_lstpnt _delta / _ang _dir)
  (setq _ang   (rem (apply 'angle _lstpnt) pi)
        _delta (rem (/ (* pi _delta) 180) (* pi 2))
        _dir   (cond ((>= (+ (/ pi 2) _delta) _ang (- (/ pi 2) _delta)) 1)
                     ((or (>= _delta _ang 0) (>= pi _ang (- pi _delta))) 0)
                     (t nil)
               ) ;_ end of cond
  ) ;_ end of setq
  (if _dir
    (cons _dir
          (/ (apply '+
                    (mapcar (if (= _dir 0)
                              'cadr
                              'car
                            ) ;_ end of if
                            _lstpnt
                    ) ;_ end of mapcar
             ) ;_ end of apply
             2
          ) ;_ end of /
    ) ;_ end of cons
  ) ;_ end of if
) ;_ end of defun

(defun pl:sort (func lst)
  (mapcar (function
            (lambda (x)
              (nth x lst)
            ) ;_ end of lambda
          ) ;_ end of function
          (vl-sort-i lst func)
  ) ;_ end of mapcar
) ;_ end of defun

(defun pl:entlst-from-ss (ss)
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of defun

(defun pl:get-bbox (obj / minpoint maxpoint)
  (vla-getboundingbox obj 'minpoint 'maxpoint)
  (mapcar 'vlax-safearray->list (list minpoint maxpoint))
) ;_ end of defun

(defun pl:is-point-in-bbox (point bbox)
  (apply 'and
         (mapcar (function
                   (lambda (x y)
                     (<= (apply 'min x) y (apply 'max x))
                   ) ;_ end of lambda
                 ) ;_ end of function
                 (apply 'mapcar (cons 'list bbox))
                 point
         ) ;_ end of mapcar
  ) ;_ end of apply
) ;_ end of defun

(defun pl:get-cen-pnts (pntlst / len)
  (setq len (length pntlst))
  (list (/ (apply '+ (mapcar 'car pntlst)) len)
        (/ (apply '+ (mapcar 'cadr pntlst)) len)
        (/ (apply '+ (mapcar 'caddr pntlst)) len)
  ) ;_ end of list
) ;_ end of defun

(defun pl:get-cen-pnts-2d (pntlst / len)
  (setq len (length pntlst))
  (list (/ (apply '+ (mapcar 'car pntlst)) len)
        (/ (apply '+ (mapcar 'cadr pntlst)) len)
  ) ;_ end of list
) ;_ end of defun

(apply
  (function
    (lambda ()
      (vl-load-com)
      (princ
       (strcat
          "\nExport Autocad Drawn Table to Excel"
          "\nAverbuh Igal Software"
          "\ntype 'tbltoex' or 'tbltoexwithfilename' to execute."
        ) ;_ end of strcat
      ) ;_ end of princ
      (princ)
    ) ;_ end of lambda
  ) ;_ end of function
  nil
) ;_ end of apply


(defun dtr (a)
(setq x (* pi (/ a 180.0)))
)

(defun rtd (a)
(setq x (/ (* a 180) pi))
)


;;----------------------------=={ Box Text }==--------------------------;;
;;                                                                      ;;
;;  This program performs in much the same way as the Express Tools'    ;;
;;  'TCircle' command: enabling the user to create a 2D polyline        ;;
;;  rectangular frame around selected Text & MText objects, with a      ;;
;;  user-defined offset.                                                ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'BT' at the AutoCAD command-line,   ;;
;;  the program first prompts the user to specify an offset factor      ;;
;;  for the text frame. This factor is multiplied by the text height    ;;
;;  for every selected text object to determine the offset of the       ;;
;;  rectangular frame from the text. At this prompt, the last used      ;;
;;  value is available as a default option.                             ;;
;;                                                                      ;;
;;  The program then prompts the user to make a selection of text       ;;
;;  and/or mtext objects. Following a valid selection, the program      ;;
;;  iterates over the selection and constructs a rectangular frame      ;;
;;  surrounding each object, offset by a distance determined by the     ;;
;;  given offset factor. The generated text box will inherit the        ;;
;;  basic properties of the enclosed text object (e.g. Layer, Linetype, ;;
;;  Lineweight etc.).                                                   ;;
;;                                                                      ;;
;;  The program will also perform successfully with Text or MText       ;;
;;  defined in any construction plane, and under all UCS & view         ;;
;;  settings.                                                           ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright ?2010  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2015-02-22                                      ;;
;;----------------------------------------------------------------------;;

(defun c:bt_edited ( / *error* def enx idx lst off sel )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (if (or (not (setq def (getenv "LMac\\boxtext-off")))
            (not (setq def (distof def 2)))
        )
        (setenv "LMac\\boxtext-off" (rtos (setq def 0.35) 2 2))
    )
    (initget 4)
    ;(if (setq off (getreal (strcat "\nSpecify offset factor <" (rtos def 2 2) ">: "))) ;original line
    (if (setq off 0) ;edited line
        (setenv "LMac\\boxtext-off" (rtos off 2 2))
        (setq off def)
    )
    
    (LM:startundo (LM:acdoc))
    ;(if (setq sel (LM:ssget "\nSelect text or mtext <exit>: " '(((0 . "TEXT,MTEXT"))))) ;original line
    (if (setq sel (LM:ssget "\n" '(((0 . "TEXT,MTEXT"))))) ;edited line
        (repeat (setq idx (sslength sel))
            (setq enx (entget (ssname sel (setq idx (1- idx))))
                  lst (text-box-off enx (* off (cdr (assoc 40 enx))))
            )
            (entmake
                (append
                   '(
                        (000 . "LWPOLYLINE")
                        (100 . "AcDbEntity")
                        (100 . "AcDbPolyline")
                        (090 . 4)
                        (070 . 1)
                    )
                    (LM:defaultprops enx)
                    (list (cons  038 (caddar lst)))
                    (mapcar '(lambda ( x ) (cons 10 x)) lst)
                    (list (assoc 210 enx))
                )
            
            )
	(mkbbx_edited)  ;edited line
        )
    )
    ;(LM:endundo (LM:acdoc)) ;edited line
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Default Properties  -  Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
 
(defun LM:defaultprops ( enx )
    (mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
       '(
            (006 . "BYLAYER")
            (008 . "0")
            (039 . 0.0)
            (048 . 1.0)
            (062 . 256)
            (370 . -1)
        )
    )
)

;; Text Box  -  gile / Lee Mac
;; Returns an OCS point list describing a rectangular frame surrounding
;; the supplied text or mtext entity with optional offset
;; enx - [lst] Text or MText DXF data list
;; off - [rea] offset (may be zero)

(defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (= "TEXT" (cdr (assoc 00 enx)))
            (setq bpt (cdr (assoc 10 enx))
                  rot (cdr (assoc 50 enx))
                  lst (textbox enx)
                  lst
                (list
                    (list (- (caar  lst) off) (- (cadar  lst) off)) (list (+ (caadr lst) off) (- (cadar  lst) off))
                    (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar  lst) off) (+ (cadadr lst) off))
                )
            )
        )
        (   (= "MTEXT" (cdr (assoc 00 enx)))
            (setq ocs  (cdr (assoc 210 enx))
                  bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                  rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                  wid  (cdr (assoc 42 enx))
                  hgt  (cdr (assoc 43 enx))
                  jus  (cdr (assoc 71 enx))
                  org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                             (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                       )
                  lst
                (list
                    (list (- (car org) off)     (- (cadr org) off))     (list (+ (car org) wid off) (- (cadr org) off))
                    (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off)     (+ (cadr org) hgt off))
                )
            )
        )
    )
    (if lst
        (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
            (list
                (list (cos rot) (sin (- rot)) 0.0)
                (list (sin rot) (cos rot)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
)
 
;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
 
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

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

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
    (strcat
        "\n:: BoxText.lsp | Version 1.2 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"bt\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;








(defun mkbbx_edited ( / a axss lpx lpy upx upy rtpts maxp minp points ss ofdst pt1 pt3)
  ;(setq ss (ssget)) ;original line
  (setq ss (ssget "L")) ;edited line
  (if ss
    (progn
(setq axss (vla-get-activeselectionset(vla-get-activedocument(vlax-get-acad-object)))
       )
  (vlax-for a  axss
    (if(not (vl-catch-all-error-p
        (vl-catch-all-apply
 (function (lambda ()
 (vla-getboundingbox a 'minp 'maxp))))))
      (setq points (append (list (vlax-safearray->list minp)
    (vlax-safearray->list maxp))
     points)
)
      )
    )
  (setq lpx (car(car(vl-sort points
   (function (lambda (a b)        
          (> (car a) (car b))           
        )))))
);_setq
  (setq lpy (cadr(car(vl-sort points
   (function (lambda (a b)        
          (< (cadr a) (cadr b))           
        )))))
);_setq
  (setq upx (car(car(vl-sort points
   (function (lambda (a b)        
          (< (car a) (car b))           
        )))))
);_setq
  (setq upy (cadr(car(vl-sort points
   (function (lambda (a b)        
          (> (cadr a) (cadr b))           
        )))))
);_setq
  (setq rtpts (list(list upx upy)(list lpx lpy)))        
;(setq ofdst (getreal "\nEnter Offset")) ;original line
(setq ofdst 0) ;edited line
       (if ofdst
       (progn
(setq pt1 (nth 0 rtpts))
(setq pt3 (nth 1 rtpts))
(setq pt1 (polar (polar pt1 (angtof "90" 0) ofdst) (angtof "180" 0) ofdst))
(setq pt3 (polar (polar pt3 (angtof "0" 0) ofdst) (angtof "270" 0) ofdst))
(command "rectangle" pt1 pt3)
       );_progn
         );_if
     );_progn
   );_if
 );_defun

 

 

 

I merged the code in the link into tbltoex.

It would be nice if I could handle properly😅

With bounding boxes, I think the first box would be unnecessary, but it was difficult to decipher it.

 

this is temporary function for my works (to export rotated call outs)

tbltoextest command.

select range of texts

then lisp will make box of those texts

292195444_2021-12-28165159.PNG.f555d991ad4578da8ed1ba9bed14a9d8.PNG

select again same range (for use same function module)

when excel processing is done,

2114753774_2021-12-28165450.thumb.PNG.74d46bdaa5e5d864afb4303c8cf4b6a7.PNG

input space bar in CAD to delete boxes.

 

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