[编程申请]：能否做个消除图素Z坐标的lisp小程序

first

在做结构图时往往会套用建筑底图，但有许多次，建筑图中图素都是三维坐标。看似相交的线却找不到交点。能否有个lisp小程序，将图素的Z坐标取消或变为“0.000”，使之成为正真的平面图，为便结构绘图

eachy

晓东工具箱－》工具二－》Z坐标为0

小狼

2. 
   
3. (defun c:entelev  (/ high1 xx)
   
4.    (setvar "cmdecho" 0)
   
5.    (setq high1 (getreal "\n请输入高程:"))
   
6.    (princ "\n请选择实体(可选多个):")
   
7.    (setq xx (ssget))
   
8.    (vl-cmdf "change" "p" "" "p" "e" high1 "")
   
9.    (setvar "cmdecho" 1)(princ)
   
10. )

<br /> (defun c:entelev  (/ high1 xx)<br />    (setvar "cmdecho" 0)<br />    (setq high1 (getreal "\n请输入高程:"))<br />    (princ "\n请选择实体(可选多个):")<br />    (setq xx (ssget))<br />    (vl-cmdf "change" "p" "" "p" "e" high1 "")<br />    (setvar "cmdecho" 1)(princ)<br /> )

版主提示：正确使用论坛代码缩进。

nmsssb

acad2002中的ET1.9有flatten命令，可以做到；天正5.x有相关命令。cad2000附带的express和r14的bonus尚无此功能。

cuiwenjun2008

晓东工具箱—》工具箱二—》Z坐标为0，是什么意思？我找不到。我想找使Z坐标变0的软件，请指点位置。谢谢

wxtasking

最初由 小狼 发布
[B][code]
(defun c:entelev  (/ high1 xx)
   (setvar "cmdecho" 0)
   (setq high1 (getreal "\n请输入高程:"))
   (princ "\n请选择实体(可选多个):")
   (setq xx (ssget))
   (vl-cmdf "change" "p" "" "p" ... [/B]

请问这个怎么用，对不起，我实在太菜

zhynt

把上面的代码复制下来，保存成lsp文件，文件名任意，扩展名为lsp，然后在cad中加载，用entelev命令运行。

另外我说一点：这个程序短小精悍，比晓东工具箱的Z－0要好，因为晓东工具箱的Z-0有时处理不完全。不过也有缺点，就是无法修改具有不同 Z 坐标的对象的标高。把两者相结合就完美无却了。

chhm

其英文简介：move all "Z" coordinates to 0 elevation (flattens drawing)

zhynt

最初由 chhm 发布
[B]其英文简介：move all "Z" coordinates to 0 elevation (flattens drawing) [/B]

这个程序的效果和晓东工具箱是一样的。

wxy36

天正里有
标高变0
的命令

zjf5561677

这里有一个可以将图形中实体的Z值和厚度置为0。

2. ;;;将图形中实体的厚度改为0.高度改为0;(zero)
   
3. (defun c:zero (/ ss count s1 old new)
   
4. 
   
5.   (princ "\nPLEASE WAIT........CHANGE HIGH thick z")
   
6.   (setq ss (ssget "x"))
   
7.   (setq count 0)
   
8.   (repeat (sslength ss)
   
9.     (setq s1 (entget (ssname ss count)))
   
10.                                                                       ;改变厚度
    
11.     (setq old (assoc 39 s1))
    
12.     (if        old
    
13.       (progn
    
14.         (setq new (cons 39 0.0))
    
15.         (setq s1 (subst new old s1))
    
16.         (entmod s1)
    
17.       )                                                                      ;end progn
    
18.     )                                                                      ;end if
    
19.     ;;改变高度
    
20.     (setq old (assoc 38 s1))
    
21.     (if        old
    
22.       (progn
    
23.         (setq new (cons 38 0.0))
    
24.         (setq s1 (subst new old s1))
    
25.         (entmod s1)
    
26.       )                                                                      ;end progn
    
27.     )                                                                      ;end if
    
28.     ;;改变z值
    
29.     (setq old (assoc 10 s1))
    
30.     (if        old
    
31.       (progn
    
32.         (setq x (cadr old))
    
33.         (setq y (caddr old))
    
34.         (setq z (cadddr old))
    
35.         (setq new (cons 10 (list x y 0.0)))
    
36.         (setq s1 (subst new old s1))
    
37.         (entmod s1)
    
38.       )                                                                      ;end progn
    
39.     )                                                                      ;end if
    
40.     (setq old (assoc 11 s1))
    
41.     (if        old
    
42.       (progn
    
43.         (setq old (assoc 11 s1))
    
44.         (setq x (cadr old))
    
45.         (setq y (caddr old))
    
46.         (setq z (cadddr old))
    
47.         (setq new (cons 11 (list x y 0.0)))
    
48.         (setq s1 (subst new old s1))
    
49.         (entmod s1)
    
50.       )                                                                      ;end progn
    
51.     )                                                                      ;end if
    
52. 
    
53.     (setq count (+ 1 count))
    
54.   )                                                                      ;end repeat
    
55.   (princ "\nOK!!!")
    
56.   (princ "\n")
    
57. )                                                                      ;end

;;;将图形中实体的厚度改为0.高度改为0;(zero)<br /> (defun c:zero (/ ss count s1 old new)<br /> <br />   (princ "\nPLEASE WAIT........CHANGE HIGH thick z")<br />   (setq ss (ssget "x"))<br />   (setq count 0)<br />   (repeat (sslength ss)<br />     (setq s1 (entget (ssname ss count)))<br />                                                                       ;改变厚度<br />     (setq old (assoc 39 s1))<br />     (if        old<br />       (progn<br />         (setq new (cons 39 0.0))<br />         (setq s1 (subst new old s1))<br />         (entmod s1)<br />       )                                                                      ;end progn<br />     )                                                                      ;end if<br />     ;;改变高度<br />     (setq old (assoc 38 s1))<br />     (if        old<br />       (progn<br />         (setq new (cons 38 0.0))<br />         (setq s1 (subst new old s1))<br />         (entmod s1)<br />       )                                                                      ;end progn<br />     )                                                                      ;end if<br />     ;;改变z值<br />     (setq old (assoc 10 s1))<br />     (if        old<br />       (progn<br />         (setq x (cadr old))<br />         (setq y (caddr old))<br />         (setq z (cadddr old))<br />         (setq new (cons 10 (list x y 0.0)))<br />         (setq s1 (subst new old s1))<br />         (entmod s1)<br />       )                                                                      ;end progn<br />     )                                                                      ;end if<br />     (setq old (assoc 11 s1))<br />     (if        old<br />       (progn<br />         (setq old (assoc 11 s1))<br />         (setq x (cadr old))<br />         (setq y (caddr old))<br />         (setq z (cadddr old))<br />         (setq new (cons 11 (list x y 0.0)))<br />         (setq s1 (subst new old s1))<br />         (entmod s1)<br />       )                                                                      ;end progn<br />     )                                                                      ;end if<br /> <br />     (setq count (+ 1 count))<br />   )                                                                      ;end repeat<br />   (princ "\nOK!!!")<br />   (princ "\n")<br /> )                                                                      ;end

aeo

(defun c:z0 ()
(command "move" (ssget) "" '(0 0) "@0,0,1e99")
(command "move" "p"  "" '(0 0) "@0,0,-1e99")
)

ZYG2000

谢谢了~~~~~~

露水2

假如线为空间线(起点和终点的z坐标不相等也不为零),这个可以把他变成z坐标都为零

2. 
   
3. (Defun c:test( / fil len n e ed b new1 c new2 )
   
4. (command "redraw")
   
5. (setq fil (ssget))
   
6. (setq len (sslength fil))
   
7. (setq n 0)
   
8. (while (<= n (- len 1))
   
9.   (progn
   
10.    (setq e (ssname fil n))
    
11.    (setq ed (entget e))
    
12.    (if (/= nil)   
    
13.      (progn
    
14.           (setq b (assoc 10 ed))
    
15.          (setq new1 (list 10 (car (cdr b)) (car (cdr (cdr b))) 0))
    
16.           (setq ed (subst new1 b ed))
    
17. 
    
18.           (setq c (assoc 11 ed))
    
19.          (setq new2 (list 11 (car (cdr c)) (car (cdr (cdr c))) 0))
    
20.           (setq ed (subst new2 c ed))
    
21.           (setq n (+ 1 n))
    
22.           (entmod ed)
    
23.      )
    
24.     (setq n (+ 1 n))
    
25.     )
    
26.    )
    
27.   )
    
28. (princ)
    
29. )

<br /> (Defun c:test( / fil len n e ed b new1 c new2 ) <br /> (command "redraw")<br /> (setq fil (ssget))<br /> (setq len (sslength fil))<br /> (setq n 0)<br /> (while (<= n (- len 1))<br />   (progn<br />    (setq e (ssname fil n))<br />    (setq ed (entget e))<br />    (if (/= nil)   <br />      (progn<br />           (setq b (assoc 10 ed))<br />          (setq new1 (list 10 (car (cdr b)) (car (cdr (cdr b))) 0))<br />           (setq ed (subst new1 b ed)) <br /> <br />           (setq c (assoc 11 ed))<br />          (setq new2 (list 11 (car (cdr c)) (car (cdr (cdr c))) 0))<br />           (setq ed (subst new2 c ed)) <br />           (setq n (+ 1 n))<br />           (entmod ed)<br />      )<br />     (setq n (+ 1 n))<br />     )<br />    )<br />   )<br /> (princ)<br /> )

KENSHIN709

好程序，要定了，copy下来好好的调试。谢谢啦