[LISP程序]：改变PL 厚度到鼠标点取的高度位置（请梦断江南给完善完善）

mf7000

我不会编怎么复杂的程序，是别人编的，R12里好用R14不行

请梦断江南给改一改

;;by xdcad.com ------ mf7000 ;改pl线条厚度 thickness
(DEFUN c:cgt ()
(setq ss (ssget))
(if ss
(progn
(princ "\ndelta Z/X/Y/Input/: ")
(initget "Z X Y Input" )
(setq thk (getpoint))
(cond
( (or (= "Z" thk) (= "X" thk) (= "Y" thk))
(cond ( (= "Z" thk) (setq cgt-n 2))
( (= "Y" thk) (setq cgt-n 1))
( (= "X" thk) (setq cgt-n 0))
);end cond
(initget 7)
(setq lpt (getpoint"\nLower point: "))
(initget 7)
(setq upt (getpoint lpt "\nUpper point: ") ;参照点是3维点
       thk (- (nth cgt-n upt) (nth cgt-n lpt))
)
);case1
( (= thk "Input")
  (initget 1)
  (setq thk (getdist "\nThickness: "))
) ;case2
( (null thk)
  (initget 1)
  (setq thk (getdist "\nZ_coords of upper_pt: ")
       upz (caddr upt)
      ent1 (ssname ss 0)
       lpz (cadddr (assoc 10 (entget ent1))))
  (if (= nil lpz)(setq lpz 0))
  (setq thk (- thk lpz) )
) ;case3
(1
  (initget 7)
  (setq upz (caddr upt)
       ent1 (ssname ss 0)
        lpz (cadddr (assoc 10 (entget ent1))))
  (if (= nil lpz)(setq lpz 0))
  (setq thk (- (caddr thk) lpz))
) ;case4
) ;end cond
(if thk (COMMAND "CHPROP" ss "" "T" thk ""))
)
)
)

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. ;;by xdcad.com ------ mf7000 ;改pl线条厚度 thickness
   
5. (DEFUN c:cgt ( / ss thk lpt upt thk upz lpz ent1)
   
6. (setq ss (ssget))
   
7. (if ss
   
8. (progn
   
9. (princ "\ndelta Z/X/Y/Input/: ")
   
10. (initget "Z X Y Input" )
    
11. (setq thk (getpoint))
    
12. (cond
    
13. ( (or (= "Z" thk) (= "X" thk) (= "Y" thk))
    
14. (cond ( (= "Z" thk) (setq cgt-n 2))
    
15. ( (= "Y" thk) (setq cgt-n 1))
    
16. ( (= "X" thk) (setq cgt-n 0))
    
17. );end cond
    
18. (initget 7)
    
19. (setq lpt (getpoint"\nLower point: "))
    
20. (initget 7)
    
21. (setq upt (getpoint lpt "\nUpper point: ") ;参照点是3维点
    
22.        thk (- (nth cgt-n upt) (nth cgt-n lpt))
    
23. )
    
24. );case1
    
25. ( (= thk "Input")
    
26.   (initget 1)
    
27.   (setq thk (getdist "\nThickness: "))
    
28. ) ;case2
    
29. ( (null thk)
    
30.   (initget 1)
    
31.   (setq thk (getdist "\nZ_coords of upper_pt: ")
    
32.        upz (caddr upt)
    
33.       ent1 (ssname ss 0)
    
34.        lpz (cadddr (assoc 10 (entget ent1))))
    
35.   (if (= nil lpz)(setq lpz 0))
    
36.   (setq thk (- thk lpz) )
    
37. ) ;case3
    
38. (1
    
39.   (initget 7)
    
40.   (setq upz (caddr upt)
    
41.        ent1 (ssname ss 0)
    
42.         lpz (cadddr (assoc 10 (entget ent1))))
    
43.   (if (= nil lpz)(setq lpz 0))
    
44.   (setq thk (- (caddr thk) lpz))
    
45. ) ;case4
    
46. ) ;end cond
    
47. (if thk (COMMAND "CHPROP" ss "" "T" thk ""))
    
48. )
    
49. )
    
50. )
    
51. 
    
52.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;by xdcad.com ------ mf7000 ;改pl线条厚度 thickness<br /> (DEFUN c:cgt ( / ss thk lpt upt thk upz lpz ent1) <br /> (setq ss (ssget)) <br /> (if ss <br /> (progn <br /> (princ "\ndelta Z/X/Y/Input/: ") <br /> (initget "Z X Y Input" ) <br /> (setq thk (getpoint)) <br /> (cond<br /> ( (or (= "Z" thk) (= "X" thk) (= "Y" thk)) <br /> (cond ( (= "Z" thk) (setq cgt-n 2)) <br /> ( (= "Y" thk) (setq cgt-n 1)) <br /> ( (= "X" thk) (setq cgt-n 0)) <br /> );end cond<br /> (initget 7) <br /> (setq lpt (getpoint"\nLower point: ")) <br /> (initget 7) <br /> (setq upt (getpoint lpt "\nUpper point: ") ;参照点是3维点<br />        thk (- (nth cgt-n upt) (nth cgt-n lpt))<br /> )<br /> );case1<br /> ( (= thk "Input") <br />   (initget 1) <br />   (setq thk (getdist "\nThickness: ")) <br /> ) ;case2<br /> ( (null thk) <br />   (initget 1) <br />   (setq thk (getdist "\nZ_coords of upper_pt: ") <br />        upz (caddr upt) <br />       ent1 (ssname ss 0) <br />        lpz (cadddr (assoc 10 (entget ent1))))<br />   (if (= nil lpz)(setq lpz 0))<br />   (setq thk (- thk lpz) )<br /> ) ;case3<br /> (1 <br />   (initget 7) <br />   (setq upz (caddr upt) <br />        ent1 (ssname ss 0) <br />         lpz (cadddr (assoc 10 (entget ent1))))<br />   (if (= nil lpz)(setq lpz 0)) <br />   (setq thk (- (caddr thk) lpz)) <br /> ) ;case4<br /> ) ;end cond<br /> (if thk (COMMAND "CHPROP" ss "" "T" thk "")) <br /> ) <br /> ) <br /> )<br /> <br />   [/FONT]<br />

下载地址：http://www.fspdi.com/forum/pic/cgt3.swf

<embed src=http://www.fspdi.com/forum/pic/cgt3.swf quality=high width=640 height=480 loop=true type="application/x-shockwave-flash">
</embed>

mf7000

就在这里接着说吧
好烈害呀！！
可是我要直接点取要变到的高度，不是点两点的距离
而且两个物体的ELEV不同

梦断江南

你的原程序 （参考 http://www.xdcad.net/forum/showt ... =49258#post49258）
问题在于：
r14以上版本，在z坐标为0 的平面作多义线时，多义线的实体数据中顶点不包括 z 值
（但是用list列出是含有z=0的信息的）你可以用一个查看实体数据的程序试试看。
在 r14以上版本， pline线条的顶点 坐标可以没有 z 值也被认为是合法的。如：
(10 30606.5 35275.8)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 12321.8 31021.9)
....
所以：

你在程序中要加一个判断
....
lpz (cadddr (assoc 10 (entget ent1))))
(if (= nil lpz)(setq lpz 0))
(setq thk (- thk lpz) )
....
我改了后就正常了。

mf7000

"问题在于：
r14以上版本，在z坐标为0 的平面作多义线时，多义线的实体数据中顶点不包括 z 值
（但是用list列出是含有z=0的信息的）你可以用一个查看实体数据的程序试试看。
在 r14以上版本， pline线条的顶点 坐标可以没有 z 值也被认为是合法的"

对于这个问题应该怎么改
LPZ 的值应该是被修改物体的ELEV     不能为0,否则改变的厚度就是THK-0  而不是THK-LPZ

怎样把点坐标（X,Y,Z)的Z值提取出来并赋予THK

梦断江南

局部修改一下，可以做到
(1
  (initget 7)
  (setq upz (caddr upt)
       ent1 (ssname ss 0)
        lpz (cdr (assoc 38 (entget ent1))))
  (if (= nil lpz)(setq lpz 0))
  (setq thk (- (caddr thk) lpz))
) ;case4
) ;end cond
...
但是要使选择集中每个实体都拉伸到指定点高度需要另外修改，如果选择集实体的z位置不同的话。

mf7000

好使了，谢谢。
梦断江南是个大好人！！！！

XDSoft

最初由 mf7000 发布
[B]"问题在于：
r14以上版本，在z坐标为0 的平面作多义线时，多义线的实体数据中顶点不包括 z 值
（但是用list列出是含有z=0的信息的）你可以用一个查看实体数据的程序试试看。
在 r14以上版本， pline线条的顶点... [/B]

在R14以上版本，POLYLINE是“二维”对象，在实体数据定义中不包括Z，而Z值（准确的说是elevation）反映在组码38上。所以，上面江南通过组码38得到了Z值。

梦断江南

38 码是多义线的z值(平面高度值)
39码是拉伸厚度(thickness)

以后凡是引用别人的程序，必须在贴出来的时候注明－－－－－－－注意！

XDSoft

最初由 梦断江南 发布
[B]38 码是多义线的z值(平面高度值)
39码是拉伸厚度(thickness)

以后凡是引用别人的程序，必须在贴出来的时候注明－－－－－－－注意！ [/B]

同意江南的观点，大家以后贴代码、问题的时候，要详细的描述问题的现象，比如程序的作用、自己在用它对什么实体操作的时候出现错误，出错的提示信息贴论坛或者有截图说明，把截图贴到论坛，这样才方便大家讨论和及时解决问题。

阿龙197811

同意楼上的观点

li809

高手自有高招，把写得楚点，能多许多解决的方法