[编程交流] 文本分隔符

 
(defun tberror (S)
 (if (/= S "Function cancelled")
   (princ (strcat "\nError: " S))
 )
 (setvar "CLAYER" TEMPLA)
 (setvar "BLIPMODE" TEMPBLIP)
 (setvar "OSMODE" TEMPOS)
 (setvar "CMDECHO" TEMPCMD)
 (setq *error* OLDERR)
 (princ)
) ;end tberror
(defun C:TB ( / TEMP FIRST TX ANG TEMPLA TEMPCMD TEMPBLIP
 TEMPOS TXTST TXTH)
 (setq OLDERR *error* 
 *error* TBERROR)
 (setq TEMPCMD (getvar "CMDECHO")
   TEMPLA  (getvar "CLAYER")
   TEMPBLIP (getvar "BLIPMODE")
   TEMPOS (getvar "OSMODE")
   TXTST (getvar "TEXTSTYLE")
 *TXTH (getvar "TEXTSIZE"))
 (setvar "CMDECHO" 0) 
 (setvar "BLIPMODE" 0)
 (setq TXTH (cdr (assoc 40 (tblsearch "style" TXTST)))) 
 (setq TEMP T)
 (setq FIRST T) 
 (while TEMP
   (setvar "OSMODE" 512)     
   (setq PT1 (getpoint "\nInsertion point for text: "))     
   (setvar "OSMODE" 0)
   (cond
     ((/= PT1 nil)
       (if FIRST
         (progn
           (if (= TXTH 0)
             (progn
               (princ "\nHeight <")
               (princ *TXTH)
               (setq H (getreal ">: "))
               (if (= H nil) (setq H *TXTH)(setq *TXTH H))
             ) 
           )
           (if (not *ANG)(setq *ANG 0))
           (princ "\nRotation angle <")
           (princ (* *ANG (/ 180 3.1415926)))
           (setq ANG (getangle PT1 ">: "))
           (if (not ANG)(setq ANG *ANG)(setq *ANG ANG))
           (setq ANG (* ANG (/ 180 3.1415926)))    
           (if (not *TEXT)(setq *TEXT "XXX"))
           (princ "\nText <")
           (princ *TEXT)
           (setq TX (getstring T ">: "))
           (if (= TX "") (setq TX *TEXT)(setq *TEXT TX))
         ) ;end progn
       ) ;end first
       (if (= TXTH 0)
         (command "text" "j" "mc" PT1 *TXTH ANG TX )
       (command "text" "j" "mc" PT1  ANG TX )) 
       (trimbox)
     ) ;end pt1
     ((null PT1)
     (setq TEMP nil))
   );end cond
   (setq FIRST nil)
 );end while
 (setvar "CLAYER" TEMPLA)
 (setvar "BLIPMODE" TEMPBLIP)
 (setvar "OSMODE" TEMPOS)
 (setvar "CMDECHO" TEMPCMD)
 (princ)
)      
(defun trimbox (/ TEXTENT TRIMFACT TB GAP FGAP LL UR 
 PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX)
 (setq TEXTENT (entlast))
 (setq TRIMFACT 0.5) ;trim gap and text height ratio  
 (command "ucs" "Entity" TEXTENT)
 (setq TB (textbox (list (cons -1 TEXTENT)))
   LL (car TB)
   UR (cadr TB)
 )
 (setq GAP (* *TXTH TRIMFACT))     
 (setq FGAP (* GAP 0.5))
 (setq PTB1 (list (- (car LL) GAP) (- (cadr LL) GAP))
   PTB3 (list (+ (car UR) GAP) (+ (cadr UR) GAP))
   PTB2 (list (car PTB3) (cadr PTB1))
   PTB4 (list (car PTB1) (cadr PTB3))
   PTF1 (list (- (car LL) FGAP) (- (cadr LL) FGAP))
   PTF3 (list (+ (car UR) FGAP) (+ (cadr UR) FGAP))
   PTF2 (list (car PTF3) (cadr PTF1))
   PTF4 (list (car PTF1) (cadr PTF3))
 )
 (command "pline" PTB1 PTB2 PTB3 PTB4 "c")
 (setq BX (entlast))
 (command "trim" BX "" "f" PTF1 PTF3 PTF4 PTF1 "" "")
 (entdel BX)
 (redraw TEXTENT)
 (command "ucs" "p")
 (princ)
) ;end trimbox
(princ "\nType TB to start") 
(princ); end tb.lsp

 
(DEFUN C:PT( / P1 P2 A)
(SETVAR "ORTHOMODE" 0)
(SETQ A "")
(SETQ P1(GETPOINT "\n1st point: ")
P2(GETPOINT P1 "\n2nd point: "))
(COMMAND "ZOOM" "W" P1 P2)
(WHILE (= A "")
(COMMAND "2D SOLID" "C" P1 P2 "" PAUSE "")
(COMMAND "ZOOM" "P")
(PRINC)
)