天正标注水平垂直免点鼠标

forestgxc

直接附代码，不接受任何批评，老原则：
肯定有人会说这玩意，有啥鸟用！！！！



(defun C:DD (/ *error* pt1 pt2 choice input)
  (vl-load-com)

  ;; 定义错误处理函数
  (defun *error* (msg)
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ "\n")
      (princ "\n操作已取消"))
    (princ)
  )

  ;; 初始化选项，允许 H V D
  (initget "H V D")
  ;; 获取起点或选项
  (setq input (getpoint "\n起点或 [水平标注H/垂直标注V/逐点标注D]<逐点标注D>: "))
  (cond
    ;; 返回点坐标，默认为 D
    ((listp input) (setq pt1 input choice "D"))
    ;; 返回选项字符串
    ((member input '("H" "V" "D")) (setq choice input))
    ;; 回车或取消，默认 D
    (t (setq choice "D"))
  )

  ;; 如果未获取 pt1，提示输入起点
  (while (not pt1)
    (setq pt1 (getpoint "\n起点: "))
    (if (not pt1) (princ "\n请选取起点或取消操作。"))
  )

  ;; 获取第二点
  (setq pt2 (getpoint pt1 "\n第二点: "))
  (while (not pt2)
    (setq pt2 (getpoint pt1 "\n第二点: "))
    (if (not pt2) (princ "\n请选取第二点或取消操作。"))
  )

  ;; 根据选项调整 pt2 坐标
  (cond
    ((= choice "H") (setq pt2 (list (car pt2) (cadr pt1) (caddr pt2))))
    ((= choice "V") (setq pt2 (list (car pt1) (cadr pt2) (caddr pt2))))
    ((= choice "D") pt2)
  )

  ;; 调用天正标注命令
  (command-s "TDIMMP" pt1 pt2)

  ;; 清理错误处理
  (*error* nil)
  (princ)
)

e2002

不接受任何批评？
不理解你为什么每个帖子都要来这么一句，是要立什么人设吗？

实际上就是大神，有时候也难免代码中有考虑不周的地方，需要不断的改进、去除bug，有的bug可能都需要在多年以后才暴露出来。

就你的上面的代码，实话实说，其中存在很多问题（自己去找，不提示了）。

虚心使人进步。

forestgxc

(defun C:DD (/ *error* pt1 pt2 choice input dx dy)
  (vl-load-com)

  ;; 定义错误处理函数
  (defun *error* (msg)
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (if msg
      (princ (strcat "\n错误: " msg))
      (princ "\n操作已取消"))
    )
    (princ)
  )

  ;; 初始化选项，仅允许 D（逐点标注）
  (initget "D")
  ;; 获取起点或选项
  (setq input (getpoint "\n起点或 [逐点标注D]<自动水平/垂直>: "))
  (cond
    ;; 返回点坐标，默认自动水平/垂直
    ((listp input) (setq pt1 input choice nil))
    ;; 返回选项字符串
    ((= input "D") (setq choice "D"))
    ;; 回车或取消，默认自动水平/垂直
    (t (setq choice nil))
  )

  ;; 如果未获取 pt1，提示输入起点
  (while (not pt1)
    (setq pt1 (getpoint "\n起点: "))
    (if (not pt1) (princ "\n请选取起点或取消操作。"))
  )

  ;; 获取第二点
  (setq pt2 (getpoint pt1 "\n第二点: "))
  (while (not pt2)
    (setq pt2 (getpoint pt1 "\n第二点: "))
    (if (not pt2) (princ "\n请选取第二点或取消操作。"))
  )

  ;; 根据选项调整 pt2 坐标
  (cond
    ;; 逐点标注，直接使用 pt2
    ((= choice "D")
     (setq pt2 pt2))
    ;; 自动水平/垂直判断
    (t
     ;; 计算 X 和 Y 坐标差值
     (setq dx (abs (- (car pt2) (car pt1)))
           dy (abs (- (cadr pt2) (cadr pt1))))
     (if (> dx dy)
       ;; 水平标注，调整 pt2 的 Y 坐标与 pt1 相同
       (progn
         (setq pt2 (list (car pt2) (cadr pt1) (caddr pt2)))
         (princ "\n水平标注"))
       ;; 垂直标注，调整 pt2 的 X 坐标与 pt1 相同
       (progn
         (setq pt2 (list (car pt1) (cadr pt2) (caddr pt2)))
         (princ "\n垂直标注"))
     )
    )
  )

  ;; 调用天正标注命令
  (command-s "TDIMMP" pt1 pt2)

  ;; 清理错误处理
  (*error* nil)
  (princ)
)

e2002

forestgxc 发表于 2025-6-17 08:19
大神，我想请教下，现在的程序逻辑，是比较水平差和垂直点差，确定水平和垂直，
有没有可能像dimlinear ...

我可不是大神啊。

AlignedDimension 的尺寸延伸线长度显然是一致的，不需要调整。
只有 RotatedDimension 才有这个问题。

如果希望选择的一批 RotatedDimension 对象的尺寸延伸线调整为长度一致（可能就是追求整齐美观，有点强迫症吧），以前也写了这个调整尺寸线/尺寸延伸线位置的工具。

tranque

我弥陀佛，戒骄戒躁

429014673

TDIMMP天正的这个命令都非常好用了，还有必要这样吗

王二麻子

不接受批评

forestgxc

TDIMMP也就是因为必须用他，但他又连基本的水平垂直都还要手动，程序员也不知道干嘛想的

应该是可以自动水平垂直，再改改就是了

forestgxc

只是简简单单的分享，而已，没有人设，只是好玩
看有没有可能遇到同样会感兴趣的人，而已

forestgxc

e2002 发表于 2025-6-16 09:47
不接受任何批评？
不理解你为什么每个帖子都要来这么一句，是要立什么人设吗？

大神，我想请教下，现在的程序逻辑，是比较水平差和垂直点差，确定水平和垂直，
有没有可能像dimlinear一样，真正的想水平就水平，想垂直就垂直，算法上现在有问题
我也只能再选两点后就调用标注程序，才能预览