- UID
- 44608
- 积分
- 371
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- 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] |
|
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园
( 辽ICP备15016793号 )
窥视卡
雷达卡
已领礼包: 
财富等级: 
发表于 2006-8-19 10:56:01
提升卡
置顶卡
沉默卡
变色卡
千斤顶
