LISP标注路线桩号_CAD插件标桩号的AutoLISP程序语言求解释并译成中文,谢谢

这篇博客介绍了一个使用AutoLISP语言编写的CAD插件,该插件能自动标注路线桩号。用户首先设置图层、颜色和字体等参数,然后选择要标注的曲线,程序将根据选定的起始点和桩号间隔自动标注桩号。程序考虑了桩号位于道路前进方向左侧或右侧的情况,并通过精确的几何计算确定标注位置和角度。
摘要由CSDN通过智能技术生成

该楼层疑似违规已被系统折叠 隐藏此楼查看此楼

标桩号:

(setq dq 0.0)

(setq wf 1.0)

(setq fx 1.0)

(setq th 3.0)

(setq zk 0.7)

(setq dist 50.0)

(setq qszh 0)

(setq lorr 0)

(setq lor "l")

(defun c:bzh ()

(setvar "cmdecho" 0)

(VL-LOAD-COM)

(princ "\n\n\n\n 使用前请预先设置好图层、颜色、字体等作图环境;所标注的须为一条直线或多段线 ")

(setq en (car (entsel "\n选择标注曲线:")))

(while (= nil en)

(setq en (car (entsel "\n选择标注曲线:")))

)

(setq lor (getstring "\n\n\n\n\n [桩号标在道路前进方向[左(l)/右(r)]侧:"))

(if (= lor "l")

(setq lorr 1)

(setq lorr 0)

)

(setq qd (getpoint "\n选取起始点:"))

(while (not (vlax-curve-getDistAtPoint en qd))

(setq qd (getpoint "\n\n\n没有选在标注曲线上,重新选择:"))

)

(if (= nil (setq qszh (getreal "\n起点桩号<0>(m):"))) (setq qszh 0))

(princ "\n\n\n\n 正在进行标注,请稍候... ")

(princ)

(setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))

(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))

(xrbz1)

(princ "\n\n\n\n 道路桩号标注完毕---中国燃气 ")

(princ)

)

(defun xrbz(/)

(if (< zhz 0.0) (setq fh "-") (setq fh "+"))

(setq nn1 (fix (/ zhz 1000.0)))

(setq nn2 (abs(- zhz (* 1000.0 nn1))))

(setq nn3 (fix (/ zhz 50.0)))

(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 0))))

(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))))

(setq str_1 (strcat (rtos nn1 2 0) str_1 ))

(setq str_2 (strcat (strcat "G" fh ) (rtos nn3 2 0)))

(setq ang (a-get-Angle en pt1))

(setq ang (+ (* lorr pi) ang))

;(setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 0.5)))

(setq pt2 pt1)

(setq pt3 (polar pt1 (+ ang (* pi 1.5)) 18))

(setq pt4 (polar pt1 (+ (* pi 1.5) ang) 12))

(setq pt5 (polar pt4 ang 2.5))

(setq pt4 (polar pt4 (+ pi ang) 2.5))

;(if (= wf 1.0)

(setq ang2 (angtos (angle pt3 pt2)0 4) )

(setq ang3 (angtos (angle pt2 pt3)0 4) )

;)

(setq sa (getvar "osmode"))

(setvar "osmode" 0)

(command "line" pt3 pt2 "")

(if (> (car pt3) (car pt2))

(progn

(command "text" "m" pt4 th ang3 str_1 )

(command "text" "m" pt5 th ang3 str_2 );位置,高度,角度,内容

)

)

(if (< (car pt3) (car pt2))

(progn

(command "text" "m" pt5 th ang2 str_1 )

(command "text" "m" pt4 th ang2 str_2 );位置,高度,角度,内容

)

)

(if (= (car pt3) (car pt2))

(progn

(if (< (cadr pt3) (cadr pt2))

(progn

(command "text" "m" pt5 th ang2 str_1 )

(command "text" "m" pt4 th ang2 str_2 );位置,高度,角度,内容

)

(progn

(command "text" "m" pt4 th ang3 str_1 )

(command "text" "m" pt5 th ang3 str_2 );位置,高度,角度,内容

)

)

)

)

(setvar "osmode" sa)

)

(defun xrbz1(/)

(if (< zhz 0.0) (setq fh "-") (setq fh "+"))

(setq nn1 (fix (/ zhz 1000.0)))

(setq nn2 (abs(- zhz (* 1000.0 nn1))))

(setq nn3 (fix (/ zhz 50.0)))

(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 0))))

(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))))

(setq str_1 (strcat (rtos nn1 2 0) str_1 ))

(setq str_2 (strcat(strcat (strcat "G" fh ) (rtos nn3 2 0)) "-1"))

(setq ang (a-get-Angle en pt1))

(setq ang (+ (* lorr pi) ang))

;(setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 0.5)))

(setq pt2 pt1)

(setq pt3 (polar pt1 (+ ang (* pi 1.5)) 18))

(setq pt4 (polar pt1 (+ (* pi 1.5) ang) 12))

(setq pt5 (polar pt4 ang 2.5))

(setq pt4 (polar pt4 (+ pi ang) 2.5))

;(if (= wf 1.0)

(setq ang2 (angtos (angle pt3 pt2)0 4) )

(setq ang3 (angtos (angle pt2 pt3)0 4) )

;)

(setq sa (getvar "osmode"))

(setvar "osmode" 0)

(command "line" pt3 pt2 "")

(if (> (car pt3) (car pt2))

(progn

(command "text" "m" pt4 th ang3 str_1 )

(command "text" "m" pt5 th ang3 str_2 );位置,高度,角度,内容

)

)

(if (< (car pt3) (car pt2))

(progn

(command "text" "m" pt5 th ang2 str_1 )

(command "text" "m" pt4 th ang2 str_2 );位置,高度,角度,内容

)

)

(if (= (car pt3) (car pt2))

(progn

(if (< (cadr pt3) (cadr pt2))

(progn

(command "text" "m" pt5 th ang2 str_1 )

(command "text" "m" pt4 th ang2 str_2 );位置,高度,角度,内容

)

(progn

(command "text" "m" pt4 th ang3 str_1 )

(command "text" "m" pt5 th ang3 str_2 );位置,高度,角度,内容

)

)

)

)

(setvar "osmode" sa)

)

(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

)

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值