动态字宽

183017064

潘成祥2015 发表于 2023-11-13 17:30
如果也能输入值就好了

加了输入值

(defun c:zkk(/ EN ENTDATA ANG PTS PTE DIS1 GR P1 PT_FZ P2 DIS2 FLAG ZK ZK_FLAG wdl_wzboxdown new_zk)
  ;; 提取包容盒底部2点坐标
  (defun wdl_wzboxdown(en / END PTS ANG ZG PT LENTXT PTE)
    (setq end (entget en))
    (setq pts (cdr (assoc 10 end)))
    (setq ang (cdr (assoc 50 end)))
    (setq zg (cdr (assoc 40 end)))
    (setq pt (textbox end))   
    (setq lentxt (caadr pt))
    (setq pte (polar pts ang lentxt))
    (list pts pte)
  )
  
  ;; main
  (setq en (car(entsel)))
  (setq entdata (entget en))
  (if (wcmatch (cdr(assoc 0 entdata)) "TEXT")
    (progn
      (setq ang (cdr (assoc 50 entdata))) ; 文字转角
      (setq pts (car (wdl_wzboxdown en))) ; 文字起点
      (setq pte (cadr (wdl_wzboxdown en))) ; 文字终点
      (setq dis1 (distance pts pte)) ; 文字宽度
      (setq zk (cdr (assoc 41 entdata))) ; 原宽度因子
      
      (princ "\n拖动鼠标调整或按[Enter]输入数值: ")
      (while (setq gr (grread t 12 0)) ; 允许混合输入模式
        (cond
          ;; 鼠标拖动模式
          ((= (car gr) 5)
            (setq p1 (cadr gr))
            (setq pt_fz (polar p1 (+ ang (/ pi 2)) 1))
            (setq p2 (inters p1 pt_fz pts pte nil))
            (setq dis2 (distance pts p2))
            (redraw) ; 清空临时图形
            (grdraw p1 p2 3 1) ; 绘制动态引导线
            (setq flag (/ dis2 dis1))
            (setq zk_flag (* zk flag))
            (princ (strcat "\r当前宽度因子: " (rtos zk_flag 2 2))) ; 动态显示数值
            (entmod (subst (cons 41 zk_flag) (assoc 41 entdata) entdata)) ; 实时更新
          )
         
          ;; 键盘输入模式
          ((= (car gr) 2)
            (if (= (cadr gr) 13) ; 检测回车键
              (progn
                (initget 1) ; 禁止空输入
                (setq new_zk (getreal (strcat "\n输入新宽度因子 <" (rtos zk_flag 2 2) ">: "))) ; 带默认值的输入提示
                (if new_zk
                  (progn
                    (entmod (subst (cons 41 new_zk) (assoc 41 entdata) entdata)) ; 应用输入值
                    (setq zk_flag new_zk) ; 更新当前值
                  )
                )
                (exit) ; 退出循环
              )
            )
          )
         
          ;; 退出条件（左键/右键点击）
          ((or (= (car gr) 3) (= (car gr) 25)) (exit))
        )
      )
    )
    (princ "\n错误：请选择文字对象！")
  )
  (princ)
)[/code]