欢迎访问 生活随笔!

凯发ag旗舰厅登录网址下载

当前位置: 凯发ag旗舰厅登录网址下载 > 编程资源 > 编程问答 >内容正文

编程问答

lisp标注路线桩号-凯发ag旗舰厅登录网址下载

发布时间:2024/9/19 编程问答 39 豆豆
凯发ag旗舰厅登录网址下载 收集整理的这篇文章主要介绍了 lisp标注路线桩号_cad插件标桩号的autolisp程序语言求解释并译成中文,谢谢 小编觉得挺不错的,现在分享给大家,帮大家做个参考.

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

标桩号:

(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旗舰厅登录网址下载为你收集整理的lisp标注路线桩号_cad插件标桩号的autolisp程序语言求解释并译成中文,谢谢的全部内容,希望文章能够帮你解决所遇到的问题。

如果觉得凯发ag旗舰厅登录网址下载网站内容还不错,欢迎将凯发ag旗舰厅登录网址下载推荐给好友。

  • 上一篇:
  • 下一篇:
网站地图