社区 › Auto Lisp › 文本修剪框需要帮助

germslyde 发表于 2022-7-6 10:35:18

文本修剪框需要帮助

我有一个lisp，它应该在选定文本周围创建一个多段线框，修剪框内的线，然后删除框。然而，我在让它正常运行时遇到了一些问题。每次我运行它时，我都会选择要使用的文本，但会出现错误
 
选择文本；错误：错误的DXF组：（-1（13.3618 5.59898
0.0))
我希望有人能帮我解决这个问题。
 

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

提前感谢您的帮助

CALCAD 发表于 2022-7-6 11:10:49

杰姆斯莱德，
进行了一些更改和添加。似乎有效。可能需要一些错误捕捉。享受
 
;;; 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

CALCAD 发表于 2022-7-6 11:45:19

这是TTR程序，其中添加了错误捕捉和代码，以保存和恢复系统状态。
 
;;; 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)

查看完整版本: 文本修剪框需要帮助