[原创]：图形坐标取整

wujimmy

20060421
完成的是line,标注,多义线等等的坐标取整

这东西在调模板的时候很好用.
把其一个轴线的坐标设为整数,其他的就用这个程序取整一下,
所有尺寸标注出来的就不会不是整数了.

原来老是被骂柱网提给做地下室的不是整数,以后看来不会了.

目前不能很好的处理的是带有角度的图形.
带有角度的只好把图分成两个部分,然后把有角度的旋转到水平的取整后再转回去.

另外autolisp中竟然四舍五入的函数都没有,大家看看是不是可以从哪个角落把他找出来

2. 
   
3.   [FONT=courier new]
   
4. 关键代码
   
5. 
   
6. (progn
   
7.      (while (setq entn (ssname ss 0))
   
8.        (ssdel entn ss)
   
9.        (setq ent (entget entn))
   
10.        (setq newent ent)
    
11.        (setq objtype (cdr (assoc 0 ent)))
    
12.        (foreach        pt ent
    
13.          (progn
    
14.            (setq dxftype (car pt))
    
15.            (cond
    
16.              ((or(= dxftype 10)(= dxftype 11)(= dxftype 13)(= dxftype 14))
    
17.               (setq x1 (cadr pt))
    
18.               (setq y1 (caddr pt))
    
19.               (setq x1(* (myfix (/ x1 wjm_qz_jindu)) wjm_qz_jindu))
    
20.               (setq y1(* (myfix (/ y1 wjm_qz_jindu)) wjm_qz_jindu))
    
21.               (setq newent (subst (list dxftype x1 y1 0)  pt newent))
    
22.               (princ (list "x:" x1 "y:" y1))
    
23.              )
    
24.              )
    
25.          )
    
26.        )
    
27.        (if x1 (entmod newent))
    
28.      )
    
29.     )
    
30. 
    
31. 
    
32.   [/FONT]
    

<br />   [FONT=courier new]<br /> 关键代码<br /> <br /> (progn<br />      (while (setq entn (ssname ss 0))<br />        (ssdel entn ss)<br />        (setq ent (entget entn))<br />        (setq newent ent)<br />        (setq objtype (cdr (assoc 0 ent)))<br />        (foreach        pt ent<br />          (progn<br />            (setq dxftype (car pt))<br />            (cond<br />              ((or(= dxftype 10)(= dxftype 11)(= dxftype 13)(= dxftype 14))<br />               (setq x1 (cadr pt))<br />               (setq y1 (caddr pt))<br />               (setq x1(* (myfix (/ x1 wjm_qz_jindu)) wjm_qz_jindu))<br />               (setq y1(* (myfix (/ y1 wjm_qz_jindu)) wjm_qz_jindu))<br />               (setq newent (subst (list dxftype x1 y1 0)  pt newent))<br />               (princ (list "x:" x1 "y:" y1))<br />              )<br />              )<br />          )<br />        )<br />        (if x1 (entmod newent))<br />      )<br />     )<br /> <br /> <br />   [/FONT]<br />

2. 
   
3.   [FONT=courier new]
   
4. (defun c:qz (/ p1 n  )
   
5.   
   
6.   (setq p1 (strcat "\n输入坐标取整模数<" (if wjm_qz_jindu (rtos wjm_qz_jindu 2 0) "")  ">:"))
   
7.   (setq n (getint p1))
   
8.   (if (/= n nil)   
   
9.     (setq wjm_qz_jindu n)
   
10.   )
    
11. 
    
12.   
    
13. (princ "\n选择要坐标取整的物体:")
    
14. (setq ss (ssget))
    
15. (if ss
    
16.    (progn
    
17.      (while (setq entn (ssname ss 0))
    
18.        (ssdel entn ss)
    
19.        (setq ent (entget entn))
    
20.        (setq newent ent)
    
21.        (setq objtype (cdr (assoc 0 ent)))
    
22.        (foreach        pt ent
    
23.          (progn
    
24.            (setq dxftype (car pt))
    
25.            (cond
    
26.              ((or(= dxftype 10)(= dxftype 11)(= dxftype 13)(= dxftype 14))
    
27.               (setq x1 (cadr pt))
    
28.               (setq y1 (caddr pt))
    
29.               (setq x1(* (myfix (/ x1 wjm_qz_jindu)) wjm_qz_jindu))
    
30.               (setq y1(* (myfix (/ y1 wjm_qz_jindu)) wjm_qz_jindu))
    
31.               (setq newent (subst (list dxftype x1 y1 0)  pt newent))
    
32.               (princ (list "x:" x1 "y:" y1))
    
33.              )
    
34.              )
    
35.          )
    
36.        )
    
37.        (if x1 (entmod newent))
    
38. ;;;       (cond
    
39. ;;;         ((eq objtype "LINE") (puline ent))
    
40. ;;;         ((eq objtype "LWPOLYLINE") (pupline wjm_qz_jindu))
    
41. ;;;         ((eq objtype "DIMENSION") (pudim ent))
    
42. ;;;       )
    
43. 
    
44.      )
    
45.     )
    
46. )
    
47.   (princ)
    
48. )
    
49. 
    
50. (defun myfix (x / mid midd)
    
51.   (setq mid (fix x))
    
52.     (setq midd (- x mid))
    
53.   (cond
    
54.     ((>= midd 0.5) (setq mid (1+ mid)))
    
55.     ((<= midd -0.5) (setq mid (1- mid)))
    
56.     )
    
57.   mid
    
58.   )
    
59. 
    
60.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:qz (/ p1 n  )<br />   <br />   (setq p1 (strcat "\n输入坐标取整模数<" (if wjm_qz_jindu (rtos wjm_qz_jindu 2 0) "")  ">:"))<br />   (setq n (getint p1))<br />   (if (/= n nil)    <br />     (setq wjm_qz_jindu n)<br />   )<br /> <br />   <br /> (princ "\n选择要坐标取整的物体:")<br /> (setq ss (ssget))<br /> (if ss<br />    (progn<br />      (while (setq entn (ssname ss 0))<br />        (ssdel entn ss)<br />        (setq ent (entget entn))<br />        (setq newent ent)<br />        (setq objtype (cdr (assoc 0 ent)))<br />        (foreach        pt ent<br />          (progn<br />            (setq dxftype (car pt))<br />            (cond<br />              ((or(= dxftype 10)(= dxftype 11)(= dxftype 13)(= dxftype 14))<br />               (setq x1 (cadr pt))<br />               (setq y1 (caddr pt))<br />               (setq x1(* (myfix (/ x1 wjm_qz_jindu)) wjm_qz_jindu))<br />               (setq y1(* (myfix (/ y1 wjm_qz_jindu)) wjm_qz_jindu))<br />               (setq newent (subst (list dxftype x1 y1 0)  pt newent))<br />               (princ (list "x:" x1 "y:" y1))<br />              )<br />              )<br />          )<br />        )<br />        (if x1 (entmod newent))<br /> ;;;       (cond<br /> ;;;         ((eq objtype "LINE") (puline ent))<br /> ;;;         ((eq objtype "LWPOLYLINE") (pupline wjm_qz_jindu))<br /> ;;;         ((eq objtype "DIMENSION") (pudim ent))<br /> ;;;       )<br /> <br />      )<br />     )<br /> )<br />   (princ)<br /> )<br /> <br /> (defun myfix (x / mid midd)<br />   (setq mid (fix x))<br />     (setq midd (- x mid))<br />   (cond<br />     ((>= midd 0.5) (setq mid (1+ mid)))<br />     ((<= midd -0.5) (setq mid (1- mid)))<br />     )<br />   mid<br />   )<br /> <br />   [/FONT]<br />

xyp1964

“另外autolisp中竟然四舍五入的函数都没有,大家看看是不是可以从哪个角落把他找出来”

用rtos不行吗？

wujimmy

(rtos 18.6 2 0)   ="19"
(rtos 18.5 2 0)  = "19"
(rtos 18.4 2 0)  = "18"

(defun myfix (x / mid midd)
  (atoi (rtos x 2 0))
)

确实可行,谢谢

linxu100

好象瞒实用的

softbird

坐标取整后，实际线的位置是否可以也调整到正确的位置？还是仅仅坐标数字不真实的改变？

cadmap

感谢楼主分享,不错的程序

色龙

可否增加其他的图元坐标提取

cy956

要注意xy很大时，尤其是四舍五入等的计算会出现错误，应该属于浮点计算的精度限制造成的。

COCOMPUTER

楼主能不能把全部代码都列出来呢？我爱心币不够，没法下载，好郁闷。