min-pt max-pt min-cen max-cen min-rad max-rad ht old-clr
filtered-txt filter)
(setq old-clr (getvar 'cecolor))
;;; 正确修复前缀输入空格问题 - 使用 getstring 的 allow-spaces 参数
(setq prefix (getstring T "\nEnter text prefix (press Enter for all text): "))
;;; 构建选择集过滤器
(if (= prefix "")
(setq filter '((0 . "TEXT"))) ; 如果前缀为空，选择所有文本
(setq filter (list '(0 . "TEXT") (cons 1 (strcat prefix "*")))) ; 只选择符合前缀的文本
)
(if (setq ss (ssget filter)) ; 使用过滤器选择文本
(progn
(setq i 0 txt-list '())
(repeat (sslength ss)
(setq ent (ssname ss i)
txt (cdr (assoc 1 (entget ent)))
ht (cdr (assoc 40 (entget ent)))
filtered-txt txt) ; 初始化为原始文本
;;; 处理前缀 - 如果前缀不为空，去掉前缀
(if (/= prefix "")
(setq filtered-txt (substr txt (+ (strlen prefix) 1)))
)
;;; 尝试转换为数字
(setq num (distof filtered-txt))
;;; 如果转换失败，尝试去掉可能的前导空格
(if (not num)
(setq num (distof (vl-string-trim " " filtered-txt)))
)
;;; 如果成功转换为数字，添加到列表
(if num
(setq txt-list (cons (list num ent txt ht) txt-list))
)
(setq i (1+ i))
)
(if txt-list
(progn
(setq sorted (vl-sort txt-list '(lambda (x y) (< (car x) (car y))))
min-ent (cadar sorted)
max-ent (cadr (last sorted))
min-ht (cadddr (car sorted))
max-ht (cadddr (last sorted)))
;;; 处理最小值文本 - 用绿色圈
(vla-getboundingbox (vlax-ename->vla-object min-ent) 'min-pt 'max-pt)
(setq min-pt (vlax-safearray->list min-pt)
max-pt (vlax-safearray->list max-pt)
min-cen (mapcar '(lambda (a b) (* (+ a b) 0.5)) min-pt max-pt)
min-rad (+ (* (distance min-pt max-pt) 0.5) (* min-ht 0.5)))
;;; 处理最大值文本 - 用红色圈
(vla-getboundingbox (vlax-ename->vla-object max-ent) 'min-pt 'max-pt)
(setq min-pt (vlax-safearray->list min-pt)
max-pt (vlax-safearray->list max-pt)
max-cen (mapcar '(lambda (a b) (* (+ a b) 0.5)) min-pt max-pt)
max-rad (+ (* (distance min-pt max-pt) 0.5) (* max-ht 0.5)))
;;; 绘制圆圈 - 最小值用绿色，最大值用红色
(setvar 'cecolor "3") ; 绿色 - 最小值
(command "_.circle" min-cen min-rad)
(setvar 'cecolor "1") ; 红色 - 最大值
(command "_.circle" max-cen max-rad)
;;; 显示结果
(princ (strcat "\nMin value: " (caddr (car sorted))
"Max value: " (caddr (last sorted))))
(princ (strcat "\nNumeric range: " (rtos (caar sorted))
" - " (rtos (car (last sorted)))))
)
(princ "\nNo valid numeric text found!")
)
)
(princ "\nNo text objects selected!")
)
(setvar 'cecolor old-clr)
(princ)
) dmxcs 发表于 2025-11-8 10:36
(defun c:tt22 (/ prefix ss i ent txt num txt-list sorted min-ent max-ent
min-pt max ...
可以输入指定前缀
页:
1
[2]