Topic: text to table

[dussla]

hi freind
again i have a question sorry~ always

that is text to table
table is  line  only  no  autocad table object
because i use  autocad 2004 only

is there good lisp ~

[rlxozzang]

Under Options, select E ​​to select a rectangular box, upper left, lower right, after the same interval as vertical alignment!
my routine is ~~

Code: [Select]

;;--------------------=={ Align Text }==----------------------;;
;thanks Lee-Mac & PTE:
(defun c:AlignText ( / ss d h h` f objs c plst sp grr g1 g2 lst len p i ii iii k n u a X_dist point_dist
center Hor_dist Ver_dist msg
LM:startundo
LM:endundo
*error*
LM:GetTextBox
PTE:sortobj
KT:ss->objs
KT:ChangeAlignmentText
)


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

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

    (defun *error* ( msg )
        (if d (LM:endundo d))
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix )
  ;; ?Lee Mac 2010

  (setq dx (lambda ( x l ) (cdr (assoc x l))))

  (if
(setq lst
  (cond
(
  (member (dx 0 (setq l (entget ent))) '("TEXT" "ATTRIB"))

  (setq base (dx 10 l) rotn (dx 50 l))

  (
(lambda ( data )
  (mapcar
(function
  (lambda ( funcs )
(mapcar
  (function
(lambda ( func )
  ((eval (car func)) ((eval (cdr func)) data) off)
)
  )
  funcs
)
  )
)
(list
  (list (cons '- 'caar ) (cons '- 'cadar ))
  (list (cons '+ 'caadr) (cons '- 'cadar ))
  (list (cons '+ 'caadr) (cons '+ 'cadadr))
  (list (cons '- 'caar ) (cons '+ 'cadadr))
)
  )
)
(textbox l)
  )
)
(
  (eq "MTEXT" (dx 0 l))

  (setq norm (dx 210 l) base (trans (dx 10 l) 0 norm)

rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm))

w (dx 42 l) h (dx 43 l)
  )
  (
(lambda ( org )
  (mapcar
(function
  (lambda ( o ) (mapcar '+ org o))
)
(list
  (list (-   off) (-   off))
  (list (+ w off) (-   off))
  (list (+ w off) (+ h off))
  (list (-   off) (+ h off))
)
  )
)
(
  (lambda ( j )
(list
  (cond
(
  (member j '(2 5 8)) (/ w -2.)
)
(
  (member j '(3 6 9)) (- w)
)
( 0. )
  )
  (cond
(
  (member j '(1 2 3)) (- h)
)
(
  (member j '(4 5 6)) (/ h -2.)
)
( 0. )
  )
)
)
(dx 71 l)
   )
)
   )
)
   )
(progn
  (setq matrix
(list
   (list (cos rotn) (sin (- rotn)) 0.)
   (list (sin rotn) (cos    rotn)  0.)
   (list     0.           0.       1.)
)
  )

  (mapcar
(function
  (lambda ( point )
(mapcar '+
  (mapcar
(function
  (lambda ( r ) (apply '+ (mapcar '* r point)))
)
matrix
  )
  (reverse (cdr (reverse base)))
)
  )
)
lst
  )
)
  )
)

(defun PTE:sortobj

( olst typ tol /
typ objs opt npt lst data lst rev sx sy dxf x y
PTE:s1 PTE:s2 PTE:s3 PTE:s4
)
       
        (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
        (defun sx  (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
        (defun sy  (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
        (defun dxf (o c)  (cdr  (assoc c (entget (vlax-vla-object->ename o)))))
        (defun x   (o)    (car  (dxf o 10)))
        (defun y   (o)    (cadr (dxf o 10)))
       
        (setq typ (vl-string->list (strcase typ)))
       
        (if (member (car typ) '(76 82))
            (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
            (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
        )
       
        (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
       
        (foreach o objs
            (if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
                (setq lst  (cons data lst) data (list o) opt npt)
                (setq data (cons o data))
            )
        )
       
        (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
              lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
              lst (if (member (car typ)  '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
              lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
        )
    )

(defun KT:ss->objs (ss)
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)

(defun KT:ChangeAlignmentText ( objs lst s dis arr count / KT:pt->center p1 p2)
(defun KT:pt->center (p1 p2)
(mapcar '(lambda (a b)(* (+ a b) 0.5))p1 p2)
)
(if (and (eq a 2)(eq center nil))
(progn
(setq p1    (getpoint "\nSpecify point : ")
  p2 (getpoint p1 "\nSecond point : ")
)
(setq center (KT:pt->center p1 p2))
(setq Hor_dist (abs (car  (mapcar '- p1 p2))));(distance (list(car p1) 0.)(list (car p2) 0.)))
(setq Ver_dist (abs (cadr (mapcar '- p1 p2))));(distance (list 0. (cadr p1))(list 0. (cadr p2))))
(prompt msg)
)
)
; (setq center nil H_dist nil V_dist nil)
(mapcar '(lambda (o l count)
(if (eq a 2)
(vla-put-Alignment o 10)
(vla-put-Alignment o arr)
)
(vlax-put o 'TextAlignmentPoint
(trans
(cond
( (eq a 0)
(list(+ (car s) dis)(cadr l))
)
( (eq a 1)
(list(+ (car s) dis)(- (cadr s)(* f count)))
)
( (eq a 2)
(list (+ (car center)(* Hor_dist u)) (- (cadr center)(* Ver_dist count)))
)
( (eq a 3)
(list(+(car g2) dis)(- (cadr g2)(-(cadr s)(cadr l))));grread좌표
)
)
1 0
)
)
)
objs lst count
)
)

;Main~~~
    (if (setq ss (KT:ss->objs (ssget "_:L" '((0 . "TEXT")))))
        (progn
(setq d (vla-get-activedocument (vlax-get-acad-object)))
(setq i 0 k 0 n 0 u 0 a 0 X_dist '(0.) ii '() iii nil)
(setq h (car (vl-sort (mapcar 'vla-get-height ss) '>)))
; (setq msg "\n<Tap>:정렬위치, <P>:삽입점 변경, <V>:수직정렬, <E>:등간격 정렬, <H>:수평정렬")
(setq msg "\n<Tap>:Alignment, <P>:Change InsertPoint, <V>:Vertical-align, <E>:Table-align, <H>:Horizontal-align")
;;;;;;;;;;;;;;;;
(setq f (* h 1.5))
(setq objs (PTE:sortobj ss "drd" h))
(setq c (length objs))

(foreach n (mapcar '(lambda (x) (length x)) objs)
(repeat n (setq ii (cons (rem i n) ii)) (setq i (1+ i)))
(setq iii (cons (reverse ii) iii))
(setq i 0 ii nil)
)

;;;;;;;;;;;;;;;;
(repeat c
(setq Plst
(cons
(mapcar
'(lambda (x)
(vlax-get x 'InsertionPoint)
  )
(nth n objs)
)
Plst
)
)
(setq n (1+ n))
)(setq Plst (reverse Plst) n 0)
;;;;;;;;;;;;;;;;
(setq sp (mapcar 'car Plst))
(repeat (1- c)
(setq X_dist
(cons
(- (car (nth (1+ k) sp))(car (car sp)))
X_dist
)
)
(setq k (1+ k))
)(setq X_dist (reverse X_dist))
;;;;;;;;;;;;;;;;
(prompt msg)
;Grread Start~~~~
            (LM:startundo d)
(while
(progn
(setq grr (grread t 15 0) g1 (car grr) g2 (cadr grr))

(cond
(   (= g1 5) (redraw)
(repeat c
(KT:ChangeAlignmentText
(nth u objs)   ;객체 리스트
(nth 0 plst)   ;객체좌표 리스트
(nth 0 sp)     ;리스트별 첫번째 객체 좌표
(nth u X_dist) ;X 좌표 간격
(+ i 12)
(nth u iii)    ;Y 좌표 수량
)
(setq u (1+ u))
)
(setq u 0)
t
)

(   (and (= g1 2) (= g2 9)) ;tap
(setq i (rem (setq i (+ i 1)) 3) u 0)
)

(   (and (= g1 2) (or (= g2 118)(= g2 86))) ;V
(setq a (rem (setq a (+ a 1)) 2) u 0)
)

(   (and (= g1 2) (or (= g2 101)(= g2 69))) ;E
(setq a 2)
)

(   (and (= g1 2) (or (= g2 112)(= g2 80))) ;P
(setq a 3) ;(rem (setq n (+ n 1)) 2) u 0)
)


(  (and (= g1 2) (or (= g2 104)(= g2 72))) ;H
(foreach o (apply 'append objs)
(setq lst (LM:GetTextBox (vlax-vla-object->ename o) 0))
(setq len (+ (fix (- (caadr lst) (caar lst))) 1))
(if (eq p nil)
(setq p (polar (getpoint "\nSpecify point : ") 0 (+ f len)))
(setq p (polar p 0 (+ f len)))
)
(vlax-put o 'Alignment acAlignmentBottomRight)
(vlax-put o 'TextAlignmentPoint (trans p 1 0)) ;(trans p 1 0)은 절대좌표계로 리턴... (trans p 0 1)은 상대좌표..
)
)

( (or (= g1 3) (member (cadr grr) '(0 13 32))) nil)

(t)
)
)
)

            (LM:endundo d)
)
    )
    (princ)
)

(vl-load-com)


[dussla]

thank you for good lisp
but  wanted work is to  text  to table make  in autocad 2004
if i select  txt ,  txt  is converted table line
~~

[rlxozzang]

thank you for good lisp
but  wanted work is to  text  to table make  in autocad 2004
if i select  txt ,  txt  is converted table line
~~

I'm sorry.Only former AutoCAD 2012 Mechanical I have

[parktaeeun]

Code - Auto/Visual Lisp: [Select]

1.  
2. ;;--------------------`' Move To Center Text '`-----------------------;;
3. ;;                                                                    ;;
4. ;;  Description                                                       ;;
5. ;;--------------------------------------------------------------------;;
6. ;;  Author :                                                          ;;
7. ;;      - PTE LISP co.                                                ;;
8. ;;      - arin9916@naver.com                                          ;;
9. ;;      - http://cafe.naver.com/ptelisp                               ;;
10. ;;--------------------------------------------------------------------;;
11. ;;  Version                                                           ;;
12. ;;    - 1.0 : Design & Created                             (12/08/12) ;;
13. ;;    - 1.1 : Change sortObj Function                      (12/08/01) ;;
14. ;;--------------------------------------------------------------------;;
15. ;;  Associated function :                                             ;;
16. ;;        HUE:start                                                   ;;
17. ;;        HUE:end                                                     ;;
18. ;;        HUE:objects                                                 ;;
19. ;;        HUE:sortObj                                                 ;;
20. ;;--------------------------------------------------------------------;;
21. (defun c:crr
22.    
23.     ( /  objs p1 p2 i j h w pt p
24.        
25.         PTE:sortobj  
26.         PTE:start
27.         PTE:end
28.         PTE:ss->obj
29.        
30.         _calp
31.     )
32.  
33.     ;-------------------------------------------------------------------------
34.     ; Sub Function
35.     ;-------------------------------------------------------------------------
36.     (defun PTE:sortobj
37.    
38.         (   olst typ tol /
39.             typ objs opt npt lst data lst rev sx sy dxf x y
40.             PTE:s1 PTE:s2 PTE:s3 PTE:s4
41.         )
42.        
43.         (defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
44.         (defun sx  (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
45.         (defun sy  (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
46.         (defun dxf (o c)  (cdr  (assoc c (entget (vlax-vla-object->ename o)))))
47.         (defun x   (o)    (car  (trans (dxf o 10) (dxf o 210) 0)))
48.         (defun y   (o)    (cadr (trans (dxf o 10) (dxf o 210) 0)))
49.        
50.         (setq typ (vl-string->list (strcase typ)))
51.        
52.         (if (member (car typ) '(76 82)) ; R or L
53.             (setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
54.             (setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
55.         )
56.        
57.         (setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
58.         (foreach o objs
59.             (if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
60.                 (setq lst  (cons data lst) data (list o) opt npt)
61.                 (setq data (cons o data))
62.             )
63.         )
64.        
65.         (setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
66.               lst (if (member (cadr typ) '(85 82)) (reverse lst) lst) ; U or R
67.               lst (if (member (car typ)  '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst) ; D or L
68.               lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
69.         )
70.     )
71.    
72.     ;-------------------------------------------------------------------------
73.     ; Sub Function
74.     ;-------------------------------------------------------------------------
75.     (defun PTE:start( lst )
76.         (vla-startundomark (PTE:end nil))
77.         (list lst (mapcar 'getvar lst))
78.     )
79.  
80.     ;-------------------------------------------------------------------------
81.     ; Sub Function
82.     ;-------------------------------------------------------------------------
83.     (defun PTE:end ( d / doc )
84.         (setq doc (vla-get-activedocument (vlax-get-acad-object)))
85.         (and (cadr d) (mapcar 'setvar (car d) (cadr d)))
86.         (and (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark doc)) doc
87.     )
88.    
89.     ;-------------------------------------------------------------------------
90.     ; Sub Function
91.     ;-------------------------------------------------------------------------
92.     (defun PTE:ss->obj ( ss / i re )
93.         (if ss
94.             (repeat (setq i (sslength ss))
95.                 (setq re (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) re))
96.             )
97.         )
98.     )
99.  
100.     ;-------------------------------------------------------------------------
101.     ; Sub Function
102.     ;-------------------------------------------------------------------------
103.     (defun _calp ( p1 p2 )
104.         (list (min (car p1) (car p2)) (max (cadr p1) (cadr p2)))
105.     )
106.  
107.    
108.     ;==================================================================================
109.     ;    Main function
110.     ;==================================================================================
111.     (setq objs (PTE:ss->obj (ssget '((0 . "text,mtext"))))
112.           objs (PTE:sortobj objs "rdr" (car (vl-sort (mapcar 'vla-get-height objs) '<)))
113.           p1   (getpoint "\nSpecify point..")
114.           p2   (getcorner p1)
115.           OOv  (PTE:start nil)
116.           j    0
117.     )
118.    
119.    
120.     (foreach os objs
121.         (setq h  (/ (abs (cadr (mapcar '- p1 p2))) (length objs))
122.               w  (/ (abs (car  (mapcar '- p1 p2))) (length os))
123.               pt (mapcar '+ (_calp p1 p2) (list (- (* w 0.5)) (* h 0.5)))
124.               j  (1- j) i 1
125.         )
126.        
127.         (foreach o os
128.             (setq p (mapcar '+ pt (list (* w i) (* h j)))
129.                   i (+ 1 i)
130.             )
131.            
132.             (cond
133.                 (    (= (vla-get-objectname o) "AcDbText")
134.                     (vlax-put o 'Alignment 10)
135.                     (vlax-put o 'TextAlignmentPoint (trans p 1 0))
136.                 )
137.                 (    (= (vla-get-objectname o) "AcDbMText")
138.                     (vlax-put o 'AttachmentPoint 5)
139.                     (vlax-put o 'InsertionPoint (trans p 1 0))
140.                 )
141.             )
142.         )
143.     )(PTE:end OOv)(princ)
144. )(vl-load-com)
145.  
146.