getpoint捕捉点的问题
本帖最后由 yu960312 于 2024-8-14 22:35 编辑视口缩放,视图高度变化会影响getpoint捕捉点位置变化,导致程序后续运行出错
求解惑
程序如下:
;;设置0位并标注
(defun C:SDD1 (/ pt ptex ptey ptx poty dis)
(DEFUN DXF (CODE ENAME / ENT LST A)
(if (= (TYPE CODE) 'LIST)
(PROGN (setq ENT (ENTGET ENAME))
(setq LST nil)
(FOREACH A CODE
(setq LST (CONS (LIST A (CDR (ASSOC A ENT))) LST))
)
(REVERSE LST)
)
(PROGN (if (= CODE -3)
(PROGN (CDR (ASSOC CODE (ENTGET ENAME '("*")))))
(PROGN (CDR (ASSOC CODE (ENTGET ENAME))))
)
)
)
)
(DEFUN XYP-SUBUPD (ENAME CODE VAL / ENT X Y I S1)
(COND
((= (TYPE ENAME) 'ENAME)
(setq ENT (ENTGET ENAME))
(if (AND (= (TYPE CODE) 'LIST) (= (TYPE VAL) 'LIST))
(PROGN
(MAPCAR '(LAMBDA (X Y) (XYP-SUBUPD ENAME X Y)) CODE VAL)
)
(PROGN
(if (= (DXF CODE ENAME) nil)
(PROGN (ENTMOD (APPEND ENT (LIST (CONS CODE VAL)))))
(PROGN (ENTMOD (SUBST (CONS CODE VAL) (ASSOC CODE ENT) ENT))
)
)
(ENTUPD ENAME)
)
)
)
((= (TYPE ENAME) 'PICKSET)
(setq I -1)
(while (and (setq S1 (SSNAME ENAME (setq I (1+ I)))))
(XYP-SUBUPD S1 CODE VAL)
)
)
((= (TYPE ENAME) 'LIST)
(FOREACH S1 ENAME (XYP-SUBUPD S1 CODE VAL))
)
)
ENAME
)
;;判断点2在点1的哪个象限
(defun quad (ptn1 ptn2 / qua)
(setq qua_ang(/ (* (angle ptn1 ptn2) 180.0) pi))
(cond
((and (>= qua_ang 0)(< qua_ang 90))(setq qua 1))
((and (>= qua_ang 90)(< qua_ang 180))(setq qua 2))
((and (>= qua_ang 180)(< qua_ang 270))(setq qua 3))
((and (>= qua_ang 270)(< qua_ang 360))(setq qua 4))
)
qua
)
(defun SD_SUB1()
(redraw)
(grdraw pt '(0 0) 1)
(setq disx (abs (car pt)))
(setq disy (abs (cadr pt)))
(setq quaa(quad '(0 0) pt))
(cond
((= quaa 1) ;第一象限
(setq ptx (trans (list disx 0) 1 0))
(setq pty (trans (list 0 disy) 1 0))
(xyp-subupd ex 14 pty)
(xyp-subupd ey 14 ptx)
)
((= quaa 2) ;第二象限
(setq ptx (trans (list (- disx) 0) 1 0))
(setq pty (trans (list 0 disy) 1 0))
(xyp-subupd ex 14 pty)
(xyp-subupd ey 14 ptx)
)
((= quaa 3) ;第三象限
(setq ptx (trans (list (- disx) 0) 1 0))
(setq pty (trans (list 0 (- disy)) 1 0))
(xyp-subupd ex 14 pty)
(xyp-subupd ey 14 ptx)
)
((= quaa 4) ;第四象限
(setq ptx (trans (list disx 0) 1 0))
(setq pty (trans (list 0 (- disy)) 1 0))
(xyp-subupd ex 14 pty)
(xyp-subupd ey 14 ptx)
)
)
)
(defun *error* (msg)
(if DIMDEC (setvar "DIMDEC" DIMDEC)(setvar "DIMDEC" 3))
(if ex (vl-cmdf "ERASE" ex ""))
(if ey (vl-cmdf "ERASE" ey ""))
(redraw)
)
(princ "\n功能: [点]坐标标注")
(setvar "cmdecho" 0)
(setvar "osmode" 16383)
(setq DIMDEC(getvar "DIMDEC"))
(if (null *dec*)(setq *dec* 3))
(setq dec(getint (strcat "\n请输入坐标标注精度(0-8):<" (rtos *dec* 2 0) ">")))
(if (null dec)(setq dec *dec*)(setq *dec* dec))
(setvar "DIMDEC" dec)
(if (setq ptt (getpoint "\n指定点设置0位:"))
(progn
(vl-cmdf "ucs" "n" ptt)
(setq ex nil ey nil)
(vl-cmdf "_dimordinate" '(0 0) '(0 5))
(setq ex(entlast))
(vl-cmdf "_dimordinate" '(0 0) '(5 0))
(setq ey(entlast))
(princ"\n请选取适当的位置:")
(setq go T)
(while go
(setq ged (grreadT 4 0))
(setq pt(cadr ged))
(setq geds(car ged))
(cond
((= pt 32)(*error*))
((= geds 3)
(SD_SUB1)
(setq go nil)
)
((= geds 5)
(SD_SUB1)
)
)
)
(redraw)
)
)
(setvar "DIMDEC" DIMDEC)
(princ)
)
目测是捕捉的问题.关闭捕捉就好了. 黄翔 发表于 2024-8-14 09:25
目测是捕捉的问题.关闭捕捉就好了.
就是因为捕捉的问题,导致程序后续出错的
页:
[1]