CAD 二次开发应用 获取统计单行字体内的特定数据

应用场景:获取autoCAD中多个单行字体的特定符号前数据,连乘求和

工具

autolisp

主要代码

(defun c:CountTextNums (/ ss i ent txt val sum)
  (setq sum 0)
  (prompt "\n请选择包含文本的单行文字对象...")

  (setq ss (ssget '((0 . "TEXT"))))
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (entget (ssname ss i)))
        (setq txt (cdr (assoc 1 ent))) ; 提取文字内容
        (setq val (process-text-fixed txt))
        (setq sum (+ sum val))
        (setq i (1+ i))
      )
      (prompt (strcat "\n所有文本计算结果之和为: " (rtos sum 2 0)))
    )
    (prompt "\n未选择任何文本对象。")
  )
  (princ)
)

(defun process-text-fixed (txt / pos num-a num-b num-c)
  ;; === 1. 提取“台”前的连续数字 ===
  (setq pos (vl-string-position (ascii "台") txt))
  (if pos
    (setq num-a (extract-number-before txt pos))
    (setq num-a 1.0)
  )

  ;; === 2. 提取“x”或“×”前的连续数字(支持普通x和乘号×)===
  (setq pos nil)
  (setq idx 0)
  (while (< idx (strlen txt))
    (setq char (substr txt (1+ idx) 1))
    (if (or (= (ascii char) 120)   ; 小写 x
            (= (ascii char) 88)    ; 大写 X
            (= (ascii char) 215)   ; 特殊乘号 ×
        )
      (setq pos idx) ; 记录最后出现的位置
    )
    (setq idx (1+ idx))
  )

  (if pos
    (setq num-b (extract-number-before txt pos))
    (setq num-b 1.0)
  )

  ;; === 3. 提取“L”前的连续数字 ===
  (setq pos (vl-string-position (ascii "L") txt))
  (if pos
    (setq num-c (extract-number-before txt pos))
    (setq num-c 1.0)
  )

  (* num-a num-b num-c) ; 返回三数相乘
)

(defun extract-number-before (txt pos / str-backward char lst-num)
  ;; 从位置 pos 向前提取紧邻的连续数字(只取紧挨前面的部分)
  (setq str-backward (substr txt 1 pos)) ; 截取到该位置之前的字符串
  (setq lst-num '())
  
  ;; 从后往前逐字符判断是否为数字
  (while (and (/= str-backward "")
              (setq char (substr str-backward (strlen str-backward) 1))
              (wcmatch char "#"))
    (setq lst-num (cons char lst-num))
    (setq str-backward (substr str-backward 1 (1- (strlen str-backward))))
  )

  ;; 若提取到数字,则转为实数;否则返回 1.0
  (if lst-num
    (atof (apply 'strcat lst-num))
    1.0
  )
)

  

 

posted @ 2025-11-27 23:05  灬Tyrion灬  阅读(6)  评论(0)    收藏  举报