[编程交流] 文本修剪框需要帮助

 
;;; 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

;;; 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

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