[原创]：给等高线高程赋值

真龙天子

只要在垂直于(斜交也可以)等高线确定起点和终点,再按坡向输入等高距和从起点开始的第一条等高线高程值,就可以将起点与终点间的等高线按要求赋值,并用颜色区分首曲线和计曲线.

eachy

如果为Lisp文件请贴出源码，编译文件用 西文名称，中文名称附件下载出错机会比较多

真龙天子

回班主,按您的要求贴出LISP源码,并做了详细注释.这可是我自学编程贴出的第一个程序,如果您觉得还可以就要给加分哦,给我点鼓励嘛!

2. 
   
3. ;;; 《给等高线高程赋值》作者：真龙天子2006.04
   
4. (defun c:llzz ()
   
5. ;——————确定初始参数——————
   
6.     (setvar "osmode" 0)                                         ;关闭捕捉
   
7.     (setvar "cmdecho" 0)                                        ;关闭命令行回显
   
8.     (command "UCS" "w")                                         ;设为世界坐标系
   
9.     (setq tt "y")
   
10.   (while (/= tt "n")
    
11.     (setq pa (getpoint "\n请按坡向确定线选等高线的起点：")      ;按坡向确定线选等高线的起点
    
12.           pb (getpoint "\n请按坡向确定线选等高线的终点：")      ;按坡向确定线选等高线的终点
    
13.           ss (ssadd)                                            ;建立一个新选择集
    
14.           ss (ssget "f" (list pa pb))                           ;将pa至pb间的等高线放入选择集ss
    
15.           n  (sslength ss)                                      ;求选择集ss里等高线的条数
    
16.           z2 0
    
17.     )
    
18.     (while (/= z2 1)
    
19.            (princ "\n请确定等高距(+ 上坡；- 下坡):<") (princ z00) (princ ">:")
    
20.            (setq z (getreal ))
    
21.            (if (= z nil) (setq z z00))
    
22.            (setq zm (abs z))                                     ;取得等高距的绝对值
    
23.            (if (or (= zm 1) (= zm 2) (= zm 2.5) (= zm 5) (= zm 10) (= zm 25)) (setq z2 1))
    
24.            (if (/= z2 1) (progn
    
25.                (setq str1  (strcat"*****等高距不规范！请重新输入*****")
    
26.                      str2  (strcat"  等高距限为；1、2、2.5、5、10、25")
    
27.                      str3  (strcat"  或者为；-1、-2、-2.5、-5、-10、-25")
    
28.                )
    
29.                (alert(strcat str1 "\n" str2 "\n" str3 "\n")))
    
30.            )
    
31.     )
    
32.     (setq p0 (list 0 0 0)                                       ;新建一个XYZ为0 的新表
    
33.           m -1                                                  ;确定计数器的起始值
    
34.           z0 3
    
35.     )
    
36.     (while (/= z1 z0)
    
37.            (princ "\n请确定起始等高线高程:<") (princ "刚才最后一条等高线高程为：") (princ zn0) (princ ">:")
    
38.            (setq z0 (getreal))
    
39.            (if (= z0 nil) (setq z0 zn0))
    
40.            (setq z1 (* zm (atoi (rtos (/ z0 zm)))))
    
41.            (if (/= z0 z1) (alert (strcat"起始等高线高程错误！请重新输入")))
    
42.     )
    
43.       (command "chprop" "f" pa pb "" "" "c" "byblock" "")    ;修改为颜色随块
    
44. ;——————从选择集里取出单条等高线赋予新的高程并根据高程值确定颜色——————
    
45.     (repeat n
    
46.           (setq m (+ m 1)                  ;计数
    
47.                 sl (ssname ss m)           ;从SS选择集里按计数器的顺序取出单条等高线
    
48.                 zn (+ z0 (* m z))          ;根据起始等高线高程计算取出的单条等高线高程
    
49.                 pz (list 0 0 zn)           ;将高程组合成坐标
    
50.            )
    
51.       (if (= zm 1) (setq mm1 (/ zn 1)))          ;等高距为1时,将高程除1
    
52.       (if (= zm 2) (setq mm1 (/ zn 2)))          ;等高距为2时,将高程除2
    
53.       (if (= zm 5) (setq mm1 (/ zn 5)))          ;等高距为5时,将高程除5
    
54.       (if (= zm 10) (setq mm1 (/ zn 10)))        ;等高距为10时,将高程除10
    
55.       (if (or (= zm 25) (= zm 2.5)) (progn                             ;等高距为25时
    
56.                     (setq mm2 (rtos zn 2 0)                    ;转换成字符串
    
57.                           mm3 (strlen mm2)                 ;提取字符串长度
    
58.                           mm4 (substr mm2 (- mm3 1) 2)     ;提取字符串最后两位
    
59.                           mm5 (atof mm4)                   ;将最后两位字符串转换为数值
    
60.                     )
    
61.                     (if (or (= mm5 00) (= mm5 00)) (setq ys 10 lww 0.25))   ;根据高程值确定其颜色和线宽
    
62.                     (if (or (= mm5 25) (= mm5 2.5)) (setq ys 50 lww 0.13))  ;根据高程值确定其颜色和线宽
    
63.                     (if (or (= mm5 50) (= mm5 5.0)) (setq ys 90 lww 0.13))  ;根据高程值确定其颜色和线宽
    
64.                     (if (or (= mm5 75) (= mm5 7.5)) (setq ys 130 lww 0.13)) ;根据高程值确定其颜色和线宽
    
65.                     )
    
66.       )  
    
67.       (if (or (= zm 1) (= zm 2) (= zm 5) (= zm 10)) (progn
    
68.           (setq mm5 (atof (substr (rtos mm1) (strlen (rtos mm1)) 1))) ;转换成字符串,提取字符串长度,提取字符串最后一位,将最后一位字符串转换为数值
    
69.           (if (or (= mm5 0) (= mm5 5)) (setq ys 10 lww 0.25))   ;根据高程值确定其颜色和线宽
    
70.           (if (or (= mm5 1) (= mm5 6)) (setq ys 50 lww 0.13))   ;根据高程值确定其颜色和线宽
    
71.           (if (or (= mm5 2) (= mm5 7)) (setq ys 90 lww 0.13))   ;根据高程值确定其颜色和线宽
    
72.           (if (or (= mm5 3) (= mm5 8)) (setq ys 130 lww 0.13))   ;根据高程值确定其颜色和线宽
    
73.           (if (or (= mm5 4) (= mm5 9)) (setq ys 170 lww 0.13)))   ;根据高程值确定其颜色和线宽
    
74.       )
    
75.       (if (= (cdr (nth 1 (entget sl))) "LWPOLYLINE") (progn          ;如果等高线是多段线
    
76.           (setq pzz0 (* -1 (cdr (assoc 38 (entget sl)))))            ;提取多段线的z值
    
77.           (command "pedit" sl "s" "" ))                              ;将多段线改为曲线
    
78.       )
    
79.       (if (= (cdr (nth 1 (entget sl))) "SPLINE")                     ;如果等高线是样条曲线
    
80.           (setq pzz0 (* -1 (nth 3 (assoc 10 (entget sl)))))           ;提取样条曲线的z值
    
81.       )
    
82.       (if (= (cdr (nth 1 (entget sl))) "POLYLINE")                   ;如果等高线是多段线改成的样条曲线
    
83.           (setq pzz0 (* -1 (nth 3 (assoc 10 (entget sl)))))           ;提取样条曲线的z值
    
84.       )
    
85.       (setq pzz (list 0 0 pzz0))                                     ;根据原等高线的z值组合新的坐标
    
86.       (if (/= pzz0 0) (command "_move" sl "" pzz ""))                ;用相对法将已赋高程值的等高线归0
    
87.       (command "_move" sl "" pz "")                                  ;用相对法移动等高线到指定高程
    
88.       (command "chprop" sl "" "lw" lww "")                           ;根据高程值修改线宽
    
89.       (vla-put-Color (vlax-ename->vla-object sl) ys)                 ;将等高线改为指定的色号
    
90.     )  
    
91.     (setq z00 z zn0 zn)
    
92.     (setq tt (getstring "\n还要继续吗？(Y/N) <Y>:"))
    
93.   )   
    
94.     (setvar "osmode" 35)                                            ;打开捕捉
    
95.   (princ "所选的等高线高程赋值、改线宽己完成!")
    
96. (prin1)
    
97. )
    
98. (prompt " <<给等高线高程赋值>>启动命令:llzz")
    
99. (princ)

<br /> ;;; 《给等高线高程赋值》作者：真龙天子2006.04<br /> (defun c:llzz ()<br /> ;——————确定初始参数——————<br />     (setvar "osmode" 0)                                         ;关闭捕捉<br />     (setvar "cmdecho" 0)                                        ;关闭命令行回显<br />     (command "UCS" "w")                                         ;设为世界坐标系<br />     (setq tt "y")<br />   (while (/= tt "n")<br />     (setq pa (getpoint "\n请按坡向确定线选等高线的起点：")      ;按坡向确定线选等高线的起点<br />           pb (getpoint "\n请按坡向确定线选等高线的终点：")      ;按坡向确定线选等高线的终点<br />           ss (ssadd)                                            ;建立一个新选择集<br />           ss (ssget "f" (list pa pb))                           ;将pa至pb间的等高线放入选择集ss<br />           n  (sslength ss)                                      ;求选择集ss里等高线的条数<br />           z2 0<br />     )<br />     (while (/= z2 1)<br />            (princ "\n请确定等高距(+ 上坡；- 下坡):<") (princ z00) (princ ">:")<br />            (setq z (getreal ))<br />            (if (= z nil) (setq z z00))<br />            (setq zm (abs z))                                     ;取得等高距的绝对值<br />            (if (or (= zm 1) (= zm 2) (= zm 2.5) (= zm 5) (= zm 10) (= zm 25)) (setq z2 1))<br />            (if (/= z2 1) (progn <br />                (setq str1  (strcat"*****等高距不规范！请重新输入*****")<br />                      str2  (strcat"  等高距限为；1、2、2.5、5、10、25") <br />                      str3  (strcat"  或者为；-1、-2、-2.5、-5、-10、-25")<br />                )<br />                (alert(strcat str1 "\n" str2 "\n" str3 "\n"))) <br />            )<br />     )<br />     (setq p0 (list 0 0 0)                                       ;新建一个XYZ为0 的新表<br />           m -1                                                  ;确定计数器的起始值<br />           z0 3<br />     )<br />     (while (/= z1 z0)<br />            (princ "\n请确定起始等高线高程:<") (princ "刚才最后一条等高线高程为：") (princ zn0) (princ ">:")<br />            (setq z0 (getreal))<br />            (if (= z0 nil) (setq z0 zn0))<br />            (setq z1 (* zm (atoi (rtos (/ z0 zm)))))<br />            (if (/= z0 z1) (alert (strcat"起始等高线高程错误！请重新输入")))<br />     ) <br />       (command "chprop" "f" pa pb "" "" "c" "byblock" "")    ;修改为颜色随块<br /> ;——————从选择集里取出单条等高线赋予新的高程并根据高程值确定颜色——————<br />     (repeat n <br />           (setq m (+ m 1)                  ;计数<br />                 sl (ssname ss m)           ;从SS选择集里按计数器的顺序取出单条等高线<br />                 zn (+ z0 (* m z))          ;根据起始等高线高程计算取出的单条等高线高程<br />                 pz (list 0 0 zn)           ;将高程组合成坐标<br />            )<br />       (if (= zm 1) (setq mm1 (/ zn 1)))          ;等高距为1时,将高程除1<br />       (if (= zm 2) (setq mm1 (/ zn 2)))          ;等高距为2时,将高程除2<br />       (if (= zm 5) (setq mm1 (/ zn 5)))          ;等高距为5时,将高程除5<br />       (if (= zm 10) (setq mm1 (/ zn 10)))        ;等高距为10时,将高程除10<br />       (if (or (= zm 25) (= zm 2.5)) (progn                             ;等高距为25时<br />                     (setq mm2 (rtos zn 2 0)                    ;转换成字符串<br />                           mm3 (strlen mm2)                 ;提取字符串长度<br />                           mm4 (substr mm2 (- mm3 1) 2)     ;提取字符串最后两位<br />                           mm5 (atof mm4)                   ;将最后两位字符串转换为数值<br />                     ) <br />                     (if (or (= mm5 00) (= mm5 00)) (setq ys 10 lww 0.25))   ;根据高程值确定其颜色和线宽<br />                     (if (or (= mm5 25) (= mm5 2.5)) (setq ys 50 lww 0.13))  ;根据高程值确定其颜色和线宽<br />                     (if (or (= mm5 50) (= mm5 5.0)) (setq ys 90 lww 0.13))  ;根据高程值确定其颜色和线宽<br />                     (if (or (= mm5 75) (= mm5 7.5)) (setq ys 130 lww 0.13)) ;根据高程值确定其颜色和线宽<br />                     )<br />       )  <br />       (if (or (= zm 1) (= zm 2) (= zm 5) (= zm 10)) (progn<br />           (setq mm5 (atof (substr (rtos mm1) (strlen (rtos mm1)) 1))) ;转换成字符串,提取字符串长度,提取字符串最后一位,将最后一位字符串转换为数值<br />           (if (or (= mm5 0) (= mm5 5)) (setq ys 10 lww 0.25))   ;根据高程值确定其颜色和线宽<br />           (if (or (= mm5 1) (= mm5 6)) (setq ys 50 lww 0.13))   ;根据高程值确定其颜色和线宽<br />           (if (or (= mm5 2) (= mm5 7)) (setq ys 90 lww 0.13))   ;根据高程值确定其颜色和线宽<br />           (if (or (= mm5 3) (= mm5 8)) (setq ys 130 lww 0.13))   ;根据高程值确定其颜色和线宽<br />           (if (or (= mm5 4) (= mm5 9)) (setq ys 170 lww 0.13)))   ;根据高程值确定其颜色和线宽<br />       )<br />       (if (= (cdr (nth 1 (entget sl))) "LWPOLYLINE") (progn          ;如果等高线是多段线<br />           (setq pzz0 (* -1 (cdr (assoc 38 (entget sl)))))            ;提取多段线的z值<br />           (command "pedit" sl "s" "" ))                              ;将多段线改为曲线<br />       )<br />       (if (= (cdr (nth 1 (entget sl))) "SPLINE")                     ;如果等高线是样条曲线<br />           (setq pzz0 (* -1 (nth 3 (assoc 10 (entget sl)))))           ;提取样条曲线的z值<br />       )<br />       (if (= (cdr (nth 1 (entget sl))) "POLYLINE")                   ;如果等高线是多段线改成的样条曲线<br />           (setq pzz0 (* -1 (nth 3 (assoc 10 (entget sl)))))           ;提取样条曲线的z值<br />       )<br />       (setq pzz (list 0 0 pzz0))                                     ;根据原等高线的z值组合新的坐标<br />       (if (/= pzz0 0) (command "_move" sl "" pzz ""))                ;用相对法将已赋高程值的等高线归0<br />       (command "_move" sl "" pz "")                                  ;用相对法移动等高线到指定高程<br />       (command "chprop" sl "" "lw" lww "")                           ;根据高程值修改线宽<br />       (vla-put-Color (vlax-ename->vla-object sl) ys)                 ;将等高线改为指定的色号<br />     )  <br />     (setq z00 z zn0 zn)<br />     (setq tt (getstring "\n还要继续吗？(Y/N) <Y>:"))<br />   )    <br />     (setvar "osmode" 35)                                            ;打开捕捉<br />   (princ "所选的等高线高程赋值、改线宽己完成!")<br /> (prin1)<br /> )<br /> (prompt " <<给等高线高程赋值>>启动命令:llzz")<br /> (princ)

温柔女神

大哥，我CAD2002，运行你的程序出错：
错误: no function definition: VLAX-ENAME->VLA-OBJECT
什么原因呢？可能是改变颜色出现问题？

WHGF

这一名可以不要
(vla-put-Color (vlax-ename->vla-object sl) ys)

真龙天子

回温柔女神;(vla-put-Color (vlax-ename->vla-object sl) ys)是XYP班主的通用函数库里的函数,你没装自然就不能用该函数了,现在你用(command "chprop" sl "" "c" ys "") 替代(vla-put-Color (vlax-ename->vla-object sl) ys)就行了.

eachy

2002 下程序前面加上

2. (vl-load-com)

(vl-load-com)

补充一句，vlax-ename->vla-object 不是 xyp 版主函数库的函数，这是 CAD 的 Lisp 函数。

53082329

请问2006里有自动生成等高线的命令吗？

hdgllj

我是菜鸟，请问ＶＬＫ扩展名的文件如何调用啊？

chydraulic

不错，谢谢高手，我这几天在编一个三维地形图自动取端面的程序，我将端面线生产3dface后与等高线用intersectwith函数求交点，但好像不行，看到你将等高线归零后，我想我也可以先提取z后，在归0，再求出交点后，将z用提取的z换掉就可以了。
还有，在判断等高线类型时，将cdr改成cadr，使程序更加规范一点！

qrs

感谢真龙天子，我找了好久类似这样的程序，谢谢了！！ 以后有好东西共享啊