[LISP程序]：批量输出逐桩坐标及方位角

zml84 · 发表于 2008-12-30 19:11:17

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

<CENTER><H1>2008-12-30批量输出逐桩坐标及方位角.lsp</H1></CENTER>
<SCRIPT LANGUAGE="JavaScript">document.write("最后修改时间: " + document.lastModified)
</SCRIPT>
<HR SIZE=5><PRE>;|;;

1. 点取线
2. 指定起点位置
3. 输入起点桩号
4. 输入间隔间距，输出等间距桩号信息
5. 循环输入加桩桩号，输出加桩信息。

;;|;


(vl-load-com)
(defun C:TT (/ SS EN ENT OBJ LEN TMP ZHN ZHI LST N)
(princ "批量输出逐桩坐标及方位角")
(if (and (setq SS (entsel "\n请点取道路平面设计线: "))
 (setq EN (car SS))
 (setq ENT (entget EN))
 (wcmatch (cdr (assoc 0 ENT)) "LINE,ARC,LWPOLYLINE,SPLINE")
)
(progn
 ;;全局变量初始化
 (if *ZH0*
()
(setq *ZH0* 0.0)
 )
 (if *ZH_JG*
()
(setq *ZH_JG* 20.0)
 )
 ;;路线全长
 (setq OBJ (vlax-ename->vla-object EN))
 (setq LEN (vlax-curve-getdistatpoint
 OBJ
 (vlax-curve-getendpoint OBJ)
 )
 )
 (princ (strcat "***路线全长: " (rtos LEN 2 3)))
 ;;3.起始桩号
 (princ (strcat "\n请输入起始桩号<" (rtos *ZH0* 2 3) ">: "))
 (if (setq TMP (getreal))
(setq *ZH0* TMP)
 )
 (setq ZHN (+ *ZH0* LEN))
 (princ (strcat "***起点桩号: "
 (rtos *ZH0* 2 3)
 " 终点桩号: "
 (rtos ZHN 2 3)
 )
 )
 ;;4.桩号间隔
 (princ (strcat "\n请输入桩号间隔<" (rtos *ZH_JG* 2 3) ">: ")
 )
 (if (and (setq TMP (getreal))
 (> TMP 0.0)
)
(setq *ZH_JG* TMP)
 )
 ;;计算各个桩号处的坐标和方位角
 (setq ZHI (* (1+ (fix (/ (- *ZH0* 1e-4)
 *ZH_JG*
 )
 )
 )
 *ZH_JG*
 )
 LST '()
 )
 (while (<= ZHI ZHN)
(if (setq TMP (ZL-LX-PM-GETPTANG EN (- ZHI *ZH0*)))
 (setq TMP (cons ZHI TMP)
 LST (cons TMP LST)
 )
)
(setq ZHI (+ ZHI *ZH_JG*))

 )
 (setq LST (reverse LST))
 ;;标记中桩桩位
 (ZL-LX-PM-DRAWZZ LST)
;;; ;;在文本窗口打印显示
;;; (princ "\n桩号\t坐标\t\t方位角")
;;; (foreach N LST
;;; (princ "\n")
;;; (princ N)
;;; )
 ;;5.询问是否加桩
 ;;(setq LST '())
 (while (setq ZHI (getreal "\n请输入加桩桩号: "))
(if (and (<= *ZH0* ZHI ZHN)
 (setq TMP (ZL-LX-PM-GETPTANG EN (- ZHI *ZH0*)))
 (setq TMP (cons ZHI TMP))
 )
 (progn
 (ZL-LX-PM-DRAWZZ (list TMP)) ;_标记位置
 (princ "\n")
 (princ TMP)
 (command "-pan"
 "non"
 (nth 1 TMP)
 "non"
 (getvar "VIEWCTR")
 ) ;_移动当前视口
 (setq LST (cons TMP LST))
 )
)
 ) ;_结束 while
 ;;
 ;;在文本窗口打印显示全部信息
 (princ "\n桩号\t坐标\t\t方位角")
 (foreach N LST
(princ "\n")
(princ N)
 )
)
)
(princ)
)
;;;================================================*
;;; 公路路线计算通用函数 *
;;;功能：计算指定里程处的坐标和方位角 *
;;;参数：EN -----表示道路平面设计线的图元名称 *
;;; LC -----里程 *
;;;返回：点的坐标和该点处路线前进方向方位角 *
(vl-load-com)
(defun ZL-LX-PM-GETPTANG (EN LC / OBJ PT LST ANG)
;;将图元名转换为 VLA对象
(setq OBJ (vlax-ename->vla-object EN))
;;距起点距离为LC的点的坐标
(setq PT (vlax-curve-getpointatdist OBJ LC))
;;pt点的切线方向矢量
(setq LST (vlax-curve-getfirstderiv
 OBJ
 (vlax-curve-getparamatpoint
 OBJ
 PT
 )
 )
)
;;计算切线方位角
(setq ANG (atan (/ (cadr LST) (car LST))))
;;(setq ang (+ ang pi ))
;;返回
(list PT ANG)
)
;;;================================================*
;;; 公路路线计算通用函数 *
;;;功能：路线平面绘制中桩 *
;;;参数：LST ----- 存放中桩信息的表 *
;;; '((桩号 坐标 方位角) *
;;; (桩号 坐标 方位角) *
;;; ... *
;;; ) *
;;;返回：点的坐标和该点处路线前进方向方位角 *
(defun ZL-LX-PM-DRAWZZ (LST / N ZH PT ANG PT1)
;;
(setq LINE_LEN 10.0 ;线的长度
 LINE_COLOR
 6 ;线的颜色
 CIRCLE_R 3.0 ;圆的半径
 CIRCLE_COLOR
 6 ;圆的颜色
 TEXT_SIZE 2.5 ;文字高度
 TEST_COLOR
 6 ;文字颜色
)
;;
(foreach N LST
(setq ZH (nth 0 N)
 PT (nth 1 N)
 ANG (nth 2 N)
)
(setq PT1 (polar PT (+ ANG (* 0.5 pi)) LINE_LEN))
;;绘制直线
(entmake (list '(0 . "LINE")
 (cons 10 PT)
 (cons 11 PT1)
 (cons 62 LINE_COLOR)
 )
)
;;绘制圆
(entmake (list '(0 . "CIRCLE")
 (cons 10 PT)
 (cons 40 CIRCLE_R)
 (cons 62 CIRCLE_COLOR)
 )
)
;;绘制文字
(entmake (list '(0 . "TEXT")
 (cons 10 PT1)
 (cons 62 CIRCLE_COLOR)
 (cons 40 TEXT_SIZE)
 (cons 1 (rtos ZH 2 3))
 (cons 50 ANG)
 '(71 . 0)
 '(72 . 1)
 (cons 11 PT1)
 '(73 . 1)
 )
)
)
)
;;;================================================*
(princ)
</PRE>

zml84 · 发表于 2008-12-30 19:12:08

登录/注册后可看大图

http://zml84.blog.sohu.com/106910115.html

zhuxiaoming · 发表于 2008-12-30 19:50:22

试问楼主，可以把这小程序发给我用用不，有爱心请联系251765120

兰心儿 · 发表于 2008-12-30 20:06:22

最初由 zhuxiaoming 发布
[B]试问楼主，可以把这小程序发给我用用不，有爱心请联系251765120 [/B]

程序不都已经贴出来了麻

kmdz · 发表于 2008-12-31 09:22:52

楼主是做公路设计的？怎么这里面好像没什么水工方面的资料啊？能不能在有空的时候整点水工方面的，或者是定义自动标注尺寸，标高类的（一个由lisp生成的图），我这方面还很差，现在只能编画的，不知道标高和标注尺寸应该从哪方面下手，想找个例子，简单的图形都行，有个例子就好办了。

zzczlh0511 · 发表于 2008-12-31 21:22:10

哈哈，下来比较一下，谢谢了

JH9981 · 发表于 2009-1-3 19:39:47

平面曲线用什么画

zml84 · 发表于 2009-1-4 08:28:34

登录/注册后可看大图

JH9981 · 发表于 2009-1-4 14:07:42

请点取道路平面设计线:
我试了直线画不行、多段线画也不行、迷惘。。。。。。。。

zml84 · 发表于 2009-1-5 09:02:17

最初由 JH9981 发布
[B]请点取道路平面设计线:
我试了直线画不行、多段线画也不行、迷惘。。。。。。。。 [/B]

不行？
"LINE,ARC,LWPOLYLINE,SPLINE"

JH9981 · 发表于 2009-1-5 09:22:49

我加载程序后,命令行运行TT,出现请点取道路平面设计线:
我试了直线画不行、多段线画也不行,见下图。
是不是还要加载另外程序

beiwenxiao · 发表于 2009-1-5 18:48:02

果然有高手

zml84 · 发表于 2009-1-6 11:36:04

最初由 JH9981 发布
[B]我加载程序后,命令行运行TT,出现请点取道路平面设计线:
我试了直线画不行、多段线画也不行,见下图。
是不是还要加载另外程序 [/B]

1.不需要加载其它东西。

2.你的acad版本？

JH9981 · 发表于 2009-1-6 13:29:53

最初由 zml84 发布
[B]

1.不需要加载其它东西。

2.... [/B]

2004

男人可贵 · 发表于 2009-1-11 21:46:11

这觉得这个程序用处不大啊?现在都用全站仪了,在CAD把坐标提取出来就行了.

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：批量输出逐桩坐标及方位角

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子