JONTHEPOPE 发表于 2022-7-6 17:25:46

文本分隔符

希望将过时的LISP更改为多行文字
而不是打破一个盒子
我需要一个图案填充/图像来隐藏它下面的内容。
 

(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" PT1ANG 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

JONTHEPOPE 发表于 2022-7-6 17:53:27

这可能会有所帮助
如果程序指定了多行文字,而不是将3d块插入到它或某种区域下,该怎么办
这样行吗??

JONTHEPOPE 发表于 2022-7-6 18:22:30

我想我是有点含糊这里有一个更好的尝试,在我试图做什么。。。
 

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

BIGAL 发表于 2022-7-6 18:40:54

大写字母意味着你的叫喊
页: [1]
查看完整版本: 文本分隔符