道路桩号标注(批量标注、任意点标注)
本帖最后由 skg123 于 2014-8-26 20:35 编辑做公路的同行常常需要标注公路的中桩号，本人结合自己的需要在别人的程序上修改了标注程序。
批量标注，可以按照要求的间距标注，首尾保留小数。将中桩坐标写入文本
;By Zo Roo CGGC 基础公司
;By zo roo 葛洲坝基础公司
;2010-5-9 修改了小数保留位数（保留0位）
;2011-6-15修改了尾桩号小数位数（保留3位）；设置捕捉，标注线不乱连接，增加桩号步长设置。
(terpri)
(If (= (Tblsearch "layer" "道路桩号") nil)
(Command "layer" "m" "道路桩号" "c" 7 "道路桩号" "")
)
(If (= (Tblsearch "layer" "道路中心线") nil)
(Command "layer" "m" "道路中心线" "c" 1 "道路中心线" "")
)
(setq dq 0.0)
(setq wf 1.0)
(setq fx 1.0)
(setq th 2.0)
(setq zk 0.67)
(Command "-style" "道路桩号" "仿宋_GB2312" "" zk """n" "n")
(setq qszh 0.0)
(setq qz "")
(setq qmw 0)
(vl-load-com)
(prompt "\n批量标注桩号,加载命令:plbzzh,设置(SZ)。By 罗泽钢 葛洲坝基础公司")
(defun c:plbzzh()
(setvar "cmdecho" 0)
(setq ff (open (getfiled "文件保存为" "c:/" "dat" 1) "a"))
(bzzh)
);修改于2012-01-11增加了将数据写入文本
(defun bzzh()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq FltLst '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC")))
(princ "\n\n\n\n 请先把预标注的曲线(多段线)连接在一起,如果已经连接好，回车跳过即可 ")
(setq SelSet (cond ((ssget "_I" FltLst)) ((ssget FltLst))))
(if (/= nil selset) (command "change" SelSet "" "p" "la" "道路中心线" ""))
(if (/= nil selset)
(if (> (sslength selset) 1)
(command "_.PEDIT" "_M" SelSet "" "_Y" "_J" "_J" "_B" "0" "")
)
)
(setq en (car (entsel "\n选择标注曲线:")))
(while (= nil en)
(setq en (car (entsel "\n选择标注曲线:")))
)
(if (vlax-curve-isClosed en)
(progn
(print "曲线为环路！请先打开个缺口！")
(exit)
)
)
(redraw en 3)
(command "change" en "" "p" "la" "道路中心线" "")
(setq qd (getpoint "\n选取已知点："))
(while (not (vlax-curve-getDistAtPoint en qd))
(setq qd (getpoint "\n\n\n没有选在标注曲线上，重新选择："))
)
(setq leng (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en) ));;;道路总长
(if (= nil (setq qszh (getreal "\n请输入已知点桩号<0>:"))) (setq qszh 0))
(if (= nil (setq dist (getreal "\n请输入桩号间距<20>:"))) (setq dist 20))
(setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))
(setvar "osmode" 0) ;关闭捕捉
(command "._erase" (ssget "x" (list (cons 8 "道路桩号"))) "") (setq pzh (fix(/ qszh dist)))
(setq pzh (- qszh (* pzh dist)))
(if (= fx 1.0)
(setq pt1 (vlax-curve-getStartPoint en))
(setq pt1 (vlax-curve-getEndPoint en))
)
(if (= fx 1.0)
(setq zhz 0)
(setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
)
(setq zhz (+ zhz (* qszh fx)))
(setq zhz (* zhz fx))
(xrbz)
(setq nn 0)
(while
(setq pt1 (vlax-curve-getPointAtDist en (abs(- (* nn (* dist fx)) pzh))))
(setq zhz (* nn (* dist fx)))
(setq zhz (+ zhz (- qszh pzh)))
(xrbz)
(setq nn (1+ nn))
)
(if (= fx 1.0)
(setq pt1 (vlax-curve-getEndPoint en))
(setq pt1 (vlax-curve-getStartPoint en))
)
(if (= fx 1.0)
(setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
(setq zhz 0)
)
(setq zhz (+ zhz (* qszh fx)))
(setq zhz (* zhz fx))
(xrbz)
)
(defun xrbz(/)
(Command "layer" "s" "道路桩号""")
(if (< zhz 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ zhz 1000.0)))
(setq nn2 (abs(- zhz (* 1000.0 nn1))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "000" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 0))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 0))))
(if(= zhz leng)(setq str_1 (strcat fh (rtos nn2 2 3)))) ;;修改部分2011-06-14
(if (= qmw 0)
(if (=(fix (/ nn2 100.0)) (/ nn2 100.0))
(progn
(setq str_1 (strcat "K" (rtos nn1 2 0)str_1 ))
(setq str_1 (strcat qz str_1 ))
)
)
(progn
(setq str_1 (strcat (rtos nn1 2)str_1 ))
(setq str_1 (strcat qz str_1 ))
)
)
(setq ang (a-get-Angle en pt1))
(setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 2.2)))
(setq pt3 (polar pt1 (+ ang (* pi 1.5)) (* th 1)))
(setq st1 (substr str_1 1 1))
(if (/=st1 fh)
(progn
(if (= wf 1.0)
(setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.65406 zk))))
(setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.65406 zk))))
)
)
(progn
(if (= wf 1.0)
(setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.3582 zk))))
(setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.3582 zk))))
)
)
)
(command "line" pt3 pt2 "")
(if (= wf 1.0)
;(setq ang2 (angtos (angle pt1 pt2)0 4) )
(setq ang2 (angtos (angle pt2 pt1)0 4) )
)
(command "text" "bc"pt1 th ang2 str_1 ) ;2014-08-26
(setq x01 (car pt1))
(setq y01 (cadr pt1))
(setq str_1 (strcat (rtos zhz 2 3)",," (rtos y01 2 3) "," (rtos x01 2 3)",0"))
(write-line str_1 ff);中桩写入文本(2012-01-10修改)
(write-line str_1 );显示中桩桩号坐标(2012-01-10修改)
(princ)
)
(setvar "osmode" 703) ;恢复捕捉
(defun a-get-Angle(ename point / p1 v1 pt-ang)
(setq v1 (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename point))
p1 (mapcar '+ point v1)
pt-ang (angle point p1))
pt-ang
)
(defun c:sz ()
(setq xz 1)
(while (/= xz "")
(setq xz (getstring "\n\n\n\n [回车退出/文字高度(H)/文字宽度比例(B)/桩号间距(J)/桩号标注方向(F)/文字方向(X)/前缀(Z)/千米位(Q)]:"))
(cond
((= xz "H") "h")
((= xz "B") "b")
((eq xz "J") "j")
((eq xz "F") "f")
((eq xz "X") "x")
((eq xz "Z") "z")
((eq xz "Q") "q")
(T xz)
)
(if (= xz nil) exit)
(if (= xz "h")
(progn
(setq str_2 (strcat "\n\n\n\n 文字高度<" (rtos (getvar "textsize") 2) ">:"))
(setq th (getreal str_2))
(if (= th nil) (setq th (getvar "textsize")))
)
)
(if (= xz "b")
(progn
(setq zk (getreal "\n\n\n\n\n [文字宽高比例]<0.67>:"))
(if (= zk nil)(setq zk 0.67))
(Command "-style" "道路桩号" "仿宋_GB2312" "" zk """n" "n")
)
)
(if (= xz "j")
(if (= nil (setq dist (getreal "\n\n\n\n\n [桩号间距]<20>:"))) (setq dist 20.0))
)
(if (= xz "f")
(progn
(setq fxxz (getstring "\n\n\n\n\n [桩号标注方向[正(Z)/反(F)]<Z>:"))
(if (= fxxz nil) (setq fxxz "z"))
(if (= fxxz "z")
(setq fx 1.0)
(setq fx -1.0)
)
(setq wf (* wf fx))
)
)
(if (= xz "x")
(progn
(if (= nil (setq WZFX (getstring "\n\n\n\n\n 文字方向[前进(Q)/后退(H)]<Q>:"))) (setq WZFX "q"))
(if (= wzfx "q")
(setq wf 1.0)
(setq wf -1.0)
)
)
)
(if (= xz "z")
(setq qz (getstring "\n\n\n\n\n 前缀(去除前缀请直接回车):"))
)
;;;(initget 1 "1 0")
(if (= xz "q")
(if (= nil (setq qmw (getint "[整百桩位标注(0)/全部标注(1)]<0>:"))) (setq qmw 0))
)
)
)
任意点桩号标注
(vl-load-com)
(vl-load-com)
(defun c:zhcx ();桩号查询
(prompt "2010-07-27 zo rooCGGC 武赤公路")
(prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
(setq old_lay (getvar "clayer"))
(if (=(tblobjname "LAYER" "桩号标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "桩号标注")
)
)
)
)
(setvar "clayer" "桩号标注")
(setq en(entsel "\n选择道路中心线: ")
a (getreal "\n请输入起点桩号:")
e (car en)
pt(cadr en)
)
(if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制
(progn
(setq OBJ (vlax-ename->vla-object (car en)))
)
)
(while (setq pt0 (getPoint "\n选择查询点："))
;画曲线的垂线
(setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
LST (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
ANG (atan (/ (cadr LST) (car LST)))
pt1 (polar Perpt (+ ANG (* 0.5 pi)) len)
pt2 (polar Perpt (- ANG (* 0.5 pi)) len)
;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(setq ang2 (angtos (angle pt2 pt1)0 4) )
(command "pline" pt1 pt2 "")
;计算桩号
(setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
leng2 (- leng leng1)
)
;计算桩号
(if (< leng1 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ leng1 1000.0 )))
(setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 3))))
(setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
(setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt4 "0.3" ang2 str_1)
(setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
(setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
(setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
(princ pxy)
)
(princ)
)
本帖最后由 skg123 于 2014-8-29 09:36 编辑
;By luozegang 葛洲坝基础公司
;2010-5-9 修改了小数保留位数（保留0位）
;2011-6-15修改了尾桩号小数位数（保留3位）；设置捕捉，标注线不乱连接，增加桩号步长设置。
(terpri)
(If (= (Tblsearch "layer" "道路桩号") nil)
(Command "layer" "m" "道路桩号" "c" 1 "道路桩号" "")
)
(If (= (Tblsearch "layer" "道路中心线") nil)
(Command "layer" "m" "道路中心线" "c" 1 "道路中心线" "")
)
(setq dq 0.0)
(setq wf 1.0)
(setq fx 1.0)
(setq th 2.0)
(setq zk 0.67)
(Command "-style" "道路桩号" "仿宋_GB2312" "" zk """n" "n")
(setq qszh 0.0)
(setq qz "")
(setq qmw 0)
(vl-load-com)
(prompt "\n批量标注桩号,加载命令:plbzzh,设置(SZ)。By luozegang 葛洲坝基础公司")
(defun c:plbzzh()
(setvar "cmdecho" 0)
(setq ff (open (getfiled "文件保存为" "c:/" "dat" 1) "a"))
(bzzh)
);修改于2012-01-11增加了将数据写入文本
(defun bzzh()
(setvar "osmode" 703) ;恢复捕捉
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq FltLst '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC")))
(princ "\n\n\n\n 请先把预标注的曲线(多段线)连接在一起,如果已经连接好，回车跳过即可 ")
(setq SelSet (cond ((ssget "_I" FltLst)) ((ssget FltLst))))
(if (/= nil selset) (command "change" SelSet "" "p" "la" "道路中心线" ""))
(if (/= nil selset)
(if (> (sslength selset) 1)
(command "_.PEDIT" "_M" SelSet "" "_Y" "_J" "_J" "_B" "0" "")
)
)
(setq en (car (entsel "\n选择标注曲线:")))
(while (= nil en)
(setq en (car (entsel "\n选择标注曲线:")))
)
(if (vlax-curve-isClosed en)
(progn
(print "曲线为环路！请先打开个缺口！")
(exit)
)
)
(redraw en 3)
(command "change" en "" "p" "la" "道路中心线" "")
(setq qd (getpoint "\n选取已知点："))
(while (not (vlax-curve-getDistAtPoint en qd))
(setq qd (getpoint "\n\n\n没有选在标注曲线上，重新选择："))
)
(setq leng (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en) ));;;道路总长
(if (= nil (setq qszh (getreal "\n请输入已知点桩号<0>:"))) (setq qszh 0))
(if (= nil (setq dist (getreal "\n请输入桩号间距<20>:"))) (setq dist 20))
(setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))
(setvar "osmode" 0) ;关闭捕捉
; (command "._erase" (ssget "x" (list (cons 8 "道路桩号"))) "") ;删除这段代码，可以实现（分次）多条线段标注，不删除只能一个图标注一次
(setq pzh (fix(/ qszh dist)))
(setq pzh (- qszh (* pzh dist)))
(if (= fx 1.0)
(setq pt1 (vlax-curve-getStartPoint en))
(setq pt1 (vlax-curve-getEndPoint en))
)
(if (= fx 1.0)
(setq zhz 0)
(setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
)
(setq zhz (+ zhz (* qszh fx)))
(setq zhz (* zhz fx))
(xrbz)
(setq nn 0)
(while
(setq pt1 (vlax-curve-getPointAtDist en (abs(- (* nn (* dist fx)) pzh))))
(setq zhz (* nn (* dist fx)))
(setq zhz (+ zhz (- qszh pzh)))
(xrbz)
(setq nn (1+ nn))
)
(if (= fx 1.0)
(setq pt1 (vlax-curve-getEndPoint en))
(setq pt1 (vlax-curve-getStartPoint en))
)
(if (= fx 1.0)
(setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
(setq zhz 0)
)
(setq zhz (+ zhz (* qszh fx)))
(setq zhz (* zhz fx))
(xrbz)
)
(defun xrbz(/)
(Command "layer" "s" "道路桩号""")
(if (< zhz 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ zhz 1000.0)))
(setq nn2 (abs(- zhz (* 1000.0 nn1))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "000" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 0))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 0))))
(if(= zhz leng)(setq str_1 (strcat fh (rtos nn2 2 3)))) ;;修改部分2011-06-14
(if (= qmw 0)
(if (=(fix (/ nn2 100.0)) (/ nn2 100.0))
(progn
(setq str_1 (strcat "K" (rtos nn1 2 0)str_1 ))
(setq str_1 (strcat qz str_1 ))
)
)
(progn
(setq str_1 (strcat(rtos nn1 2)str_1 )) ;
(setq str_1 (strcat qz str_1 ))
)
)
(setq ang (a-get-Angle en pt1))
(setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 1))) ;垂线的左边点
(setq pt3 (polar pt1 (+ ang (* pi 1.5)) (* th 1))) ;垂线的右边点（文字中心点）
(setq st1 (substr str_1 1 1))
(if (/=st1 fh)
(progn
(if (= wf 1.0)
(setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.65406 zk))))
(setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.65406 zk))))
)
)
(progn
(if (= wf 1.0)
(setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.3582 zk))))
(setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.3582 zk))))
)
)
)
(command "line" pt1 pt2 "")
(if (= wf 1.0)
(setq ang2 (angtos (+ (angle pt2 pt1) (/ pi 2))0 4) ) ;桩号文字角度2014-08-26
)
(command "text" "bc" pt2 thang2 str_1 ) ;文字“中下”对中
(setq x01 (car pt1))
(setq y01 (cadr pt1))
(setq str_1 (strcat (rtos zhz 2 3)",," (rtos y01 2 3) "," (rtos x01 2 3)",0"))
(write-line str_1 ff);中桩写入文本(2012-01-10修改)
(write-line str_1 );显示中桩桩号坐标(2012-01-10修改)
(princ)
)
(defun a-get-Angle(ename point / p1 v1 pt-ang)
(setq v1 (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename point))
p1 (mapcar '+ point v1)
pt-ang (angle point p1))
pt-ang
)
(defun c:sz ()
(setq xz 1)
(while (/= xz "")
(setq xz (getstring "\n\n\n\n [回车退出/文字高度(H)/文字宽度比例(B)/桩号间距(J)/桩号标注方向(F)/文字方向(X)/前缀(Z)/千米位(Q)]:"))
(cond
((= xz "H") "h")
((= xz "B") "b")
((eq xz "J") "j")
((eq xz "F") "f")
((eq xz "X") "x")
((eq xz "Z") "z")
((eq xz "Q") "q")
(T xz)
)
(if (= xz nil) exit)
(if (= xz "h")
(progn
(setq str_2 (strcat "\n\n\n\n 文字高度<" (rtos (getvar "textsize") 2) ">:"))
(setq th (getreal str_2))
(if (= th nil) (setq th (getvar "textsize")))
)
)
(if (= xz "b")
(progn
(setq zk (getreal "\n\n\n\n\n [文字宽高比例]<0.67>:"))
(if (= zk nil)(setq zk 0.67))
(Command "-style" "道路桩号" "仿宋_GB2312" "" zk """n" "n")
)
)
(if (= xz "j")
(if (= nil (setq dist (getreal "\n\n\n\n\n [桩号间距]<20>:"))) (setq dist 20.0))
)
(if (= xz "f")
(progn
(setq fxxz (getstring "\n\n\n\n\n [桩号标注方向[正(Z)/反(F)]<Z>:"))
(if (= fxxz nil) (setq fxxz "z"))
(if (= fxxz "z")
(setq fx 1.0)
(setq fx -1.0)
)
(setq wf (* wf fx))
)
)
(if (= xz "x")
(progn
(if (= nil (setq WZFX (getstring "\n\n\n\n\n 文字方向[前进(Q)/后退(H)]<Q>:"))) (setq WZFX "q"))
(if (= wzfx "q")
(setq wf 1.0)
(setq wf -1.0)
)
)
)
(if (= xz "z")
(setq qz (getstring "\n\n\n\n\n 前缀(去除前缀请直接回车):"))
)
;;;(initget 1 "1 0")
(if (= xz "q")
(if (= nil (setq qmw (getint "[整百桩位标注(0)/全部标注(1)]<0>:"))) (setq qmw 0))
)
)
) 感谢楼主程序，如果能加上特征点：如直园 圆缓 缓园 曲中 共切点 直缓 缓直点等等 ZY ZH HY HZ QZ HY YH 楼主你好，请问代码怎么修改可以使每个中桩标注不省略'Ki',比如K2+240，而不是+240 楼主的分享精神值得肯定 zyhandw 发表于 2012-12-18 11:38 static/image/common/back.gif
楼主的分享精神值得肯定
在 明经论坛 里学了很多东西，也得到 论坛会员的帮助。
分享我的东西是对明经的支持 skg123 发表于 2012-12-18 11:42 static/image/common/back.gif
在 明经论坛 里学了很多东西，也得到 论坛会员的帮助。
分享我的东西是对明经的支持
不知道LZ还不能能更新下去
把任意点桩号继续完善能生成纬地的WID格式？ 任意点桩号标注中，为什么桩号标注出来是K0+9,而不是K0+009,要怎么改一下才可以在前面自动加0
谢谢楼主。。。。