桩自动编号
哪位帅哥美女有桩自动编号及提取坐标的源码发给小弟一个万分感谢看你头像可不像是小弟的感觉啊，开个玩笑别介意啊。
给你个zml84版主的一个桩号标注的程序。不知对阁下是否有所帮助。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 ;文字高度
TEXT_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 TEXT_COLOR)
(cons 40 TEXT_SIZE)
(cons 1 (rtos ZH 2 3))
(cons 50 ANG)
'(71 . 0)
'(72 . 1)
(cons 11 PT1)
'(73 . 1)
)
)
)
)
;;;================================================*
(princ) newbuser 发表于 2015-1-18 07:57 static/image/common/back.gif
看你头像可不像是小弟的感觉啊，开个玩笑别介意啊。
给你个zml84版主的一个桩号标注的程序。不知对阁下是否 ...
你是中交哪个单位的？ newbuser 发表于 2015-1-18 07:57 static/image/common/back.gif
看你头像可不像是小弟的感觉啊，开个玩笑别介意啊。
给你个zml84版主的一个桩号标注的程序。不知对阁下是否 ...
人是长得有点戳，不过谢了兄弟。 rhww 发表于 2015-1-18 19:15 static/image/common/back.gif
你是中交哪个单位的？
中交一航的，你呢？难道是同一个体系的？ newbuser 发表于 2015-1-18 07:57 static/image/common/back.gif
看你头像可不像是小弟的感觉啊，开个玩笑别介意啊。
给你个zml84版主的一个桩号标注的程序。不知对阁下是否 ...
谢谢!收藏备用! 好东西啊 谢谢啊
页:
[1]