X、Y坐标值交换小程序

yjwht · 发表于 2025-3-1 17:50:39

电缆线路设计时需要标名桩号，浩辰CAD2019标注坐标点非常方便。但有个问题，X、Y坐标的值在城建坐标系统中与CAD中是颠倒的：

CAD坐标与图纸坐标XY反着的原因是建筑坐标系和CAD坐标轴是相反的。
在数学中，平面直角坐标系以纵轴为y轴，自原点向上为正，向下为负；以横轴为x轴，自原点向右为正，向左为负；象限按逆时针方向编号。
而在测量上，平面直角坐标系以南北方向的纵轴为x轴，自原点向北为正，向南为负；以东西方向的横轴为y轴，自原点向东为正，向西为负；象限按顺时针方向编号。这种差异导致了在CAD中，如果使用的是测量坐标系，输入坐标时需要将原本的X和Y坐标值交换使用，即将数学坐标系中的X坐标作为建筑坐标系中的Y坐标，将数学坐标系中的Y坐标作为建筑坐标系中的X坐标。

我需手动调整一个个坐标值，以前也确实这么做的，现在终于可用刚学会一点的lisp知识解决这个问题了。请允许我得瑟1秒钟

;浩辰CAD中标注坐标不需解散组也可用该功能框选交换X、Y坐标值
(princ "X、Y坐标值交换程序加载成功，请输入yt_swap执行该命令...")
(defun c:yt_swap(/ text1 text2 str1 obj obj1 obj2 ss n i)
(prompt "请注意：每次只能框选一对坐标！")
(setq ss (ssget '((0 . "TEXT"))))
(setq n (sslength ss))
(setq i 0)
(while (< i n)
(setq obj (ssname ss i))
(cond ((= (substr (cdr (assoc 1 (entget obj))) 1 2) "X=")
(setq obj1 obj))
((= (substr (cdr (assoc 1 (entget obj))) 1 2) "Y=")
(setq obj2 obj)))
(setq i (1+ i))
)
(setq text1 (cdr (assoc 1 (entget obj1))))
(setq text1 (strcat "Y" (substr text1 2)))
(setq text2 (cdr (assoc 1 (entget obj2))))
(setq text2 (strcat "X" (substr text2 2)))
(setq str1 text1)
(entmod (subst (cons 1 Text2) (assoc 1 (entget obj1)) (entget obj1)))
(entmod (subst (cons 1 str1) (assoc 1 (entget obj2)) (entget obj2)))
(princ "\nX、Y坐标值交换成功！")
(princ)
)

xiao1984 · 发表于 2025-3-1 21:22:04

(defun c:tt (/ ss n i obj text x-list y-list x-value y-value x-obj y-obj x-pair y-pair)
  (prompt "\n请框选所有需要交换X、Y坐标值的标注点：")
  (setq ss (ssget '((0 . "TEXT"))))
  (if ss
(progn
   (setq n (sslength ss))
   (setq i 0)
   (setq x-list nil)
   (setq y-list nil)
   (while (< i n)
      (setq obj (ssname ss i))
      (setq text (cdr (assoc 1 (entget obj))))
      (if (and (>= (strlen text) 2)
(or (= (substr text 1 2) "X=") (= (substr text 1 2) "Y=")))
(progn
(if (= (substr text 1 1) "X")
(setq x-list (cons (list obj text) x-list))
(if (= (substr text 1 1) "Y")
(setq y-list (cons (list obj text) y-list))
)
)
)
      )
      (setq i (1+ i))
   )
   (if (and x-list y-list)
(progn
(while (and x-list y-list)
(setq x-pair (car x-list))
(setq y-pair (car y-list))
(setq x-obj (car x-pair))
(setq x-value (substr (cadr x-pair) 3))
(setq y-obj (car y-pair))
(setq y-value (substr (cadr y-pair) 3))
(entmod (subst (cons 1 (strcat "X=" y-value)) (assoc 1 (entget x-obj)) (entget x-obj)))
(entmod (subst (cons 1 (strcat "Y=" x-value)) (assoc 1 (entget y-obj)) (entget y-obj)))
(entupd x-obj)
(entupd y-obj)
(setq x-list (cdr x-list))
(setq y-list (cdr y-list))
)
(prompt "\n所有坐标点的X、Y坐标值已成功交换！")
)
(prompt "\n未找到匹配的X和Y坐标对！")
   )
)
(prompt "\n未选择任何对象！")
  )
  (princ)
)

xiao1984 · 发表于 2025-3-1 22:45:25

xiao1984 发表于 2025-3-1 21:22
(defun c:tt (/ ss n i obj text x-list y-list x-value y-value x-obj y-obj x-pair y-pair)
(prompt " ...

(defun c:hhzb (/ ss n i obj text x-list y-list x-value y-value x-obj y-obj x-pair y-pair)
  (prompt "\n请框选所有需要交换X、Y坐标值的标注点：")
  (setq ss (ssget '((0 . "TEXT"))))
  (if ss
(progn
   (setq n (sslength ss))
   (setq i 0)
   (setq x-list nil)
   (setq y-list nil)
   (while (< i n)
      (setq obj (ssname ss i))
      (setq text (cdr (assoc 1 (entget obj))))
      (if (and (>= (strlen text) 2)
               (or (= (substr text 1 2) "X=") (= (substr text 1 2) "Y=")))
      (progn
         (if (= (substr text 1 2) "X=")
            (setq x-list (cons (list obj text) x-list))
            (if (= (substr text 1 2) "Y=")
            (setq y-list (cons (list obj text) y-list))
            )
         )
      )
      )
      (setq i (1+ i))
   )
   (if (and x-list y-list)
      (progn
      (while (and x-list y-list)
         (setq x-pair (car x-list))
         (setq y-pair (car y-list))
         (setq x-obj (car x-pair))
         (setq x-value (substr (cadr x-pair) 3))
         (setq y-obj (car y-pair))
         (setq y-value (substr (cadr y-pair) 3))

         (setq x-ent (entget x-obj))
         (setq x-ent (subst (cons 1 (strcat "X=" y-value)) (assoc 1 x-ent) x-ent))
         (if (assoc 62 x-ent)
            (setq x-ent (subst (cons 62 1) (assoc 62 x-ent) x-ent))
            (setq x-ent (append x-ent (list (cons 62 1))))
         )
         (entmod x-ent)

         (setq y-ent (entget y-obj))
         (setq y-ent (subst (cons 1 (strcat "Y=" x-value)) (assoc 1 y-ent) y-ent))
         (if (assoc 62 y-ent)
            (setq y-ent (subst (cons 62 1) (assoc 62 y-ent) y-ent))
            (setq y-ent (append y-ent (list (cons 62 1))))
         )
         (entmod y-ent)

         (entupd x-obj)
         (entupd y-obj)
         (setq x-list (cdr x-list))
         (setq y-list (cdr y-list))
      )
      (prompt "\n所有坐标点的X、Y坐标值已成功交换并设置为红色！")
      )
      (prompt "\n未找到匹配的X和Y坐标对！")
   )
)
(prompt "\n未选择任何对象！")
  )
  (princ)
)

xyp1964 · 发表于 2025-3-1 20:55:05

(defun c:tt ()
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun SubUpd(e c v)(entmod(subst(cons c v)(assoc c(entget e))(entget e)))(entupd e))
(while (and (setq ss (ssget '((0 . "TEXT") (1 . "X=*,Y=*"))))
(= (sslength ss) 2)
)
(setq s1 (ssname ss 0)
s2 (ssname ss 1)
t1 (DXF 1 s1)
t1a (substr t1 1 2)
t1b (substr t1 3)
t2 (DXF 1 s2)
t2a (substr t2 1 2)
t2b (substr t2 3)
t1 (strcat t1a t2b)
t2 (strcat t2a t1b)
s1 (SubUpd s1 1 t1)
s2 (SubUpd s2 1 t2)
)
(command"chprop" ss """c" 1 "")
)
(princ)
)

cjf160204 · 发表于 2025-3-1 18:04:20

好麻烦，标注时候就xy反过来，标注好有这种太麻烦

你有种再说一遍 · 发表于 2025-3-1 18:22:45

如果图纸画得比较好,文字不重叠,
那么按照text的包围盒扩容一个距离,选取两个单行文字,
就可以批量交换了.
原本半小时的任务变成两秒钟...

yjwht · 发表于 2025-3-1 19:53:49

cjf160204 发表于 2025-3-1 18:04
好麻烦，标注时候就xy反过来，标注好有这种太麻烦

浩辰CAD标注的，它本身不会过来。

yjwht · 发表于 2025-3-1 20:19:03

你有种再说一遍发表于 2025-3-1 18:22
如果图纸画得比较好,文字不重叠,
那么按照text的包围盒扩容一个距离,选取两个单行文字,
就可以批量交换了 ...

一个电缆路径不到5km，需要标注的点30~50个，逐个修改工作量也不大。并且文字距离太近，还有其它内容的干扰，容易出错。

tanxindong · 发表于 2025-3-1 22:42:26

强

学习中

yjwht · 发表于 2025-3-2 08:02:32

xyp1964 发表于 2025-3-1 20:55

看懂了，内部定义dxf、SubUpd两个函数，使得主程序变得很简洁。一次还是选中一对坐标进行交换。多谢指导

账号		自动登录	找回密码
密码			注册

[源码] X、Y坐标值交换小程序

本帖子中包含更多资源