[编程交流] 需要文字放置方面的帮助

(defun mip-text-entmake (txt pnt height rotation justification / ent_list)
 ;;; borrowed from ShaggyDoc
 ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
 (setq  ent_list (list  '(0 . "TEXT")
    '(100 . "AcDbEntity")
    '(100 . "AcDbText")
    (list 10 (car pnt) (cadr pnt) 0.0)
    (cons 1 txt)
    (cons 40 height)
    (cons 7 (getvar "TEXTSTYLE"))
    (if justification
      (cond
        ((= justification "C")
         '(72 . 1)
        )
        ((= justification "R")
         '(72 . 2)
        )
        ((= justification "A")
         '(72 . 3)
        )
        ((= justification "M")
         '(72 . 4)
        )
        ((= justification "F")
         '(72 . 5)
        )
        (t
         '(72 . 0)
        )
      ) ;_ end of cond
      '(72 . 0)
    ) ;_ end of if
    (cons 50 rotation)
    (list 11 (car pnt) (cadr pnt) 0.0)
    ) ;_ end of list
  ) ;_ end of setq
  (setq ent_list (entmakex ent_list))
)
(defun C:TEST (/ selobj #line)
 
(setq selobj (entsel))
 (setq #line (cdr (assoc 8 (entget (car selobj)))))
 (and
   (setq pt (getpoint "\nPick center text point: "))
   (setq pt (trans pt 1 0))
   (mip-text-entmake
     #line           ;;; text
      pt                   ;;; point
     (getvar "TEXTSIZE") ;;; heigth
     [color="red"]0[/color]                     ;;; rotation
     "C"                   ;;; justification
     )
   )
 )

(defun c:test2 ( / ang entity norm point ) (vl-load-com)
 (if
   (and (setq entity (entsel))
     (not
       (vl-catch-all-error-p
         (setq point
           (vl-catch-all-apply 'vlax-curve-getclosestpointto
             (list (car entity) (trans (cadr entity) 1 0))
           )
         )
       )
     )
   )
   (progn
     (setq entity (car entity)
           norm   (trans '(0. 0. 1.) 1 0 t)
     )
     (setq ang
       (angle '(0. 0. 0.)
         (trans
           (vlax-curve-getfirstderiv entity
             (vlax-curve-getparamatpoint entity point)
           )
           0 norm
         )
       )
     )
     (if (and (< (/ pi 2.) ang) (<= ang (/ (* 3. pi) 2.)))
       (setq ang (- ang pi))
     )
     (setq point (trans point 0 norm))
     (entmakex
       (list
         (cons 0 "TEXT")
         (cons 7  (getvar 'TEXTSTYLE))
         (cons 40 (getvar 'TEXTSIZE))
         (cons 10 point)
         (cons 11 point)
         (cons 1 (cdr (assoc 8 (entget entity))))
         (cons 50 ang)
         (cons 72 1)
         (cons 73 2)
         (cons 210 norm)
       )
     )
   )
 )
 (princ)
)

(defun C:test (/ p1 p2 angline)
(setq selobj (entget (entsel)))
(setq p1 (car (cdr (assoc 10 selobj))))
(setq p2 (car (cdr (assoc 11 selobj))))
(princ (angle p1 p2))
(princ)
)

4