getpoint捕捉点的问题

yu960312

视口缩放,视图高度变化会影响getpoint捕捉点位置变化,导致程序后续运行出错
求解惑

程序如下:
;;设置0位并标注

1. (defun C:SDD1 (/ pt ptex ptey ptx poty dis)
   
2. (DEFUN DXF (CODE ENAME / ENT LST A)
   
3. (if (= (TYPE CODE) 'LIST)
   
4. (PROGN (setq ENT (ENTGET ENAME))
   
5. (setq LST nil)
   
6. (FOREACH A CODE
   
7. (setq LST (CONS (LIST A (CDR (ASSOC A ENT))) LST))
   
8. )
   
9. (REVERSE LST)
   
10. )
    
11. (PROGN (if (= CODE -3)
    
12. (PROGN (CDR (ASSOC CODE (ENTGET ENAME '("*")))))
    
13. (PROGN (CDR (ASSOC CODE (ENTGET ENAME))))
    
14. )
    
15. )
    
16. )
    
17. )
    
18. (DEFUN XYP-SUBUPD (ENAME CODE VAL / ENT X Y I S1)
    
19. (COND
    
20. ((= (TYPE ENAME) 'ENAME)
    
21. (setq ENT (ENTGET ENAME))
    
22. (if (AND (= (TYPE CODE) 'LIST) (= (TYPE VAL) 'LIST))
    
23. (PROGN
    
24. (MAPCAR '(LAMBDA (X Y) (XYP-SUBUPD ENAME X Y)) CODE VAL)
    
25. )
    
26. (PROGN
    
27. (if (= (DXF CODE ENAME) nil)
    
28. (PROGN (ENTMOD (APPEND ENT (LIST (CONS CODE VAL)))))
    
29. (PROGN (ENTMOD (SUBST (CONS CODE VAL) (ASSOC CODE ENT) ENT))
    
30. )
    
31. )
    
32. (ENTUPD ENAME)
    
33. )
    
34. )
    
35. )
    
36. ((= (TYPE ENAME) 'PICKSET)
    
37. (setq I -1)
    
38. (while (and (setq S1 (SSNAME ENAME (setq I (1+ I)))))
    
39. (XYP-SUBUPD S1 CODE VAL)
    
40. )
    
41. )
    
42. ((= (TYPE ENAME) 'LIST)
    
43. (FOREACH S1 ENAME (XYP-SUBUPD S1 CODE VAL))
    
44. )
    
45. )
    
46. ENAME
    
47. )
    
48. ;;判断点2在点1的哪个象限
    
49. (defun quad (ptn1 ptn2 / qua)
    
50. (setq qua_ang(/ (* (angle ptn1 ptn2) 180.0) pi))
    
51. (cond
    
52. ((and (>= qua_ang 0)(< qua_ang 90))(setq qua 1))
    
53. ((and (>= qua_ang 90)(< qua_ang 180))(setq qua 2))
    
54. ((and (>= qua_ang 180)(< qua_ang 270))(setq qua 3))
    
55. ((and (>= qua_ang 270)(< qua_ang 360))(setq qua 4))
    
56. )
    
57. qua
    
58. )
    
59. (defun SD_SUB1()
    
60. (redraw)
    
61. (grdraw pt '(0 0) 1)
    
62. (setq disx (abs (car pt)))
    
63. (setq disy (abs (cadr pt)))
    
64. (setq quaa(quad '(0 0) pt))
    
65. (cond
    
66. ((= quaa 1) ;第一象限
    
67. (setq ptx (trans (list disx 0) 1 0))
    
68. (setq pty (trans (list 0 disy) 1 0))
    
69. (xyp-subupd ex 14 pty)
    
70. (xyp-subupd ey 14 ptx)
    
71. )
    
72. ((= quaa 2) ;第二象限
    
73. (setq ptx (trans (list (- disx) 0) 1 0))
    
74. (setq pty (trans (list 0 disy) 1 0))
    
75. (xyp-subupd ex 14 pty)
    
76. (xyp-subupd ey 14 ptx)
    
77. )
    
78. ((= quaa 3) ;第三象限
    
79. (setq ptx (trans (list (- disx) 0) 1 0))
    
80. (setq pty (trans (list 0 (- disy)) 1 0))
    
81. (xyp-subupd ex 14 pty)
    
82. (xyp-subupd ey 14 ptx)
    
83. )
    
84. ((= quaa 4) ;第四象限
    
85. (setq ptx (trans (list disx 0) 1 0))
    
86. (setq pty (trans (list 0 (- disy)) 1 0))
    
87. (xyp-subupd ex 14 pty)
    
88. (xyp-subupd ey 14 ptx)
    
89. )
    
90. )
    
91. )
    
92. (defun *error* (msg)
    
93. (if DIMDEC (setvar "DIMDEC" DIMDEC)(setvar "DIMDEC" 3))
    
94. (if ex (vl-cmdf "ERASE" ex ""))
    
95. (if ey (vl-cmdf "ERASE" ey ""))
    
96. (redraw)
    
97. )
    
98. (princ "\n功能: [点]坐标标注")
    
99. (setvar "cmdecho" 0)
    
100. (setvar "osmode" 16383)
     
101. (setq DIMDEC(getvar "DIMDEC"))
     
102. (if (null *dec*)(setq *dec* 3))
     
103. (setq dec(getint (strcat "\n请输入坐标标注精度(0-8):<" (rtos *dec* 2 0) ">")))
     
104. (if (null dec)(setq dec *dec*)(setq *dec* dec))
     
105. (setvar "DIMDEC" dec)
     
106. (if (setq ptt (getpoint "\n指定点设置0位:"))
     
107. (progn
     
108. (vl-cmdf "ucs" "n" ptt)
     
109. (setq ex nil ey nil)
     
110. (vl-cmdf "_dimordinate" '(0 0) '(0 5))
     
111. (setq ex(entlast))
     
112. (vl-cmdf "_dimordinate" '(0 0) '(5 0))
     
113. (setq ey(entlast))
     
114. (princ"\n请选取适当的位置:")
     
115. (setq go T)
     
116. (while go
     
117. (setq ged (grread  T 4 0))
     
118. (setq pt(cadr ged))
     
119. (setq geds(car ged))
     
120. (cond
     
121. ((= pt 32)(*error*))
     
122. ((= geds 3)
     
123. (SD_SUB1)
     
124. (setq go nil)
     
125. )
     
126. ((= geds 5)
     
127. (SD_SUB1)
     
128. )
     
129. )
     
130. )
     
131. (redraw)
     
132. )
     
133. )
     
134. (setvar "DIMDEC" DIMDEC)
     
135. (princ)
     
136. )
     

(defun C:SDD1 (/ pt ptex ptey ptx poty dis)<br /> (DEFUN DXF (CODE ENAME / ENT LST A)<br /> (if (= (TYPE CODE) 'LIST)<br /> (PROGN (setq ENT (ENTGET ENAME))<br /> (setq LST nil)<br /> (FOREACH A CODE<br /> (setq LST (CONS (LIST A (CDR (ASSOC A ENT))) LST))<br /> )<br /> (REVERSE LST)<br /> )<br /> (PROGN (if (= CODE -3)<br /> (PROGN (CDR (ASSOC CODE (ENTGET ENAME '("*")))))<br /> (PROGN (CDR (ASSOC CODE (ENTGET ENAME))))<br /> )<br /> )<br /> )<br /> )<br /> (DEFUN XYP-SUBUPD (ENAME CODE VAL / ENT X Y I S1)<br /> (COND<br /> ((= (TYPE ENAME) 'ENAME)<br /> (setq ENT (ENTGET ENAME))<br /> (if (AND (= (TYPE CODE) 'LIST) (= (TYPE VAL) 'LIST))<br /> (PROGN<br /> (MAPCAR '(LAMBDA (X Y) (XYP-SUBUPD ENAME X Y)) CODE VAL)<br /> )<br /> (PROGN<br /> (if (= (DXF CODE ENAME) nil)<br /> (PROGN (ENTMOD (APPEND ENT (LIST (CONS CODE VAL)))))<br /> (PROGN (ENTMOD (SUBST (CONS CODE VAL) (ASSOC CODE ENT) ENT))<br /> )<br /> )<br /> (ENTUPD ENAME)<br /> )<br /> )<br /> )<br /> ((= (TYPE ENAME) 'PICKSET)<br /> (setq I -1)<br /> (while (and (setq S1 (SSNAME ENAME (setq I (1+ I)))))<br /> (XYP-SUBUPD S1 CODE VAL)<br /> )<br /> )<br /> ((= (TYPE ENAME) 'LIST)<br /> (FOREACH S1 ENAME (XYP-SUBUPD S1 CODE VAL))<br /> )<br /> )<br /> ENAME<br /> )<br /> ;;判断点2在点1的哪个象限<br /> (defun quad (ptn1 ptn2 / qua)<br /> (setq qua_ang(/ (* (angle ptn1 ptn2) 180.0) pi))<br /> (cond<br /> ((and (>= qua_ang 0)(< qua_ang 90))(setq qua 1))<br /> ((and (>= qua_ang 90)(< qua_ang 180))(setq qua 2))<br /> ((and (>= qua_ang 180)(< qua_ang 270))(setq qua 3))<br /> ((and (>= qua_ang 270)(< qua_ang 360))(setq qua 4))<br /> )<br /> qua<br /> )<br /> (defun SD_SUB1()<br /> (redraw)<br /> (grdraw pt '(0 0) 1)<br /> (setq disx (abs (car pt)))<br /> (setq disy (abs (cadr pt)))<br /> (setq quaa(quad '(0 0) pt))<br /> (cond<br /> ((= quaa 1) ;第一象限<br /> (setq ptx (trans (list disx 0) 1 0))<br /> (setq pty (trans (list 0 disy) 1 0))<br /> (xyp-subupd ex 14 pty)<br /> (xyp-subupd ey 14 ptx)<br /> )<br /> ((= quaa 2) ;第二象限<br /> (setq ptx (trans (list (- disx) 0) 1 0))<br /> (setq pty (trans (list 0 disy) 1 0))<br /> (xyp-subupd ex 14 pty)<br /> (xyp-subupd ey 14 ptx)<br /> )<br /> ((= quaa 3) ;第三象限<br /> (setq ptx (trans (list (- disx) 0) 1 0))<br /> (setq pty (trans (list 0 (- disy)) 1 0))<br /> (xyp-subupd ex 14 pty)<br /> (xyp-subupd ey 14 ptx)<br /> )<br /> ((= quaa 4) ;第四象限<br /> (setq ptx (trans (list disx 0) 1 0))<br /> (setq pty (trans (list 0 (- disy)) 1 0))<br /> (xyp-subupd ex 14 pty)<br /> (xyp-subupd ey 14 ptx)<br /> )<br /> )<br /> )<br /> (defun *error* (msg)<br /> (if DIMDEC (setvar "DIMDEC" DIMDEC)(setvar "DIMDEC" 3))<br /> (if ex (vl-cmdf "ERASE" ex ""))<br /> (if ey (vl-cmdf "ERASE" ey ""))<br /> (redraw)<br /> )<br /> (princ "\n功能: [点]坐标标注")<br /> (setvar "cmdecho" 0)<br /> (setvar "osmode" 16383)<br /> (setq DIMDEC(getvar "DIMDEC"))<br /> (if (null *dec*)(setq *dec* 3))<br /> (setq dec(getint (strcat "\n请输入坐标标注精度(0-8):<" (rtos *dec* 2 0) ">")))<br /> (if (null dec)(setq dec *dec*)(setq *dec* dec))<br /> (setvar "DIMDEC" dec)<br /> (if (setq ptt (getpoint "\n指定点设置0位:"))<br /> (progn<br /> (vl-cmdf "ucs" "n" ptt)<br /> (setq ex nil ey nil)<br /> (vl-cmdf "_dimordinate" '(0 0) '(0 5))<br /> (setq ex(entlast))<br /> (vl-cmdf "_dimordinate" '(0 0) '(5 0))<br /> (setq ey(entlast))<br /> (princ"\n请选取适当的位置:")<br /> (setq go T)<br /> (while go<br /> (setq ged (grread  T 4 0))<br /> (setq pt(cadr ged))<br /> (setq geds(car ged))<br /> (cond<br /> ((= pt 32)(*error*))<br /> ((= geds 3)<br /> (SD_SUB1)<br /> (setq go nil)<br /> )<br /> ((= geds 5)<br /> (SD_SUB1)<br /> )<br /> )<br /> )<br /> (redraw)<br /> )<br /> )<br /> (setvar "DIMDEC" DIMDEC)<br /> (princ)<br /> )<br />

黄翔

目测是捕捉的问题.关闭捕捉就好了.

yu960312

黄翔 发表于 2024-8-14 09:25
目测是捕捉的问题.关闭捕捉就好了.

就是因为捕捉的问题,导致程序后续出错的