网上下载了一个大侠的累加测距程序，很好用，美中不足的是不能像cad总原命令dist那样显示x、y坐标增量，如果增加这个功能就完全替代了cad的dist命令，麻烦哪位高手帮完善一下


网友答: 本帖最后由 xyp1964 于 2025-9-10 14:43 编辑

  1. ;; 累加测距
  2. (defun c:tt ()
  3.   (defun abc (pt tx / th)
  4.     (setq th   (* (getvar "viewsize") 0.05))
  5.     (entmakex
  6.       (list '(0 . "TEXT")
  7.             '(100 . "AcDbText")
  8.             (cons 10 pt)
  9.             (cons 40 th)
  10.             (cons 1 tx)
  11.             '(50 . 0.0)
  12.             (cons 11 pt)
  13.             (cons 7 (getvar 'textstyle))
  14.             '(41 . 0.7)
  15.             '(51 . 0.0)
  16.             '(71 . 0)
  17.             '(72 . 1)
  18.             '(100 . "AcDbText")
  19.             '(73 . 2)
  20.       )
  21.     )
  22.   )
  23.   (princ "累加测距...")
  24.   (setq os (getvar "osmode"))
  25.   (setvar "osmode" 16319)
  26.   (if (setq p1 (getpoint "\n测距起点: "))
  27.     (progn
  28.       (setq dd  0
  29.             n1  1
  30.             msg (strcat "\n下一点...")
  31.             txy (abc p1 "累距:0")
  32.       )
  33.       (while (and p1 (setq p2 (getpoint p1 msg)))
  34.         (entdel txy)
  35.         (grdraw p1 p2 1 1)
  36.         (setq p1  (list (car p1) (cadr p1))
  37.               p2  (list (car p2) (cadr p2))
  38.               dd  (+ dd (distance p1 p2))
  39.               xy  (strcat "\nX 增量 = "
  40.                           (rtos (- (car p2) (car p1)) 2 3)
  41.                           "，  Y 增量 = "
  42.                           (rtos (- (cadr p2) (cadr p1)) 2 3)
  43.                   )
  44.               n1  (1+ n1)
  45.               msg (strcat "\n共" (itoa n1) "点累距: " (rtos dd 2 3))
  46.               tx  (strcat (itoa n1) "点：总距离" (rtos dd 2 3))
  47.               txy (abc p2 tx)
  48.               p1  p2
  49.         )
  50.         (princ xy)
  51.       )
  52.       (entdel txy)
  53.     )
  54.   )
  55.   (setvar "osmode" os)
  56.   (princ)
  57. )


网友答: 加载后出现
累加测距...
测距0点:
; 错误: no function definition: CRETXT

网友答: @xyp1964，非常感谢院长出手相助，赠人玫瑰，手有余香

网友答: 还有个小小的请求，如果字高能按照屏幕的比例显示更好，就是按照什么时候都看得清楚，字有时太小还要滚鼠标放大不太方便

网友答: 有时又太大，能够自动适应屏幕，就是正常看的舒服就行了

网友答:
wanhongron 发表于 2025-9-7 10:23
有时又太大，能够自动适应屏幕，就是正常看的舒服就行了

院长的子函数ABC 改为你程序中的CRETXT子函数就行啊

网友答: 本帖最后由 统一网名 于 2025-9-8 08:17 编辑
wanhongron 发表于 2025-9-7 10:23
有时又太大，能够自动适应屏幕，就是正常看的舒服就行了

(setq ztgd (* (getvar "viewsize") 0.03))
[color=rgba(0, 0, 0, 0.85)]获取当前视图高度（viewsize[color=rgba(0, 0, 0, 0.85)] 系统变量），并将其乘以 0.03 作为文字高度，0.03也可以重新设置


网友答: check aatched file

网友答:
  1. (defun abc (pt tx / th)
  2.     (setq th   (* (getvar "viewsize") 0.05))
  3.     (entmakex
  4.       (list '(0 . "TEXT")
  5.             '(100 . "AcDbText")
  6.             (cons 10 pt)
  7.             (cons 40 th)
  8.             (cons 1 tx)
  9.             '(50 . 0.0)
  10.             (cons 11 pt)
  11.             (cons 7 (getvar 'textstyle))
  12.             '(41 . 0.7)
  13.             '(51 . 0.0)
  14.             '(71 . 0)
  15.             '(72 . 1)
  16.             '(100 . "AcDbText")
  17.             '(73 . 2)
  18.       )
  19.     )
  20.   )
  • 上一篇：视图切换功能(cad两个位置回来切换)
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025