Jump to content
germslyde

Text trim box need help

Recommended Posts

germslyde

I have a lisp that is supposed to create a Polyline box around selected text, trim lines within the box, and then delete the box. I am, however, having some issues getting it to run properly. Everytime I run it, I select the text that I want to use, but I get an error

 

Select Text; error: bad DXF group: (-1 (13.3618 5.59898

0.0))

I am hoping that someone can help me out with this.

 

 
;;; This lisp routine creates a box around selected text, trims all entities within the box, and then deletes the box.

(defun C:TTR (/ TEXTENT TRIMFACT TB GAP FGAP LL UR 
 PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX)
 (setq TEXTENT (entsel "\nSelect Text"))
 (setq TRIMFACT 2.0) ;Set trim gap and text height ratio HERE
 (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 TTR to start") 
(princ); end TEXT TRIM.lsp

Thank you in advance for your help

Share this post


Link to post
Share on other sites
CALCAD

germslyde,

Made a few changes and additions. Seems to work. Could use some error trapping. Enjoy

 

;;; This lisp routine creates a box around selected text, trims all entities within the box, and then deletes the box.

(defun C:TTR (/ TEXTENT TRIMFACT TEXTLIST TB GAP FGAP LL UR 
 PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX *TXTH)
 ;(setq TEXTENT (entsel "\nSelect Text"))
 (setq TEXTENT (car (entsel "\nSelect Text"))) ; changed - added car to get name alone
 (setq TRIMFACT 1.0) ;Set trim gap and text height ratio HERE
 (command "ucs" "Entity" TEXTENT)
 (setq TEXTLIST (entget TEXTENT))          ; added to get entity record
 (setq *TXTH (cdr (assoc 40 TEXTLIST)))    ; added to get text height
 ;(setq TB (textbox (list (cons -1 TEXTENT)))
  ; LL (car TB)
  ; UR (cadr TB)
 
 (setq TB (textbox TEXTLIST)   ; changed
   LL (car TB)
   UR (cadr TB)  ; changed, was cdr
 )
 (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 TTR to start") 
(princ); end TEXT TRIM.lsp

Share this post


Link to post
Share on other sites
CALCAD

Here is the TTR program with error trapping and code added to save and restore the system state.

 

;;; This lisp routine creates a box around selected text, trims all 
;   entities within the box, and then deletes the box. 
; Modifications by CALCAD from original code by germslyde in the Cadtutor forum 

(defun C:TTR (/ *ERROR* CE TEXTENT TRIMFACT TEXTLIST TB GAP FGAP LL UR  
 PTB1 PTB2 PTB3 PTB4 PTF1 PTF2 PTF3 PTF4 BX *TXTH) 
  
 (defun *ERROR* (msg) 
 (command "_.ucs" "R" "sys_ucs") 
 (command "_.ucs" "D" "sys_ucs") 
 (setvar "cmdecho" CE) 
 (princ "\r") 
 (princ) 
 ) 
  
 (setq CE (getvar "cmdecho")) 
 (setvar "cmdecho" 0) 
 (command "_.ucs" "S" "sys_ucs") 
 (setq TEXTENT (car (entsel "\nSelect Text"))) 
 (setq TRIMFACT 2.0) ;Set trim gap and text height ratio HERE 
 (command "_.ucs" "Entity" TEXTENT) 
 (setq textlist (entget TEXTENT)) 
 (setq *TXTH (cdr (assoc 40 TEXTLIST))) 
 (setq TB (textbox TEXTLIST) 
   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" "R" "sys_ucs") 
 (command "_.ucs" "D" "sys_ucs") 
 (princ "\r") 
 (setvar "cmdecho" CE) 
 (princ) 
) ; end defun 
(princ "\nType TTR to start")  
(princ)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...