wzs_ls 发表于 2009-6-8 22:21:00

[原创]提取等高线生成cass下的DAt

<p><br/>(defun c:dfd()<br/>&nbsp; ;本程序分为两个部分，&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; By&nbsp; 老四<br/>&nbsp; ;1---将线按一定距离进行等分<br/>&nbsp; (setvar "cmdecho" 0)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;取消命令显示<br/>&nbsp; (setq juli (GETINT "\n 输入等分距离:"))<br/>&nbsp; (command "layer" "m" "DGXD" "color" "red" "" "")<br/>&nbsp; (SETQ ss1 (SSGET&nbsp; '((0 . "LWPOLYLINE"))))<br/>&nbsp;&nbsp; (setq gs (sslength ss1))&nbsp;&nbsp;&nbsp;&nbsp; ;获取选择集中对象的数目<br/>&nbsp;&nbsp; (setq n 0)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;设置图元初始个数，并逐个读取<br/>&nbsp;&nbsp; (repeat gs<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq name (ssname ss1 n))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "MEASURE" name juli )&nbsp;&nbsp; ;逐等分距离分点<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n (1+ n))<br/>&nbsp; ))</p><p>;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%</p><p><br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;提取线上顶点的坐标（带高程）生成南方格式<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;可以提取多段线、二维多段线、三维多段线的坐标和高程<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;根据线的特征修改程序------有标高的和顶点带高程的<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;仔细阅读以下程序根据需要修改相应参数<br/>(vl-load-com)<br/>(defun c:tqzb ()<br/>&nbsp; (SETQ plx (SSGET)) <br/>&nbsp; (setq gs (sslength plx))<br/>&nbsp; (setq nn 0)<br/>&nbsp; (setq file (open "d:\\坐标.dat" "w"))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;根据需要选择存放目录<br/>&nbsp; (while (&gt; gs nn)<br/>&nbsp;&nbsp;&nbsp; (setq ent (ssname plx nn))<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; ;提取线上坐标主程序&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq obj (vlax-ename-&gt;vla-object ent))<br/>&nbsp;&nbsp;&nbsp;&nbsp; ;(setq zgc (itoa (fix (vla-get-Elevation obj))))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;有标高的情况&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq plist (vlax-safearray-&gt;list (vlax-variant-value (vla-get-coordinates obj))))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq n 0)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (repeat (/ (length plist) 3)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;设定步长&nbsp;&nbsp;&nbsp;&nbsp; 多段线(用3) 二维线(用2)&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;(setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;输出的是列表形式<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq xzb (rtos (nth (1+ n) plist)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq yzb (rtos (nth n plist)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq zgc (rtos (nth (+ 2 n) plist)))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;顶点带高程的情况 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ (strcat "3,," yzb "," xzb "," zgc) file)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ "\n" file)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n (+ n 3))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;设定步长&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 多段线(用3) 二维线(用2)&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;;提取线上坐标主程序结束<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq nn (+ nn 1))<br/>&nbsp;)<br/>&nbsp; (close file)<br/>)<br/></p>

8350 发表于 2009-6-10 21:14:00

<p>顶，收下！</p>

xiewawa 发表于 2010-1-29 02:14:00

谢谢！！！

461045462 发表于 2011-1-12 10:32:20

谢谢楼主的分享
收藏试试，学习学习

sy100 发表于 2011-1-31 23:12:46

谢谢！学习一下。

hnzx 发表于 2011-3-5 09:58:31

谢谢！学习一下。

hounengwei 发表于 2011-6-8 04:52:42

谢谢！学习一下。

就一小卒 发表于 2011-6-8 06:38:11

学习交流~~~

zbwei120 发表于 2011-9-10 00:31:36

试了一下，发现有时坐标提取是错误的
同时对由cass做出的等高线倒是不认识。

xiewawa 发表于 2012-2-22 22:34:08

谢谢楼主，学习了继续努力
页: [1] 2
查看完整版本: [原创]提取等高线生成cass下的DAt