- UID
- 44608
- 积分
- 369
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-4-23
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
对直线,多义线进行桩号标注,标注与线的方向有关系,桩号标注是根据我们单位的设计习惯编制,如果不习惯请自己修改代码!对于多段直线的情况,请转换为多线段再操作!
2006年8月22日增加输入起始桩号功能,可是由于时间紧迫,有事出差,所以起始桩号最好是你桩号间距的整数倍,否则后果很严重,结果很糟糕!
2006.09.02修改删除原来桩号的代码,更加快捷。修改起始桩号问题。改变字体及桩号间距设置情况,如果设置运行sz。
2006.09.09程序定型,可以选择标注方向,文字方向,起始点,起始桩号,桩号前缀以及千米桩号在破桩位是否标注等等。
[PHP]
;;;;;以下信息请在转载,修改的时候保留,谢谢!
;;;;;作者:dabingrain,网络硬盘:dabingrain.ys168.com,信箱:dabingrain@163.com
(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 dist 20.0)
(setq qszh 0.0)
(setq qz "")
(setq qmw 0)
(prompt "\n标注桩号,加载命令:bz,设置(SZ)。")
(defun c:bz ()
(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没有选在标注曲线上,重新选择:"))
)
(if (= nil (setq qszh (getreal "\n起点桩号<0>:"))) (setq qszh 0))
(setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))
(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 "000" )))
(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))))
(if (= qmw 0)
(if (= (fix (/ nn2 100.0)) (/ nn2 100.0))
(progn
(setq str_1 (strcat (rtos nn1 2) 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 0.5)))
(setq pt3 (polar pt1 (+ ang (* pi 1.5)) (* th 0.5)))
(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" pt4 th ang2 str_1 )
)
(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))
)
)
)
[/PHP] |
|