forestgxc 发表于 前天 10:54

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

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



(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)
)

tranque 发表于 前天 11:36

我弥陀佛，戒骄戒躁

429014673 发表于 前天 13:37

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

王二麻子 发表于 前天 15:29

不接受批评

forestgxc 发表于 前天 22:44


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

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

forestgxc 发表于 昨天 09:35

(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)
)

页: [1]
查看完整版本: 天正标注水平垂直免点鼠标