lisp标注路线桩号-ag凯发k8国际
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
标桩号：
(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
)
总结
以上是ag凯发k8国际为你收集整理的lisp标注路线桩号_cad插件标桩号的autolisp程序语言求解释并译成中文，谢谢的全部内容，希望文章能够帮你解决所遇到的问题。
- 上一篇：
- 下一篇：