Change routine to use a selection rather than an input.

[dlbsurveysuk]

Hi, I have the following lisp routine. Contained within it (at the end) is a function called "trimbox" that I want to extract as a stand alone routine that will work on a picked text string selection instead of an entered text string.

I don't really know what I'm doing...

I think the following line needs modifying? But I'm not sure...

(setq TEXTENT (entlast))

Thanks in advance

Quentin.

;TIP1222.LSP:     TB.LSP     Text Break     (c)1996, Yuqun Lian

;;; This routine writes a text string to the drawing and then breaks any
;;; lines, polylines, etc. that intersect an imaginary box around the text.
;;; The text is placed on the current layer using the current style. The
;;; default input and repeat capabilities of TB.LSP make multiple labeling
;;; very convenient.

;;; Yuqun Lian - SimpleCAD,  http://www.simplecad.com	    
;;; ------------------------------------------------------------------------
(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.25) ;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 "\nWritten by Yuqun Lian")
(princ "\nType TB to start") 
(princ); end tb.lsp


[TomBeauford]

This will convert it to Mtext and add background masking that prompts with a 1.1 offset but you can enter whatever value you want. No need to trim any lines.

http://forums.augi.com/showthread.php?77962-How-to-set-border-offset-factor-for-background-masking-M...

;| Turns Background mask on/off
 Set 'Border Offset Factor' to 1.15 & trim excess width.
 http://forums.augi.com/showthread.php?77962-How-to-set-border-offset-factor-for-background-masking-Mtext&p=1128420&viewfull=1#post1128420
 (load "BGtoggle.lsp") BGtoggle
   Macro: ^P(or C:BGtoggle (load "BGtoggle.lsp"));BGtoggle
   Command line: (load "BGtoggle.lsp") BGtoggle |;
(defun c:BGtoggle (/ ss1 num cnt get_dst BGoffSet obj ent data elist mtwidth)
  (setq ss1 (ssget '((0 . "mtext,text")))
        num (sslength ss1)
        cnt 0
  )
  (repeat num

    ;; alanjt edit BEGIN
    (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss1 cnt))))) "TEXT")
      (progn (command "_.txt2mtxt" ent "")
             (entmod (subst '(41 . 0.) (assoc 41 (setq data (entget (setq ent (entlast))))) data))
      )
    )
    ;; alanjt edit END

    (setq obj (vlax-ename->vla-object ent))
    (if (= (vlax-get-property obj 'BackgroundFill) :vlax-true)
      (vlax-put-property obj 'BackgroundFill :vlax-false)
      (progn
        (vlax-put-property obj 'BackgroundFill :vlax-true)
        (if (= get_dst BGoffSet nil)
		  (progn
			(or ·×BGoff×· (setq ·×BGoff×· 1.1))
			(setq get_dst (getreal (strcat"\nEnter Distance :<" (rtos ·×BGoff×·) "> ")))
			(if get_dst (setq ·×BGoff×· get_dst))
			(setq BGoffSet "T")
		  )
        )
        (setq ent   (vlax-vla-object->ename obj)
              elist (entget ent)
              elist (subst (cons 90 3)(assoc 90 elist) elist) ;Use drawing background color
;              elist (subst (cons 90 19)(assoc 90 elist) elist) ;Use drawing background color and add Frame
              elist (subst (cons 45 ·×BGoff×·) (assoc 45 elist) elist) ;Set 'Border Offset Factor'
              mtwidth (* (cdr (assoc 42 elist))1.015)
              elist (subst (cons 41 mtwidth)(assoc 41 elist) elist) ;Trim excess width
        )
        (entmod elist)
      ) ; progn
    )
    (setq cnt (1+ cnt))
  ) ; repeat
  (vl-cmdf "_draworder" ss1 "" "f")
  (princ)
)

[Sea-Haven]

I agree use mtext with mask, perhaps use * textht factor for the values of border offset etc. A bit quicker.

[ВeekeeCZ · Accepted solution]

(defun c:trimbox (/ TEXTENT TRIMFACT TB GAP FGAP LL UR TXTH
		  PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX)
  
  (setq TXTH (getvar "TEXTSIZE"))
  
  (if (setq s (ssget '((0 . "TEXT"))))
    (repeat (setq i (sslength s))
      (setq TEXTENT (ssname s (setq i (1- i))))
      ;(setq TEXTENT (entlast))
      (setq TRIMFACT 0.25) ;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

[dlbsurveysuk]

Hi BeekeeCZ

Thanks for helping again.

I just tried to run your updated version of trimbox and got -

error: bad argument type: numberp: nil

[dlbsurveysuk]

PS. This is after I select some text that is overwriting a couple of lines, and hit enter.

[ВeekeeCZ]

The code is updated. It was just the *TXTH variable definition missing.

[dlbsurveysuk]

Ah ok, thanks,

I'd actually tried editing the code myself using the (ssget '((0 . "TEXT"))) command before asking for help but kept getting errors.

Thanks again for the help.

[ВeekeeCZ]

HERE are more methods of how to work with selection sets. I prefer to use method 2a, or 2 if the order matters.

[TomBeauford]

Been 20+ years since using pre r14 text but just remembered there's an AutoCAD command TEXTMASK for that purpose.

[dlbsurveysuk]

Haha Thanks!

Been using Autocad for 20+ years (together with a selection of ancient Lisp routines). It's very easy to get stuck in your ways and fail to update on new commands etc.

Thanks, that's a very useful command that I should've known existed.

The above Lisp routine was a good exercise in coding but now somewhat redundant...

[ВeekeeCZ]

Been using ACAD.... whatever, not that long. Familiar with TEXTMASK, never used, never liked. Why I should fight with two objects over each other if it can simply use an MTEXT that has this as its property?!

So just curious, what is it that you don't like about MTEXT?

[dlbsurveysuk]

Ah ok, just investigated having MTEXT with the background mask property. I didn't know that existed either...

Very useful to know. I'll have to consider the now 3 different masking methods I have at my disposal, and decide which is best for my needs.

Having the MTEXT with it's own background mask property does seem to make the most sense.

Thanks.