[编程交流] 将文本放置在直线或柱脚上

;;;Label storm pipe size  LPS 2010-02-04   
(defun c:lblstsize (/ ent midpt entname obj mid-param beg-pt end-pt ang ins-pt)
 (vl-load-com)
 (setq temperr *error*            
       *error* errortrap
       varlst '("cmdecho")
       oldvar (mapcar 'getvar varlst)
   )
 
 (setvar "cmdecho" 0)
(defun dtr (a) (* pi (/ a 180.0)))
(command "UCS" "W")
 (setq ent (entsel "\nSelect pipe: ")
   midpt (osnap (cadr ent) "mid")
       entname (car ent)
   obj (vlax-ename->vla-object entname)
   mid-param (vlax-curve-getParamAtPoint obj midpt)
   beg-pt (vlax-curve-getPointAtParam obj (fix mid-param))
   end-pt (vlax-curve-getPointAtParam  obj (1+ (fix mid-param)))
   ang (angle beg-pt end-pt))
   (if
     (and (> ang 1.74533) (< ang 4.53786))
     (setq ang (angle end-pt beg-pt))
          )
   
   (setq ins-pt (polar midpt (+ ang (/ pi 2)) (* (getvar "dimscale")0.125)))
   (if (not (tblsearch "layer" "st-txt"))
   (command "-layer" "m" "ST-TXT" "C" "130" "ST-TXT" ""))
  (entmakex
   (list
     (cons 0   "MTEXT")         
     (cons 100 "AcDbEntity")          
     (cons 100 "AcDbMText")
     (cons 8 "ST-TXT")
     (cons 10 ins-pt)        
     (cons 1 (getstring T "\nEnter Pipe size: "))
     (cons 71 5)
     (cons 50 ang)
     (cons 7 "Simplex")
     (cons 40 (* (getvar "dimscale") 0.1))
     )
   )
 (setvar "cmdecho" 1)
 (command "UCS" "P")
 (princ)
   );defun
(defun errortrap (msg)
 (if oldvar (mapcar 'setvar varlst oldvar))
   (setq *error* temperr)
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n<< Error: " msg " >>"))
     )
(princ)
)