【e派】Z轴归零问题探讨——源码揭秘

200853006

赶紧占楼！

429014673

先占个位置。

xyp1964

;; spline、arc 、块内实体、dxf 210码不正常等等的实体——待后续研究

2. 
   
3. ;; zzgl(Z轴归零)
   
4. ;; 测试实例
   
5. (defun c:zzgl ()
   
6.   (princ "\n选择归零实体: ")
   
7.   (if (setq ss (ssget))
   
8.     (setq lst (xyp-Ss2List ss)
   
9.           lst (mapcar 'xyp-Zzgl lst)
   
10.     )
    
11.   )
    
12.   (princ)
    
13. )
    
14. 
    
15. ;; Z轴归零主函数 xyp-Zzgl
    
16. (defun xyp-Zzgl        (s1 / p10)
    
17.   ;; 属性块实体: 先移位后属性实体归零
    
18.   (if (and (xyp-Etype s1 "insert")
    
19.            (= (xyp-Dxf 66 s1) 1)
    
20.       )
    
21.     (progn
    
22.       (setq p10 (xyp-Dxf 10 s1))
    
23.       (xyp-Move s1 p10 (list (car p10) (cadr p10) 0))
    
24.       (foreach ob (xyp-AttList s1)
    
25.         (xyp-Zzgl (vlax-vla-object->ename ob))
    
26.       )
    
27.     )
    
28.   )
    
29.   ;; 一般实体
    
30.   (foreach a '(10 11 12 13 14)
    
31.     (xyp-Zzgl-Dxf s1 a)
    
32.   )
    
33.   ;; 有38码的实体
    
34.   (if (/= (setq pt (xyp-Dxf 38 s1)) 0)
    
35.     (xyp-SubUpd s1 38 0)
    
36.   )
    
37.   ;; spline实体、arc 实体、块内实体、dxf 210码不正常的实体
    
38. )

<br /> ;; zzgl(Z轴归零)<br /> ;; 测试实例<br /> (defun c:zzgl ()<br />   (princ "\n选择归零实体: ")<br />   (if (setq ss (ssget))<br />     (setq lst (xyp-Ss2List ss)<br />           lst (mapcar 'xyp-Zzgl lst)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;; Z轴归零主函数 xyp-Zzgl<br /> (defun xyp-Zzgl        (s1 / p10)<br />   ;; 属性块实体: 先移位后属性实体归零<br />   (if (and (xyp-Etype s1 "insert")<br />            (= (xyp-Dxf 66 s1) 1)<br />       )<br />     (progn<br />       (setq p10 (xyp-Dxf 10 s1))<br />       (xyp-Move s1 p10 (list (car p10) (cadr p10) 0))<br />       (foreach ob (xyp-AttList s1)<br />         (xyp-Zzgl (vlax-vla-object->ename ob))<br />       )<br />     )<br />   )<br />   ;; 一般实体<br />   (foreach a '(10 11 12 13 14)<br />     (xyp-Zzgl-Dxf s1 a)<br />   )<br />   ;; 有38码的实体<br />   (if (/= (setq pt (xyp-Dxf 38 s1)) 0)<br />     (xyp-SubUpd s1 38 0)<br />   )<br />   ;; spline实体、arc 实体、块内实体、dxf 210码不正常的实体<br /> )

liuhaixin88

xyp1964 发表于 2014-5-8 19:46
;; spline、arc 、块内实体、dxf 210码不正常等等的实体——待后续研究

好像不支持块吧，用在块上无效，但是炸开块，就可以用了

xyp1964

;; 来个平面spline的

2. ;; zzgl(Z轴归零);; 测试实例
   
3. (defun c:zzgl ()
   
4.   (princ "\n选择归零实体: ")
   
5.   (if (setq ss (ssget))
   
6.     (setq lst (xyp-Ss2List ss)
   
7.           lst (mapcar 'xyp-Zzgl lst)
   
8.     )
   
9.   )
   
10.   (princ)
    
11. )
    
12. 
    
13. ;; Z轴归零主函数 xyp-Zzgl
    
14. ;; arc、块内实体、dxf210码不正常的实体等等，待后续研究
    
15. (defun xyp-Zzgl        (s1 / p10)
    
16.   ;; 属性块实体: 先移位后属性实体归零
    
17.   (cond        ((and (xyp-Etype s1 "insert")
    
18.               (= (xyp-Dxf 66 s1) 1)
    
19.          )
    
20.          (setq p10 (xyp-Dxf 10 s1))
    
21.          (xyp-Move s1 p10 (list (car p10) (cadr p10) 0))
    
22.          (foreach ob (xyp-AttList s1)
    
23.            (xyp-Zzgl (vlax-vla-object->ename ob))
    
24.          )
    
25.         )
    
26.         ((xyp-etype s1 "spline") (xyp-Zzgl-Spline s1))
    
27.   )
    
28.   ;; 一般实体
    
29.   (foreach a '(10 11 12 13 14)
    
30.     (xyp-Zzgl-Dxf s1 a)
    
31.   )
    
32.   ;; 有38码的实体
    
33.   (if (/= (setq pt (xyp-Dxf 38 s1)) 0)
    
34.     (xyp-SubUpd s1 38 0)
    
35.   )
    
36. )

;; zzgl(Z轴归零);; 测试实例<br /> (defun c:zzgl ()<br />   (princ "\n选择归零实体: ")<br />   (if (setq ss (ssget))<br />     (setq lst (xyp-Ss2List ss)<br />           lst (mapcar 'xyp-Zzgl lst)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;; Z轴归零主函数 xyp-Zzgl<br /> ;; arc、块内实体、dxf210码不正常的实体等等，待后续研究<br /> (defun xyp-Zzgl        (s1 / p10)<br />   ;; 属性块实体: 先移位后属性实体归零<br />   (cond        ((and (xyp-Etype s1 "insert")<br />               (= (xyp-Dxf 66 s1) 1)<br />          )<br />          (setq p10 (xyp-Dxf 10 s1))<br />          (xyp-Move s1 p10 (list (car p10) (cadr p10) 0))<br />          (foreach ob (xyp-AttList s1)<br />            (xyp-Zzgl (vlax-vla-object->ename ob))<br />          )<br />         )<br />         ((xyp-etype s1 "spline") (xyp-Zzgl-Spline s1))<br />   )<br />   ;; 一般实体<br />   (foreach a '(10 11 12 13 14)<br />     (xyp-Zzgl-Dxf s1 a)<br />   )<br />   ;; 有38码的实体<br />   (if (/= (setq pt (xyp-Dxf 38 s1)) 0)<br />     (xyp-SubUpd s1 38 0)<br />   )<br /> )

vlisp2012

院长要悬壶济世了！

vlisp2012

哪位英文好，是不是得给桌子公司提个建议啊。
把0.001（一定容差范围）之类的全部归零的命令啊。

USER2128

支持院长！向您学习！向您致敬！

donghuidong2003

好像秋枫大侠也做过这样一个归零的东西,版权归秋枫所有；另外还有一个不知名的归零,一同上传来与大家分享,算是与院长的来一个集合吧。

yiqisese

好像不支持天正块