wanhongron 发表于 2025-9-6 16:20:12

提升累加测距程序

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

xyp1964 发表于 2025-9-6 18:06:44

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

;; 累加测距
(defun c:tt ()
(defun abc (pt tx / th)
    (setq th   (* (getvar "viewsize") 0.05))
    (entmakex
      (list '(0 . "TEXT")
            '(100 . "AcDbText")
            (cons 10 pt)
            (cons 40 th)
            (cons 1 tx)
            '(50 . 0.0)
            (cons 11 pt)
            (cons 7 (getvar 'textstyle))
            '(41 . 0.7)
            '(51 . 0.0)
            '(71 . 0)
            '(72 . 1)
            '(100 . "AcDbText")
            '(73 . 2)
      )
    )
)
(princ "累加测距...")
(setq os (getvar "osmode"))
(setvar "osmode" 16319)
(if (setq p1 (getpoint "\n测距起点: "))
    (progn
      (setq dd0
            n11
            msg (strcat "\n下一点...")
            txy (abc p1 "累距:0")
      )
      (while (and p1 (setq p2 (getpoint p1 msg)))
      (entdel txy)
      (grdraw p1 p2 1 1)
      (setq p1(list (car p1) (cadr p1))
            p2(list (car p2) (cadr p2))
            dd(+ dd (distance p1 p2))
            xy(strcat "\nX 增量 = "
                        (rtos (- (car p2) (car p1)) 2 3)
                        "，Y 增量 = "
                        (rtos (- (cadr p2) (cadr p1)) 2 3)
                  )
            n1(1+ n1)
            msg (strcat "\n共" (itoa n1) "点累距: " (rtos dd 2 3))
            tx(strcat (itoa n1) "点：总距离" (rtos dd 2 3))
            txy (abc p2 tx)
            p1p2
      )
      (princ xy)
      )
      (entdel txy)
    )
)
(setvar "osmode" os)
(princ)
)

zmzk 发表于 2025-9-6 17:44:34

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

wanhongron 发表于 2025-9-7 09:49:51

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

wanhongron 发表于 2025-9-7 10:21:38

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

wanhongron 发表于 2025-9-7 10:23:50

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

bai2000 发表于 2025-9-7 10:39:17

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

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

统一网名 发表于 2025-9-8 08:16:22

本帖最后由 统一网名 于 2025-9-8 08:17 编辑

wanhongron 发表于 2025-9-7 10:23
有时又太大，能够自动适应屏幕，就是正常看的舒服就行了
(setq ztgd (* (getvar "viewsize") 0.03))
获取当前视图高度（viewsize 系统变量），并将其乘以 0.03 作为文字高度，0.03也可以重新设置

sachindkini 发表于 2025-9-8 20:48:17

check aatched file

xyp1964 发表于 2025-9-10 14:43:36

(defun abc (pt tx / th)
    (setq th   (* (getvar "viewsize") 0.05))
    (entmakex
      (list '(0 . "TEXT")
            '(100 . "AcDbText")
            (cons 10 pt)
            (cons 40 th)
            (cons 1 tx)
            '(50 . 0.0)
            (cons 11 pt)
            (cons 7 (getvar 'textstyle))
            '(41 . 0.7)
            '(51 . 0.0)
            '(71 . 0)
            '(72 . 1)
            '(100 . "AcDbText")
            '(73 . 2)
      )
    )
)
页: [1]
查看完整版本: 提升累加测距程序