[LISP-LEEMAC] 박스문자 (포스트아이디 : 1136679728372577421)

;; 출 처 : http://www.lee-mac.com/boxtext.html
;; 제 목 : Box Text
;; 버 전 : V1.0
;; 명령어 : BoxText / BT
 ;;


;;-----------------------=={ Box Text }==---------------------;;
;;                                                            ;;
;;  Frames Text or MText objects with an LWPolyline, with     ;;
;;  optional offset. Works in all UCS/Views.                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:BT nil (c:BoxText))

(defun c:BoxText nil
  ;; ?Lee Mac 2010

  (
    (lambda ( ss off i / e )
      (if ss
        (while (setq e (ssname ss (setq i (1+ i))))
          (entmakex
            (append
              (list
                (cons 0 "LWPOLYLINE")
                (cons 100 "AcDbEntity")
                (cons 100 "AcDbPolyline")
                (assoc 8 (entget e))
                (cons 90 4)
                (cons 70 1)
                (cons 38 (caddr (cdr (assoc 10 (entget e)))))
                (assoc 210 (entget e))
              )
              (mapcar '(lambda ( x ) (cons 10 x)) (LM:GetTextBox e off))
            )
          )
        )
      )
    )
    (ssget '((0 . "TEXT,MTEXT")))
    (setq *o*
      (cond
        (
          (getdist
            (strcat "\nSpecify Offset <"
              (rtos
                (setq *o*
                  (cond ( *o* ) ( (* 0.5 (getvar 'TEXTSIZE)) ))
                )
              )
              "> : "
            )
          )
        )
        ( *o* )
      )
    )
    -1
  )

  (princ)
)

;;---------------------=={ Get Text Box }==-------------------;;
;;                                                            ;;
;;  Returns a point list describing a rectangle framing the   ;;
;;  specified text or mtext entity with optional offset       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ent - Text or MText ename                                 ;;
;;  off - offset (may be zero)                                ;;
;;------------------------------------------------------------;;
;;  Returns:  List of Points (in OCS) describing text frame   ;;
;;------------------------------------------------------------;;

(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
        (
          (eq "TEXT" (dx 0 (setq l (entget ent))))

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