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