redraw table line for old table (texts and lines)

[exceed]

;; RETABLE - 2022.03.04 exceed
;; https://www.cadtutor.net/forum/topic/74577-redraw-table-line-for-old-table-texts-and-lines/

(defun C:RETABLE ( / *error* x_tol text_size_sample text_ss text_size y_tol text_ss_length text_ss_index text_data_list text_ent text_ent_name text_box text_box_min_x text_box_min_y text_box_max_x text_box_max_y text_data tdll tdllindex memory_min_x memory_min_y memory_max_x memory_max_y now_min_y now_max_y mid_y now_min_x now_max_x mid_y_stack mysl mysindex memory_mys filtered_mys now_mys gap_mys pt1 pt2 first_y last_y first_x mid_x_stack mid_x mxsl mxsindex memory_mxs filtered_mxs now_mxs gap_mxs mid_x_stack pt3 pt4 last_x )
    (LM:startundo (LM:acdoc))
    (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )


  (setq x_tol 0)
  (setq y_tol 0)
  (setq text_size 0)
  (setq text_ss_length 0)


  (princ "\n RETABLE - Select Texts to Remake Table Line")
  (setq text_ss (ssget ":L" '((0 . "*TEXT")) ) )

  (initget 4)
  (setq x_tol (getreal "\n Input X-axis tolerance < 0 >"))
  (if (= x_tol nil) (setq x_tol 0))

  (setq text_size_sample (entget (ssname text_ss 0)))
  (setq text_size (cdr (assoc 40 text_size_sample)))
  ;(princ "\n text_size - ")
  ;(princ text_size)
  (initget 4)
  (setq y_tol (getreal (strcat "\n Input Y-axis tolerance < " (vl-princ-to-string text_size) " >")))
  (if (= y_tol nil) (setq y_tol text_size))

  (setq text_ss_length (sslength text_ss))
  (setq text_ss_index 0)
  (setq text_data_list nil)
  (setq text_ent nil)
  
  (repeat text_ss_length
     (setq text_ent (entget (ssname text_ss text_ss_index)))
     (setq text_ent_name (cdr (assoc -1 text_ent)))
     (setq text_box (text-box-off text_ent 0))
     (setq text_box_min_x (car (car text_box)))
     (setq text_box_min_y (cadr (car text_box)))
     (setq text_box_max_x (car (caddr text_box)))
     (setq text_box_max_y (cadr (caddr text_box))) 
     (setq text_data (list text_box_min_x text_box_min_y text_box_max_x text_box_max_y)) ;text_ent_name))
     (setq text_data_list (cons text_data text_data_list))
     (setq text_ss_index (+ text_ss_index 1))
  )

  ;(princ text_data_list)

  (setq text_data_list (vl-sort text_data_list
                              (function
                                      (lambda (x1 x2)(< (cadr x1) (cadr x2)))
                              )
                        )
  )
 ;(princ "\n sorted by min_y list =")
 ;(princ text_data_list)

 (setq tdll (length text_data_list))
 (setq tdlindex 0)
 (setq memory_min_x (car (nth 0 text_data_list)))
 (setq memory_min_y (cadr (nth 0 text_data_list)))
 (setq memory_max_x (caddr (nth 0 text_data_list)))
 (setq memory_max_y (cadddr (nth 0 text_data_list)))
 (setq mid_y_stack nil)

 (repeat (- tdll 1)
   (setq now_min_y (cadr (nth tdlindex text_data_list)))
   (setq now_max_y (cadddr (nth tdlindex text_data_list)))
   (if (> now_min_y memory_max_y) 
      (progn 
        (setq mid_y (/ (+ now_min_y memory_max_y) 2))
        (setq memory_max_y now_max_y)
        (setq memory_min_y now_min_y)
      )
      (progn
        (setq memory_max_y now_max_y)
      )
   )

   ;(princ "\n mid_y : ")
   ;(princ mid_y)
   (setq mid_y_stack (cons mid_y mid_y_stack))

   (setq tdlindex (+ tdlindex 1))
 )

 (setq tdlindex 0)
 (repeat tdll
   (setq now_min_x (car (nth tdlindex text_data_list)))
   (setq now_max_x (caddr (nth tdlindex text_data_list)))
   (if (< now_min_x memory_min_x)
      (progn 
        (setq memory_min_x now_min_x)
      )
   )
   (if (> now_max_x memory_max_x)
      (progn 
        (setq memory_max_x now_max_x)
      )
   )  
   (setq tdlindex (+ tdlindex 1))
 )


 (setq mid_y_stack (LM:Unique mid_y_stack))

 (setq mid_y_stack (cdr (vl-sort mid_y_stack '<)))




   ;(princ "\n mid_y_stack : ")
   ;(princ mid_y_stack)

   (setq mysl (length mid_y_stack))
   (setq mysindex 1)
   (setq memory_mys (car mid_y_stack))
   (setq filtered_mys (list (car mid_y_stack)))

  (repeat (- mysl 1)
     (setq now_mys (nth mysindex mid_y_stack))
     (setq gap_mys (- now_mys memory_mys))
     ;(princ "\n gap_mys - ")
     ;(princ gap_mys)
     (if (> gap_mys y_tol)
       (setq filtered_mys (cons now_mys filtered_mys))
     )
     (setq memory_mys now_mys)
     (setq mysindex (+ mysindex 1))
   )

   (setq mid_y_stack (reverse filtered_mys))
   ;(princ "\n filtered mid_y_stack - ")
   ;(princ mid_y_stack)

   ;(princ "\n min_x : ")
   ;(princ memory_min_x)
   ;(princ "\n max_x : ")
   ;(princ memory_max_x)



  (setq last_x (+ memory_max_x (atoi (rtos (/ text_size 2) 2 0))) )


  (setq text_data_list (vl-sort text_data_list
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

 (setq memory_min_x (car (nth 0 text_data_list)))
 (setq first_x (- memory_min_x (atoi (rtos (/ text_size 2) 2 0))))



   (setq mysl (length mid_y_stack))
   (setq mysindex 0)
   (repeat mysl
     (setq pt1 (list first_x (nth mysindex mid_y_stack)))
     (setq pt2 (list last_x (nth mysindex mid_y_stack)))
     ;(princ "\n pt1 : ")
     ;(princ pt1)
     ;(princ "\n pt2 : ")
     ;(princ pt2)
     (entmake (list '(0 . "LINE")
                    (cons 10 pt1)
                    (cons 11 pt2)
              )
    )
 
     (setq mysindex (+ mysindex 1))
   )

   ;draw outline
   (setq first_y 0)
   (setq last_y 0)
   (setq first_y (+ (nth (- mysl 1) mid_y_stack) (- (nth (- mysl 1) mid_y_stack) (nth (- mysl 2) mid_y_stack)) ) )
   (setq last_y (- (car mid_y_stack) (- (cadr mid_y_stack) (car mid_y_stack)) ) )

   ;(princ "\n first_y : ")
   ;(princ first_y)

   ;(princ "\n last_y : ")
   ;(princ last_y)

   (entmake (list '(0 . "LINE")
                    (cons 10 (list first_x first_y))
                    (cons 11 (list last_x first_y))
              )
    )

   (entmake (list '(0 . "LINE")
                    (cons 10 (list first_x last_y))
                    (cons 11 (list last_x last_y))
              )
    )






;draw x line
 (setq tdlindex 0)
 (setq memory_max_x (caddr (nth 0 text_data_list)))
 (setq mid_x_stack '())

 (repeat (- tdll 1)
   (setq now_min_x (car (nth tdlindex text_data_list)))
   (setq now_max_x (caddr (nth tdlindex text_data_list)))
   (if (> now_min_x memory_max_x) 
      (progn 
        (setq mid_x (/ (+ now_min_x memory_max_x) 2))
        (setq memory_max_x now_max_x)
        (setq memory_min_x now_min_x)
      )
      (progn
        (setq memory_max_x now_max_x)
      )
   )
   ;(princ "\n mid_x : ")
   ;(princ mid_x)
   (setq mid_x_stack (cons mid_x mid_x_stack))
   (setq tdlindex (+ tdlindex 1))
 )

 (setq mid_x_stack (LM:Unique mid_x_stack))

 (setq mid_x_stack (cdr (vl-sort mid_x_stack '<)))
   ;(princ "\n mid_x_stack - ")
   ;(princ mid_x_stack)

   (setq mxsl (length mid_x_stack))
   (setq mxsindex 1)
   (setq memory_mxs (car mid_x_stack))
   (setq filtered_mxs (list (car mid_x_stack)))

   (repeat (- mxsl 1)
     (setq now_mxs (nth mxsindex mid_x_stack))
     (setq gap_mxs (- now_mxs memory_mxs))
     ;(princ "\n gap_mxs - ")
     ;(princ gap_mxs)
     (if (> gap_mxs x_tol)
       (setq filtered_mxs (cons now_mxs filtered_mxs))
     )
     (setq memory_mxs now_mxs)
     (setq mxsindex (+ mxsindex 1))
   )

   (setq mid_x_stack (reverse filtered_mxs))
   ;(princ "\n filtered mid_x_stack - ")
   ;(princ mid_x_stack)
   (setq mxsl (length mid_x_stack))
   (setq mxsindex 0)
   (repeat mxsl
     (setq pt3 (list (nth mxsindex mid_x_stack) last_y))
     (setq pt4 (list (nth mxsindex mid_x_stack) first_y))
     ;(princ "\n pt3 : ")
     ;(princ pt3)
     ;(princ "\n pt4 : ")
     ;(princ pt4)
     (entmake (list '(0 . "LINE")
                    (cons 10 pt3)
                    (cons 11 pt4)
              )
    )
 
     (setq mxsindex (+ mxsindex 1))
   )





   (entmake (list '(0 . "LINE")
                    (cons 10 (list first_x first_y ))
                    (cons 11 (list first_x last_y))
              )
    )

   (entmake (list '(0 . "LINE")
                    (cons 10 (list last_x first_y))
                    (cons 11 (list last_x last_y))
              )
    )






(princ "\n RETABLE - done.")
(LM:endundo (LM:acdoc))
(setvar "cmdecho" 1)
(princ)
)


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


 
;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.

(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)


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

 

redraw lines for texts, which are arranged like old-style tables with texts and lines.

this lisp can use when they are lost lines, or a part of the line is in the xref, or lost xref files or etc....

 

there are many Lisp, that turns old tables into tables

but generally for that lisp need these lines

or that ignores blank cells by outputting only the position of the text. 

 

this is not complete routine.

it may not calculate the left and right widths properly

but it can enough to use it for conversion lisp. i think

 

command : RETABLE

(minimum table size = 2 column x 3 row)

 

I used a text box to resolve the different alignment points.

and there may be texts with slightly different x values, slightly different y values,

or overlapping texts in real work, so I put a tolerance value that ignores them.

x tol - x length to ignore (default: 0)

y tol - y length to ignore (default: font size)

 

 

 

- different access.

I have been trying to compare the textbox and basepoint

to measure the max number of rows and columns.

and calculate which column is close to the empty cells.

but I still have a long way to go.

Edited March 4, 2022 by exceed