坐标提取lisp程序

坐标提取lisp程序

2010-05-17 20:50:07| 分类：工程| 标签：|字号大中小订阅

;该程序主要用于CAD点（point）三维坐标提取，并将数据输出为CASS软件中使用的数据格式;输出格式：点号,,测量Y值，测量X值，测量Z值例：1,,100.3244,1232,433,25

;2010-05-17

;命令：plzbsc

(defun c:plzbsc()

(princ "\n选择所需输出的点（point）:")

(setq ss (ssget ));;选取坐标点

(setq n (sslength ss ));计算坐标点数量

(setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径

(setq i 0)

(repeat n

(setq spt (ssname ss i ))

(setq ept (entget spt))

(if (= (cdr (assoc 0 ept)) "POINT")

(progn

(setq lxyz (cdr (assoc 10 ept)))

(setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符

(setq sy (rtos (nth 0 lxyz)))

(setq sz (rtos (nth 2 lxyz)))

(setq i1 (+ i 1));计算点序号

(setq sn (rtos i1 2 0));将序号实数转换成字符

(setq sxyz (strcat sn",," sy "," sx "," sz))

(write-line sxyz ff)

)

)

(setq i (+ i 1))

);repeat

)

(prompt "* << 命令:plzbsc >> *输出格式（点号,, Y，X，Z）**")

(prin1)

地形图上提取碎步点（高程点）坐标并输出到文本

2010-05-18 08:50:38| 分类：工程| 标签：|字号大中小订阅

利用程序提取地形图上碎步点的三维坐标。并输出到记事本中，

该程序待修改的地方是不能选取点，并输出数据，待改正。

(defun c:gcdtq()

(setvar "cmdecho" 0) ;指令执行过程不响应

(setq en (entsel "选择高程点:")) ;要求碰选一个高程点

(setq ff (open (getfiled "文件保存为" "f:/" "txt" 1) "a"))

(setq en_data (entget (car en))) ;取得元体资料列表

(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt

(setq py(rtos (nth 1 pt)));提取测量坐标Y值

(setq px(rtos (nth 0 pt)));提取测量坐标X值

(setq pz(rtos (nth 2 pt)));提取测量坐标Z值

(setq sxyz (strcat px " " py " " pz))

(write-line sxyz ff)

(prin1)

)

(prompt "*************** << C:gcdtq >> *****************")

(prin1)

连续选取高程点并输出到文本

2010-05-18 15:33:49| 分类：工程| 标签：|字号大中小订阅

;2010-05-18 武赤公路

;用于提取地形图中的高程点（碎步点）坐标，同时可以提取点（point）的坐标

;本程序的缺点是不能过滤对象，同时也成为了他的优点；没有限制点的样式，块也可以，点也可以；

;本程序设计保存文件是可以在已有文件中继续添加数据，但是序号不再累积；这样可以判断不同时期选取的数据

(defun c:gcdtq()

(setvar "cmdecho" 0) ;指令执行过程不响应

(setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "a"))

(setq en (entsel "选择高程点:"));要求碰选一个高程点

(setq i 1);生成序号

(while en

(setq en_data (entget (car en))) ;取得元体资料列表

(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt

(setq py(rtos (nth 1 pt)));提取测量坐标系Y值

(setq px(rtos (nth 0 pt)));提取测量坐标洗X值

(setq pz(rtos (nth 2 pt)));提取测量坐标系Z值

(setq pi(rtos i 2 0))

(setq pxyz (strcat pi",," px "," py "," pz));输出为CASS数据格式

(write-line pxyz ff);写入文本

(setq en (entsel "\n选择下一个高程点<回车结束选择>:"))

(setq i (+ i 1))

)

(close file)

(prin1)

)

(prompt "**从CASS中提取高程点或（point）点坐标，* << C:gcdtq >> *高程点提取**") (prin1)

横断面数据提取（待修改）

2010-05-18 21:59:09| 分类：工程| 标签：|字号大中小订阅

(defun c:hdm()

(setvar "cmdecho" 0) ;指令执行过程不响应

;计算方位角

(setq ff (open (getfiled "文件保存为" "c:/" "hdm" 1) "a"))

(setq zh (getreal"请输入桩号："))

;计算横断面上点到中心线的垂距，数值分正负

(setq pt1 (getpoint "\n拾取纵断面上的一点："));用于确定横断面上的零点位置

(setq x1 (car pt1));给纵断面上一点X赋值x1

(setq y1 (cadr pt1));给纵断面上一点Y赋值y1

(setq pt2 (getpoint "\n拾取纵断面上的第二点："));用于确定横断面上的零点位置

(setq x2 (car pt2));给纵断面上一点X赋值x1

(setq y2 (cadr pt2));给纵断面上一点Y赋值y1

;计算纵断面（pt1->pt2）方位角

(setq j1 (atan (/(- y2 y1) (+(- x2 x1) 0.00000001)))))

(setq j2 (/(* j1 180) pi))

(if (>(- y2 y1) 0)(setq sgn 1));符号判断

(if (=(- y2 y1) 0)(setq sgn 0))

(if (<(- y2 y1) 0)(setq sgn -1))

(setq fwj (+ (- 180(* 90 sgn) j2)));方位角计算

(setq ang (/(* fwj pi) 180))

(setq en (entsel "选择高程点:"));要求碰选一个高程点

(while en

(setq en_data (entget (car en))) ;取得元体资料列表

(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt

(setq py (nth 1 pt));提取测量坐标系Y值

(setq px (nth 0 pt));提取测量坐标洗X值