Prikazi cijelu temu 21.09.2010 22:57
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Korisni lispovi
Trim do teksta.
PreuzmiIzvorni kôd (Lisp):
  1. ;TIP1222.LSP:     TB.LSP     Text Break     (c)1996, Yuqun Lian;;; This routine writes a text string to the drawing and then breaks any
  2. ;;; lines, polylines, etc. that intersect an imaginary box around the text.
  3. ;;; The text is placed on the current layer using the current style. The
  4. ;;; default input and repeat capabilities of TB.LSP make multiple labeling
  5. ;;; very convenient.;;; Yuqun Lian - SimpleCAD    
  6. ;;; ------------------------------------------------------------------------
  7. (defun tberror (S)
  8.   (if (/= S "Function cancelled")
  9.     (princ (strcat "\nError: " S))
  10.   )
  11.   (setvar "CLAYER" TEMPLA)
  12.   (setvar "BLIPMODE" TEMPBLIP)
  13.   (setvar "OSMODE" TEMPOS)
  14.   (setvar "CMDECHO" TEMPCMD)
  15.   (setq *error* OLDERR)
  16.   (princ)
  17. ) ;end tberror(defun C:TB ( / TEMP FIRST TX ANG TEMPLA TEMPCMD TEMPBLIP
  18.   TEMPOS TXTST TXTH)
  19.   (setq OLDERR *error*
  20.   *error* TBERROR)
  21.   (setq TEMPCMD (getvar "CMDECHO")
  22.     TEMPLA  (getvar "CLAYER")
  23.     TEMPBLIP (getvar "BLIPMODE")
  24.     TEMPOS (getvar "OSMODE")
  25.     TXTST (getvar "TEXTSTYLE")
  26.   *TXTH (getvar "TEXTSIZE"))
  27.   (setvar "CMDECHO" 0)
  28.   (setvar "BLIPMODE" 0)
  29.   (setq TXTH (cdr (assoc 40 (tblsearch "style" TXTST))))   (setq TEMP T)
  30.   (setq FIRST T)
  31.   (while TEMP
  32.     (setvar "OSMODE" 512)    
  33.     (setq PT1 (getpoint "\nInsertion point for text: "))    
  34.     (setvar "OSMODE" 0)
  35.     (cond
  36.       ((/= PT1 nil)
  37.         (if FIRST
  38.           (progn            (if (= TXTH 0)
  39.               (progn
  40.                 (princ "\nHeight <")
  41.                 (princ *TXTH)
  42.                 (setq H (getreal ">: "))
  43.                 (if (= H nil) (setq H *TXTH)(setq *TXTH H))
  44.               )
  45.             )            (if (not *ANG)(setq *ANG 0))
  46.             (princ "\nRotation angle <")
  47.             (princ (* *ANG (/ 180 3.1415926)))
  48.             (setq ANG (getangle PT1 ">: "))
  49.             (if (not ANG)(setq ANG *ANG)(setq *ANG ANG))
  50.             (setq ANG (* ANG (/ 180 3.1415926)))                (if (not *TEXT)(setq *TEXT "XXX"))
  51.             (princ "\nText <")
  52.             (princ *TEXT)
  53.             (setq TX (getstring T ">: "))
  54.             (if (= TX "") (setq TX *TEXT)(setq *TEXT TX))
  55.           ) ;end progn
  56.         ) ;end first        (if (= TXTH 0)
  57.           (command "text" "j" "mc" PT1 *TXTH ANG TX )
  58.         (command "text" "j" "mc" PT1  ANG TX ))
  59.         (trimbox)
  60.       ) ;end pt1      ((null PT1)
  61.       (setq TEMP nil))    );end cond
  62.     (setq FIRST nil)
  63.   );end while  (setvar "CLAYER" TEMPLA)
  64.   (setvar "BLIPMODE" TEMPBLIP)
  65.   (setvar "OSMODE" TEMPOS)
  66.   (setvar "CMDECHO" TEMPCMD)
  67.   (princ)
  68. )      (defun trimbox (/ TEXTENT TRIMFACT TB GAP FGAP LL UR
  69.   PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX)
  70.   (setq TEXTENT (entlast))
  71.   (setq TRIMFACT 0.5) ;trim gap and text height ratio  
  72.   (command "ucs" "Entity" TEXTENT)
  73.   (setq TB (textbox (list (cons -1 TEXTENT)))
  74.     LL (car TB)
  75.     UR (cadr TB)
  76.   )
  77.   (setq GAP (* *TXTH TRIMFACT))    
  78.   (setq FGAP (* GAP 0.5))
  79.   (setq PTB1 (list (- (car LL) GAP) (- (cadr LL) GAP))
  80.     PTB3 (list (+ (car UR) GAP) (+ (cadr UR) GAP))
  81.     PTB2 (list (car PTB3) (cadr PTB1))
  82.     PTB4 (list (car PTB1) (cadr PTB3))
  83.     PTF1 (list (- (car LL) FGAP) (- (cadr LL) FGAP))
  84.     PTF3 (list (+ (car UR) FGAP) (+ (cadr UR) FGAP))
  85.     PTF2 (list (car PTF3) (cadr PTF1))
  86.     PTF4 (list (car PTF1) (cadr PTF3))
  87.   )
  88.   (command "pline" PTB1 PTB2 PTB3 PTB4 "c")
  89.   (setq BX (entlast))
  90.   (command "trim" BX "" "f" PTF1 PTF3 PTF4 PTF1 "" "")
  91.   (entdel BX)
  92.   (redraw TEXTENT)
  93.   (command "ucs" "p")
  94.   (princ)
  95. ) ;end trimbox(princ "\nWritten by Yuqun Lian")
  96. (princ "\nType TB to start")
  97. (princ); end tb.lsp
  98. 
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.
Ovaj post je ureden 2 puta. Posljednja izmjena 19.10.2010 03:19 od strane zxz.