X、Y坐标值交换小程序
电缆线路设计时需要标名桩号，浩辰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)
)
(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 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)
) (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)
) 好麻烦，标注时候就xy反过来，标注好有这种太麻烦 如果图纸画得比较好,文字不重叠,
那么按照text的包围盒扩容一个距离,选取两个单行文字,
就可以批量交换了.
原本半小时的任务变成两秒钟... cjf160204 发表于 2025-3-1 18:04
好麻烦，标注时候就xy反过来，标注好有这种太麻烦
浩辰CAD标注的，它本身不会过来。 你有种再说一遍 发表于 2025-3-1 18:22
如果图纸画得比较好,文字不重叠,
那么按照text的包围盒扩容一个距离,选取两个单行文字,
就可以批量交换了 ...
一个电缆路径不到5km，需要标注的点30~50个，逐个修改工作量也不大。并且文字距离太近，还有其它内容的干扰，容易出错。 :hug:强:lol学习中 xyp1964 发表于 2025-3-1 20:55
看懂了，内部定义dxf、SubUpd两个函数，使得主程序变得很简洁。一次还是选中一对坐标进行交换。多谢指导
页:
[1]
2