坐标提取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 \选择所需输出的点(point):\ (setq ss (ssget ));;选取坐标点 (setq n (sslength ss ));计算坐标点数量

(setq ff (open (getfiled \文件保存为\保存路径 (setq i 0) (repeat n

(setq spt (ssname ss i )) (setq ept (entget spt))

(if (= (cdr (assoc 0 ept)) \ (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 \指令执行过程不响应

(setq en (entsel \选择高程点:\要求碰选一个高程点 (setq ff (open (getfiled \文件保存为\(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 \(prin1)

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

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

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

;本程序的缺点是不能过滤对象，同时也成为了他的优点；没有限制点的样式，块也可以，点也可以； ;本程序设计保存文件是可以在已有文件中继续添加数据，但是序号不再累积；这样可以判断不同时期选取的数据

(defun c:gcdtq()

(setvar \指令执行过程不响应

(setq ff (open (getfiled \文件保存为\(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\py \pz));输出为CASS数据格式 (write-line pxyz ff);写入文本

(setq en (entsel \选择下一个高程点:\

(setq i (+ i 1)) )

(close file) (prin1) )

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

横断面数据提取(待修改)

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

(setvar \指令执行过程不响应 ;计算方位角

(setq ff (open (getfiled \文件保存为\(setq zh (getreal\请输入桩号：\

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

(setq pt1 (getpoint \拾取纵断面上的一点：\用于确定横断面上的零点位置 (setq x1 (car pt1));给纵断面上一点X赋值x1 (setq y1 (cadr pt1));给纵断面上一点Y赋值y1

(setq pt2 (getpoint \拾取纵断面上的第二点：\用于确定横断面上的零点位置 (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 (

(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值

(setq px2 (sin ang)) (setq px3 (cos ang))

(setq cj (-(* (- py y1) (cos ang)) (* (- px x1) (sin ang))));计算垂直距离(cj) (setq dist (rtos cj 2 0))

(setq pz(rtos (nth 2 pt)));提取测量坐标系Z值 (setq pdz (strcat dist\输出为CASS数据格式 (write-line pdz ff);写入文本

(setq en (entsel \选择下一个高程点:\)

(close file) (prin1) )

(prompt \从CASS中提取高程点或(point)点坐标，* << C:hdm >> *输出横断面数据(平距，高程)**\(prin1)

批量提取CAD中点(point)三维坐标

2010-05-22 23:11:43| 分类： 默认分类 | 标签： |字号大中小 订阅

;该程序主要用于CAD点(point)三维坐标提取，并将数据输出为CASS软件中使用的数据格式 ;输出格式： 点号,,测量Y值，测量X值，测量Z值 例：1,,100.3244,1232,433,25 ;2010-05-17 罗泽钢 中国葛洲坝集团基础工程有限公司 ;命令：plzbsc (defun c:plzbsc()

(princ \选择所需输出的点(point):\ (setq ss (ssget ));;选取坐标点 (setq n (sslength ss ));计算坐标点数量

(setq ff (open (getfiled \文件保存为\保存路径 (setq i 0) (repeat n

(setq spt (ssname ss i )) (setq ept (entget spt))

(if (= (cdr (assoc 0 ept)) \ (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 \只适合point点 << 命令:plzbsc >> *输出格式(点号,, Y，X，Z)**\(prin1)

从CASS提取高程点坐标输出到文本

2010-05-22 23:15:18| 分类： 工程 | 标签：高程点 提取 cass |字号大中小 订阅 :2010-05-17 (defun c:gcdtq()

(setvar \指令执行过程不响应

(setq en (entsel \选择高程点:\要求碰选一个高程点 (setq ff (open (getfiled \文件保存为\(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 \(prin1);

修改后可以实现连续提取2011--02--25 (defun c:gcdtq()

(setvar \指令执行过程不响应

(setq ff (open (getfiled \文件保存为\(setq n 0) (while;循环语句

(setq en (entsel \选择高程点:\要求碰选一个高程点 (redraw (car en) 3);亮显高程点 (setq n(+ n 1))