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

xyp1964

属性块内的属性文本：

普通块内的实体：

;; 先从简单的开始

2. 
   
3. ;; Z轴归零主函数 zzgl
   
4. ;; 实例: (zzgl (setq s1 (car (entsel "\n选择: "))))
   
5. (defun zzgl (s1)
   
6.   ;; 适合于一般实体
   
7.   (foreach a '(10 11 12 13 14)
   
8.     (zzgl-dxf s1 a)
   
9.   )
   
10. )
    
11. ;; __________________________________________________________________
    
12. ;; 以下为自定义函数，大部分代码都曾经开源过
    
13. ;; __________________________________________________________________
    
14. (defun xyp-DXF (code s1 / ent lst a)
    
15.   (if (= (type code) 'LIST)
    
16.     (progn
    
17.       (setq ent (entget s1)
    
18.             lst        '()
    
19.       )
    
20.       (foreach a code
    
21.         (setq lst (cons (list a (cdr (assoc a ent))) lst))
    
22.       )
    
23.       (reverse lst)
    
24.     )
    
25.     (if (= code -3)
    
26.       (cdr (assoc code (entget s1 '("*"))))
    
27.       (cdr (assoc code (entget s1)))
    
28.     )
    
29.   )
    
30. )
    
31. 
    
32. (defun xyp-Etype (s1 etype)
    
33.   (wcmatch (xyp-DXF 0 s1) (strcase etype))
    
34. )
    
35. 
    
36. (defun xyp-SubUpd (s1 code val / ent x y i s1)
    
37.   (cond ((= (type s1) 'ENAME)
    
38.          (setq ent (entget s1))
    
39.          (if (and (= (type code) 'LIST) (= (type val) 'LIST))
    
40.            (mapcar '(lambda (x y) (xyp-SubUpd s1 x y)) code val)
    
41.            (progn
    
42.              (if (= (xyp-dxf code s1) nil)
    
43.                (entmod (append ent (list (cons code val))))
    
44.                (entmod (subst (cons code val) (assoc code ent) ent))
    
45.              )
    
46.              (entupd s1)
    
47.            )
    
48.          )
    
49.         )
    
50.         ((= (type s1) 'PICKSET)
    
51.          (setq i -1)
    
52.          (while (setq s2 (ssname s1 (setq i (1+ i))))
    
53.            (xyp-SubUpd s2 code val)
    
54.          )
    
55.         )
    
56.         ((= (type s1) 'LIST)
    
57.          (foreach s2 s1 (xyp-SubUpd s2 code val))
    
58.         )
    
59.   )
    
60.   s1
    
61. )
    
62. 
    
63. (defun zzgl-dxf (s1 mode / pt)
    
64.   (if (and (setq pt (xyp-dxf mode s1))
    
65.            (/= (caddr pt) 0)
    
66.       )
    
67.     (xyp-SubUpd s1 mode (list (car pt) (cadr pt) 0))
    
68.   )
    
69. )
    
70. ;; __________________________________________________________________
    
71. ;; 自定义函数
    
72. ;; __________________________________________________________________
    

<br /> ;; Z轴归零主函数 zzgl<br /> ;; 实例: (zzgl (setq s1 (car (entsel "\n选择: "))))<br /> (defun zzgl (s1)<br />   ;; 适合于一般实体<br />   (foreach a '(10 11 12 13 14)<br />     (zzgl-dxf s1 a)<br />   )<br /> )<br /> ;; __________________________________________________________________<br /> ;; 以下为自定义函数，大部分代码都曾经开源过<br /> ;; __________________________________________________________________<br /> (defun xyp-DXF (code s1 / ent lst a)<br />   (if (= (type code) 'LIST)<br />     (progn<br />       (setq ent (entget s1)<br />             lst        '()<br />       )<br />       (foreach a code<br />         (setq lst (cons (list a (cdr (assoc a ent))) lst))<br />       )<br />       (reverse lst)<br />     )<br />     (if (= code -3)<br />       (cdr (assoc code (entget s1 '("*"))))<br />       (cdr (assoc code (entget s1)))<br />     )<br />   )<br /> )<br /> <br /> (defun xyp-Etype (s1 etype)<br />   (wcmatch (xyp-DXF 0 s1) (strcase etype))<br /> )<br /> <br /> (defun xyp-SubUpd (s1 code val / ent x y i s1)<br />   (cond ((= (type s1) 'ENAME)<br />          (setq ent (entget s1))<br />          (if (and (= (type code) 'LIST) (= (type val) 'LIST))<br />            (mapcar '(lambda (x y) (xyp-SubUpd s1 x y)) code val)<br />            (progn<br />              (if (= (xyp-dxf code s1) nil)<br />                (entmod (append ent (list (cons code val))))<br />                (entmod (subst (cons code val) (assoc code ent) ent))<br />              )<br />              (entupd s1)<br />            )<br />          )<br />         )<br />         ((= (type s1) 'PICKSET)<br />          (setq i -1)<br />          (while (setq s2 (ssname s1 (setq i (1+ i))))<br />            (xyp-SubUpd s2 code val)<br />          )<br />         )<br />         ((= (type s1) 'LIST)<br />          (foreach s2 s1 (xyp-SubUpd s2 code val))<br />         )<br />   )<br />   s1<br /> )<br /> <br /> (defun zzgl-dxf (s1 mode / pt)<br />   (if (and (setq pt (xyp-dxf mode s1))<br />            (/= (caddr pt) 0)<br />       )<br />     (xyp-SubUpd s1 mode (list (car pt) (cadr pt) 0))<br />   )<br /> )<br /> ;; __________________________________________________________________<br /> ;; 自定义函数<br /> ;; __________________________________________________________________<br />

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 /> )

tigcat

用的天正自带的坐标归零。这个试了后，发现上传的测试图图案填充还有一些块无法坐标归零。

头大无恼

ko217 发表于 2015-5-26 21:53
有块不炸开就归零的吗

期待啊

emk

院长厉害......垃圾处理利器

kfboy

看得见摸不着哦

用户3766035971

院长厉害

donghuidong2003

期待院长的源码发放……
我的图就是这鬼样的

yiqisese

有程序共享不，图多了会不会致命错误

xyp1964

2. 
   
3. ;; Z轴归零主函数 zzgl
   
4. ;; (zzgl (setq s1 (car (entsel "\n选择: "))))
   
5. (defun zzgl (ename)
   
6.   ;; 适合于一般实体
   
7.   (foreach a '(10 11 12 13 14)
   
8.     (zzgl-dxf ename a)
   
9.   )
   
10.   ;; 存在38码的实体
    
11.   (if (/= (setq pt (xyp-dxf 38 ename)) 0)
    
12.     (xyp-SUBUPD ename 38 0)
    
13.   )
    
14. )

<br /> ;; Z轴归零主函数 zzgl<br /> ;; (zzgl (setq s1 (car (entsel "\n选择: "))))<br /> (defun zzgl (ename)<br />   ;; 适合于一般实体<br />   (foreach a '(10 11 12 13 14)<br />     (zzgl-dxf ename a)<br />   )<br />   ;; 存在38码的实体<br />   (if (/= (setq pt (xyp-dxf 38 ename)) 0)<br />     (xyp-SUBUPD ename 38 0)<br />   )<br /> )

rjtiantian

火前留名。。。

zichang

院长厉害！

txd720127

这个确实很实用，顶院长！