关于z坐标清零及线加粗程序

cdjtsf

在勘察资料图中，好多实体都含有不同值的z坐标（即z轴增量不为0），这样在编辑时（如延伸，修剪，加粗等）就提示出错，晓东工具箱里有“z坐标为0”的工具，但运行速度慢，下面这个语句特别简单，无论图形有多大，处理速度一瞬间，它其实利用计算机对数据的处理精度问题而达到目的，建议XD工具改为此代码。

(command "_.move" e0 "" '(0 0 1e99) ""  "_.move" e0 "" '(0 0 -1e99) "");e0为选择集[/SIZE][/COLOR]
XD站里也有好多线加粗小程序，但不能处理z轴增量不为0的情况，下面的能处理circle及上述等各种情况

2. 
   
3. (defun FLATTEN (e0 /)
   
4.   (command "_.UCS" "")
   
5.   (command "_.move" e0 "" '(0 0 1e99) "" "_.move" e0 "" '(0 0 -1e99) "")
   
6.   (princ)
   
7. )
   
8. 
   
9. (defun C:wd (/ olde p l n w0 e0 w e b d a r x y pt p1)
   
10.   (setvar "cmdecho" 0)
    
11.   (command "undo" "m")
    
12.   (setq olde *error*
    
13.         *error* clmerr
    
14.   )                                       ; (if(null psc)(setq psc 100))(setq
    
15.                                        ; w0 (* psc 0.6))
    
16.   (setq w0 70)
    
17.   (if (null p)
    
18.     (setq p (ssget))
    
19.   )
    
20.   (setq l 0
    
21.         n (sslength p)
    
22.   )
    
23.   (princ "\n宽度<")
    
24.   (princ w0)
    
25.   (setq w (getreal ">:"))
    
26.   (if (null w)
    
27.     (setq w w0)
    
28.   )
    
29.   (while (< l n)
    
30.     (setq e0 (ssname p l))
    
31.     (setq e (entget e0))
    
32.     (setq b (cdr (assoc 0 e)))
    
33.     (progn
    
34.       (if (= "LWPOLYLINE" b)
    
35.         (command "pedit" e0 "w" w "")
    
36.       )
    
37.       (if (= "ARC" b)
    
38.         (command "pedit" e0 "" "w" w "")
    
39.       )
    
40.       (if (= "LINE" b)
    
41.         (if (/= (nth 3 (assoc '10 e)) (nth 3 (assoc '11 e)))
    
42.           (progn
    
43.             (flatten e0)
    
44.             (command "pedit" e0 "" "w" w "")
    
45.           )
    
46.           (command "pedit" e0 "" "w" w "")
    
47.         )
    
48.       )                                       ; end if
    
49.       (if (= "CIRCLE" b)
    
50.         (progn
    
51.           (setq d (getstring "\n圆改<Y>es or No?"))
    
52.           (if (or
    
53.                 (= (strcase d) "Y")
    
54.                 (= "" d)
    
55.               )
    
56.             (progn
    
57.               (setq a (cdr (assoc 10 e)))
    
58.               (setq r (* 2 (cdr (assoc 40 e))))
    
59.               (setq x (car a)
    
60.                     y (cadr a)
    
61.               )
    
62.               (setq pt (list x y))
    
63.               (command "erase" e0 "")
    
64.               (command "donut" r r pt "")
    
65.               (setq p1 (entlast))
    
66.               (command "pedit" p1 "w" w "")
    
67.             )                               ; end progn
    
68.           )                               ; end if
    
69.         )                               ; end progn
    
70.       )                                       ; end if
    
71.       (setq l (1+ l))
    
72.     )                                       ; end progn
    
73.     (command "redraw")
    
74.     (setq *error* olde)
    
75.     (setvar "cmdecho" 1)
    
76.     (princ)
    
77.   )                                       ; end while
    
78.   (princ)
    
79. )
    
80. ;;; end defun

<br /> (defun FLATTEN (e0 /)<br />   (command "_.UCS" "")<br />   (command "_.move" e0 "" '(0 0 1e99) "" "_.move" e0 "" '(0 0 -1e99) "")<br />   (princ)<br /> )<br /> <br /> (defun C:wd (/ olde p l n w0 e0 w e b d a r x y pt p1)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "m")<br />   (setq olde *error*<br />         *error* clmerr<br />   )                                       ; (if(null psc)(setq psc 100))(setq<br />                                        ; w0 (* psc 0.6))<br />   (setq w0 70)<br />   (if (null p)<br />     (setq p (ssget))<br />   )<br />   (setq l 0<br />         n (sslength p)<br />   )<br />   (princ "\n宽度<")<br />   (princ w0)<br />   (setq w (getreal ">:"))<br />   (if (null w)<br />     (setq w w0)<br />   )<br />   (while (< l n)<br />     (setq e0 (ssname p l))<br />     (setq e (entget e0))<br />     (setq b (cdr (assoc 0 e)))<br />     (progn<br />       (if (= "LWPOLYLINE" b)<br />         (command "pedit" e0 "w" w "")<br />       )<br />       (if (= "ARC" b)<br />         (command "pedit" e0 "" "w" w "")<br />       )<br />       (if (= "LINE" b)<br />         (if (/= (nth 3 (assoc '10 e)) (nth 3 (assoc '11 e)))<br />           (progn<br />             (flatten e0)<br />             (command "pedit" e0 "" "w" w "")<br />           )<br />           (command "pedit" e0 "" "w" w "")<br />         )<br />       )                                       ; end if<br />       (if (= "CIRCLE" b)<br />         (progn<br />           (setq d (getstring "\n圆改<Y>es or No?"))<br />           (if (or<br />                 (= (strcase d) "Y")<br />                 (= "" d)<br />               )<br />             (progn<br />               (setq a (cdr (assoc 10 e)))<br />               (setq r (* 2 (cdr (assoc 40 e))))<br />               (setq x (car a)<br />                     y (cadr a)<br />               )<br />               (setq pt (list x y))<br />               (command "erase" e0 "")<br />               (command "donut" r r pt "")<br />               (setq p1 (entlast))<br />               (command "pedit" p1 "w" w "")<br />             )                               ; end progn<br />           )                               ; end if<br />         )                               ; end progn<br />       )                                       ; end if<br />       (setq l (1+ l))<br />     )                                       ; end progn<br />     (command "redraw")<br />     (setq *error* olde)<br />     (setvar "cmdecho" 1)<br />     (princ)<br />   )                                       ; end while<br />   (princ)<br /> )<br /> ;;; end defun

陌生人

但不能处理z轴增量不为0的情况-----???能详细说清楚一点么？

cdjtsf

最初由 陌生人 发布
[B]但不能处理z轴增量不为0的情况-----???能详细说清楚一点么？ [/B]

对于line而言，就是起始点的z坐标不等

Free-Lancer

除了块内实体，Move就可解决Z不为0的情况。
属性又是什么情况，各位补充了。

2. 
   
3. (defun c:Fzto0 (/ )
   
4.   (vl-cmdf ".move"    "all"         ""            "0,0,0"    "0,0,1e99"
   
5.            ".move"    "all"         ""            "0,0,1e99" "0,0,0"
   
6.           )
   
7.   (vlax-map-collection
   
8.     (vla-get-blocks
   
9.       (vla-get-activedocument (vlax-get-acad-object))
   
10.     )
    
11.     '(lambda (x)
    
12.        (vlax-map-collection
    
13.          x
    
14.          '(lambda (i)
    
15.             (vla-move i
    
16.                       (vlax-3d-point '(0. 0. 0.))
    
17.                       (vlax-3d-point '(0. 0. 1e99))
    
18.             )
    
19.             (vla-move i
    
20.                       (vlax-3d-point '(0. 0. 1e99))
    
21.                       (vlax-3d-point
    
22.                         '(0. 0. 0.)
    
23.                       )
    
24.             )
    
25.           )
    
26.        )
    
27.      )
    
28.   )
    
29.   (princ)
    
30. )

<br /> (defun c:Fzto0 (/ )<br />   (vl-cmdf ".move"    "all"         ""            "0,0,0"    "0,0,1e99"<br />            ".move"    "all"         ""            "0,0,1e99" "0,0,0"<br />           )<br />   (vlax-map-collection<br />     (vla-get-blocks<br />       (vla-get-activedocument (vlax-get-acad-object))<br />     )<br />     '(lambda (x)<br />        (vlax-map-collection<br />          x<br />          '(lambda (i)<br />             (vla-move i<br />                       (vlax-3d-point '(0. 0. 0.))<br />                       (vlax-3d-point '(0. 0. 1e99))<br />             )<br />             (vla-move i<br />                       (vlax-3d-point '(0. 0. 1e99))<br />                       (vlax-3d-point<br />                         '(0. 0. 0.)<br />                       )<br />             )<br />           )<br />        )<br />      )<br />   )<br />   (princ)<br /> )

陌生人

把块内实体也压平了，这个主意不错：）
建议给楼上加分

caibaobao

拜托大师们将上述程序给整合一下，好让吾等目不识“编程”者使用方便，谢谢楼上各位

zxdcad

有三维实体对象时，用不得这种move操作，电脑要停止响应，不信你试试！！！

eachy

最初由 zxdcad 发布
[B]有三维实体对象时，用不得这种move操作，电脑要停止响应，不信你试试！！！ [/B]

试了一个含BOX的没事。

陈老汉

其实AutoCAD中"change"就有将Z坐标改任意值功能;"pe"就有加粗功能.

ruan_gdqf

加载之后　没用。