該樓層疑似違規(guī)已被系統(tǒng)折疊?隱藏此樓查看此樓

標(biāo)樁號：

(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 使用前請預(yù)先設(shè)置好圖層、顏色、字體等作圖環(huán)境;所標(biāo)注的須為一條直線或多段線 ")

(setq en (car (entsel "\n選擇標(biāo)注曲線:")))

(while (= nil en)

(setq en (car (entsel "\n選擇標(biāo)注曲線:")))

)

(setq lor (getstring "\n\n\n\n\n [樁號標(biāo)在道路前進(jìn)方向[左(l)/右(r)]側(cè):"))

(if (= lor "l")

(setq lorr 1)

(setq lorr 0)

)

(setq qd (getpoint "\n選取起始點(diǎn)："))

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

(setq qd (getpoint "\n\n\n沒有選在標(biāo)注曲線上，重新選擇："))

)

(if (= nil (setq qszh (getreal "\n起點(diǎn)樁號<0>(m):"))) (setq qszh 0))

(princ "\n\n\n\n 正在進(jìn)行標(biāo)注，請稍候... ")

(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 道路樁號標(biāo)注完畢---中國燃?xì)?")

(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 );位置，高度，角度，內(nèi)容

)

)

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

(progn

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

(command "text" "m" pt4 th ang2 str_2 );位置，高度，角度，內(nèi)容

)

)

(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 );位置，高度，角度，內(nèi)容

)

(progn

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

(command "text" "m" pt5 th ang3 str_2 );位置，高度，角度，內(nèi)容

)

)

)

)

(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 );位置，高度，角度，內(nèi)容

)

)

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

(progn

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

(command "text" "m" pt4 th ang2 str_2 );位置，高度，角度，內(nèi)容

)

)

(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 );位置，高度，角度，內(nèi)容

)

(progn

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

(command "text" "m" pt5 th ang3 str_2 );位置，高度，角度，內(nèi)容

)

)

)

)

(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

)

總結(jié)

以上是生活随笔為你收集整理的LISP标注路线桩号_CAD插件标桩号的AutoLISP程序语言求解释并译成中文，谢谢的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。