关于动态引线坐标标注用户坐标与世界坐标的转换

努.力

自己学着拼了一个坐标标注的程序，核心代码都是从各位大神那里抄来的。也非常感谢各位大神的热心解答。现在有一个关于用户坐标与世界坐标之间转换的问题，不知道要怎么写，还望各位帮忙解惑
问题是这样的：当重设置坐标原点之后，产生的图元就会飞得很远，未从新设置原点前是正常的
当重新设置原点之后，不知道这段代码要怎么处理
(if (and (listp jp) (>= (car jp) (car pti))) (setq q 4 f 1)(setq q 6 f -1))
(setq p0 (mapcar '+ jp (list (*(*(i_zg 1)0.12)f) 0)) j0 (mapcar '+ jp (list (*(*(*(i_zg 1)0.24)f)-1) 0)) )




;————————————————————;————————————————————坐标标注
(vl-load-com)
(defun c:v(/ zuo_biao pt tc ss)
(defun zuo_biao(/ ss xf yf wz hj h) ;坐标标注
(setq tc "0标注")
;如果选中的是圆或圆弧，则自动移到圆心
(if (setq ss (ssget pt '((0 . "circle,arc"))) ) (setq pt (trans (cdr (assoc 10 (entget (ssname ss 0)) )) 0 1)) );trans坐标转换
(if (and (=(car pt)0) (=(cadr pt)0) )
(progn (princ (strcat "\n 请指定坐标原点 0 的位置：")) (i_yinxian pt "\\C6;0" tc "") )
(progn
(if (and (<(car pt)0) (<(cadr pt)0) ) (setq xf (if (<(car pt)0)"-" " ") yf (if (<(cadr pt)0) "-" " ") ) (setq xf "" yf "") )
(princ (strcat "\n 请指定 X"(strcat (rtos(car pt)2 2)) "   Y" (rtos(cadr pt)2 2)" 的文字位置："))
(setq hj (if (wcmatch (vlax-get-property(vlax-get-acad-object)'Path) "*AutoCAD*")"0.62" "0.7") );行距
;A1下标,把字母XY置于左中，hj行距，h1字母XY字高，\\P换行符
(setq h "0.55" wz (strcat "\\A1;\\pxsm" hj ";{\\H" h "x;\\C191;X}\\C53;" xf(rtos (abs (car pt))2 2) "\\P{\\H" h "x;\\C181;Y}\\C52;" yf(rtos (abs (cadr pt))2 2) ) )
(i_yinxian pt wz tc "");引线标注
) )
(princ))
;————————————————————
(if (setq pt (getpoint "\n 请指定坐标点(右键指定原点 0 的位置)："))
(progn
(zuo_biao) ;坐标标注
(while (setq pt (getpoint"\n 请指定坐标点：")) (zuo_biao) );坐标标注
)
(if (setq pt (getpoint "\n 请指定坐标原点 0 的位置："))
(progn
(if (setq ss (ssget pt '((0 . "point")))) (vl-cmdf "_.erase" ss ""))
(vl-cmdf "ucs" pt "" "_point" "non" '(0 0) "")
(princ "\n 请指定坐标原点 0 的位置：")
(i_yinxian pt "\\C6;0" tc "")
(while (setq pt (getpoint"\n 请指定坐标点：")) (zuo_biao) );坐标标注
) ) )
(setq pt nil ss nil)
(princ))
;————————————————————;————————————————————引线标注(i_yinxian 基点 内容 图层 字高)
(defun i_yinxian(pti wzi tci hi / *error* new_yx z j jp loop ja jp q f p0 j0)
;(defun *error*(msg)(entdel j)(entdel z)(setq loop nil j nil z nil)) ;出错处理
(defun new_yx(/ x);重新生成引线
(setq x (entlast))
(command "qleader" "non" pti jp "" "" wzi "" "chprop" (i_new_ss x) "" "P" "LA" tci "")
(entdel j)(entdel z)(setq loop nil j nil z nil x nil)
(setq x nil) )
;————————————————————
(if (or (not pti)(= pti "")) (setq pti (cadr(grread 3))) );基点
(if (or (not tci)(= tci "")) (setq tci (getvar "clayer")) );图层
(if (or (not hi)(= hi "")) (setq hi (i_zg 1)) );字高
(if (not wzi) (setq wzi ""));内容
(setq loop t)
(while loop
(setq ja (car (grread t)) jp (cadr (grread t)))
(cond
((= ja 5)
(if (and (listp jp) (>= (car jp) (car pti))) (setq q 4 f 1)(setq q 6 f -1))
(setq p0 (mapcar '+ jp (list (*(*(i_zg 1)0.12)f) 0)) j0 (mapcar '+ jp (list (*(*(*(i_zg 1)0.24)f)-1) 0)) )
(if j (entdel j))
(entmake (list '(0 . "leader")'(100 . "AcDbEntity")'(100 . "AcDbLeader")(cons 10 pti)(cons 10 j0)(cons 10 jp) ) )
(setq j (entlast)) (i_gjt j)
(if z (entdel z))
(entmake (list '(0 . "mtext")'(100 . "AcDbEntity")'(100 . "AcDbMText")(cons 7(getvar "textstyle"))(cons 8 tci)(cons 1 wzi)(cons 10 p0)(cons 40 hi)(cons 71 q)))
(setq z (entlast))
)
((= ja 3) (new_yx));左键
((or (= ja 2) (= ja 25)) (entdel j) (entdel z) (setq loop nil j nil z nil) );右键或键盘
);cond
);while
(princ))
;————————————————————;————————————————————改箭头大小(i_gjt ent)
(defun i_gjt(ent / dat ent)
(setq dat (list -3 (list "ACAD" '(1000 . "DSTYLE")'(1002 . "{")'(1070 . 41)(cons 1040 (*(i_zg 1)0.25))'(1002 . "}") ) ) )
;(setq ent (car (entsel "\n 请点选对象：")));(setq ent (ssname (ssget ":s")0));(setq ent (entlast))
(entmod (append (entget ent) (list dat)))
(princ))
;————————————————————;————————————————————获得当前标注字高(i_zg 1)
(defun i_zg(site / h j1 j2 j3) ;(i_zg 1) ;获得当前标注字高
(if (<= (getvar'dimscale)1) (setq h (getvar'dimtxt) ) (setq h (*(getvar'dimtxt) (getvar'dimscale)) ) )
(setq j1 (* h 1.8) j2 (* j1 0.685) j3 (* j2 1.922) ) ;标注尺寸线间距系数设置
(setvar "dimasz" (*(getvar "dimtxt") 0.25)) ;箭头大小
(setvar "dimgap" (*(getvar "dimtxt") 0.12)) ;文字与尺寸线的距离
(setvar "dimexe" (*(getvar "dimtxt") 0.15)) ;尺寸界限线超出尺寸线距离
(setvar "dimexo" (*(getvar "dimtxt") 0.2)) ;尺寸界限线起点偏移量
(nth (- site 1) (list h j1 j2 j3)) )
;————————————————————;————————————————————获取在图元 en 之后产生的选择集 i_new_ss
;获取在图元 en 之后产生的选择集 caoyin 2009-1-5 http://bbs.mjtd.com/thread-73098-1-1.html
(defun i_new_ss(en / ss) ;(setq x (entlast)) (if (i_new_ss x)  ) ;判断新图元
(if en (progn
(setq ss (ssadd)) ;建立空集
(while (setq en (entnext en)) ;当en后有对象时
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND"))) (ssadd en ss) ) ) ;把en后的对象加入到空集
(if (zerop (sslength ss)) (setq ss nil))
ss)
(ssget "x")
) )

liuhe

研究一下 trans

努.力

liuhe 发表于 2023-12-29 14:31
研究一下 trans

谢谢，我去看看

努.力

有点抽象，一时还理解不了，大神是否方便帮改一下呢

http://bbs.mjtd.com/forum.php?mo ... 3%BB%A7%D7%F8%B1%EA

http://bbs.mjtd.com/forum.php?mo ... 3%BB%A7%D7%F8%B1%EA

努.力

调成这样，但是在头一次设置0点标注的时候，箭头还是会跑很远，但是再次标0点又可以，请教一下大神们，这要怎么改？
(entmake (list '(0 . "leader")'(100 . "AcDbEntity")'(100 . "AcDbLeader")(cons 10 (trans pti 1 0))(cons 10 (trans j0 1 0))(cons 10 (trans jp 1 0)) ) )

zxmmelly

用户交互获取到的点都是UCS，CAD最终保存的点都是WCS。用trans把交互得到的点从ucs转为wcs