求教一个困扰多年的问题：如何使所有图形Z坐标强制归0？

千雨千寻

在实际运用中，很多图形都是copy其他专业或者协作伙伴的图纸作为初始文件开始绘制施工图的，比如规划图纸、其他院或者设计事务所所作的方案或者初设，有的图乍一看是平面图，实际上并不是所有的点都在0坐标上，这里请问各位达人，有没有什么好的方法可以让一张图上所有的点的z坐标一次性全部归0？
通常我自己用过的的方法有3：
1。打开此文件，进入三维空间一个一个地仔细找这些点并一个一个的修改。
2。照原图自己全部重画一遍。
3。wmfout,然后新开一文件再wmfin，然后炸开。但炸开后尺寸完全不对，而且所有图形（包括文字）全部分解为直线并且所属图层全部变为0层，故此法不可取。
我用过网上的一个lsp程序，说是让所有点的z坐标一次性全部归0，但是它对空间闭合曲线以及文字不管用。
此外我还找到一个名为flatten的lsp程序，比那个名为z0的lsp程序好用得多，但是它有个很致命的缺点，那就是它会让所有的文字全部分解为线段。
这个问题一直让我很伤脑筋，但我自己一直没有找到什么好的办法，非常苦恼！
在此真心向各位赐教，谢谢！！

也可以将方法发送到我的邮箱中：newmask@sina.com

eachy

一年以来多到 XDCAD 看看，早已有答案。

xyp1964

应该还用更简单的。
只适用于线line：
[php]
(DEFUN C:ZZGL (/ SSS1 n s1 old1 new1 s2 old2 new2)
  (princ "\n\t选择实体: ")
  (while (not (SETQ SSS1 (ssget))))
  (setq n 0)
  (while (setq s1 (ssname SSS1 n))
    (SETQ OLD1 (ASSOC 10 (entget S1)))
    (SETQ NEW1 (list 10 (cadr old1) (caddr old1) 0))
    (SETQ S1 (SUBST NEW1 OLD1 (entget S1)))
    (setq s2 (ENTMOD S1))
    (setq s1 (dxf -1 s2))
    (SETQ OLD2 (ASSOC 11 (entget S1)))
    (SETQ NEW2 (list 11 (cadr old2) (caddr old2) 0))
    (SETQ S1 (SUBST NEW2 OLD2 (entget S1)))
    (ENTMOD S1)
    (setq n (+ 1 n))
  )
  (princ)
)
(defun dxf (code elist) (cdr (assoc code elist)))
(princ "ZZGL      (Z轴坐标归零)")
(princ)
[/php]

LUCAS

2. 
   
3. (defun C:SPLAT (/ SS CE HL OS)
   
4.    (cond
   
5.     ((setq SS (ssget))
   
6.      (setq CE (getvar "cmdecho")
   
7.            HL (getvar "highlight")
   
8.            OS (getvar "osmode")
   
9.      )
   
10.      (setvar "cmdecho" 0)
    
11.      (setvar "highlight" 0)
    
12.      (setvar "osmode" 0)
    
13.      (command "_.move" SS "" '(0 0 1e99) "")
    
14.      (command "_.move" "_p" "" '(0 0 -1e99) "")
    
15.      (setvar "cmdecho" CE)
    
16.      (setvar "highlight" HL)
    
17.      (setvar "osmode" OS)
    
18.     )
    
19.     (t (princ "\nNothing to splatten."))
    
20.   )
    
21.   (princ)
    
22. )
    

<br /> (defun C:SPLAT (/ SS CE HL OS)<br />    (cond<br />     ((setq SS (ssget))<br />      (setq CE (getvar "cmdecho")<br />            HL (getvar "highlight")<br />            OS (getvar "osmode")<br />      )<br />      (setvar "cmdecho" 0)<br />      (setvar "highlight" 0)<br />      (setvar "osmode" 0)<br />      (command "_.move" SS "" '(0 0 1e99) "")<br />      (command "_.move" "_p" "" '(0 0 -1e99) "")<br />      (setvar "cmdecho" CE)<br />      (setvar "highlight" HL)<br />      (setvar "osmode" OS)<br />     )<br />     (t (princ "\nNothing to splatten."))<br />   )<br />   (princ)<br /> )<br />

onej

楼上的我倒觉得不错！

兴趣人生

版主的程序.
在轴侧视图下的V视图下,不能适用啊?请问如何改善?

KERRYWM

建议用如下的方法试试：
对于直线如下：
(SETQ PT1(VLA-GET-STARTPOINT OBJ))
(SETQ PT2(VLA-GET-ENDPOINT OBJ))
(SETQ PT11(VLAX-SAFEARRAY-PUT-ELEMENT (VLAX-VARIANT-VALUE PT1) 2 0))
(SETQ PT21(VLAX-SAFEARRAY-PUT-ELEMENT (VLAX-VARIANT-VALUE PT2) 2 0))
(VLA-PUT-STARTPOINT OBJ (VLAX-MAKE-VARIANT PT11))
(VLA-PUT-ENDPOINT OBJ (VLAX-MAKE-VARIANT PT21))
对于圆，则可以用VLA-GET-CENTER和VLA-PUT-CENTER方法
对于3DPOLYLINE和SPLINE则可以用VLA—GET—COORDINATES和VLA—PUT—COORDINATES的方法；
对于图块，则可以用VLA—GET—INSERTIONPOINT和VLA—PUT—INSERTIONPOINT的方法，记住将Z坐标改为0，文字的方法也类似，试试吧！

firstintimate

多义线标高清零,这个是我老早以前学习lisp时候编的,函数还是xdcad某一个大虾写的-_-!
粗是粗了点,不过还能用,没多少行,你44看好了,我现在没怎么用lisp编程序比较生疏了,帮不上忙,呵呵
(defun c:bg20(/ ss i ent);;;多义线标高清零  
  (defun sub_upd (ename code newvalue)
    (entmod (subst (cons code newvalue)
                 (assoc code (entget ename))
                 (entget ename)
            )
    )
  (entupd ename)
  );defun

  ;;;主程序
  (setq ss(ssget '((0 . "LWPOLYLINE")) ))
  (setq i 0)
  (repeat(sslength ss)
    (setq ent(ssname ss i))
    (sub_upd ent 38 0)
    (setq i(1+ i))   
  )  
)

TLHMQH

我用了8楼的方法出现下列提示：

; 错误: 参数类型错误: lselsetp nil