公路测绘求助：进一步完善公路线路画法线标桩号（附源码）
原来贴了一个：求高手看看“沿曲线标注桩号”的小问题http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87961&fromuid=280412
现在想继续升级此LISP，毕竟搞公路测绘的也经常用它。原来程序提示：字高？选择线路？间距？现在想这样：选择线路中线？（圆，直线，缓和曲线等多个线元组成的一条PL线，）-指定起点？-该点里程？（默认为0）-法线长度？（默认为20）-0两侧画1左侧画2右侧画？（默认为0）-0批量1指定里程（默认为0）-字高（默认字高0.2）。当选择批量的时候，再询问间距。指定里程的时候，只需输入里程数值，在相应的位置画一条法线。是不是要求高了，还请高手修改为盼！ 上回高手改了的源码，还请继续升级！
(defun c:www ()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq
str_2 (strcat "\n给定文字高度<" (rtos (getvar "textsize") 2) ">:")
)
(setq th (getreal str_2))
(if (= th nil)
(setq th (getvar "textsize"))
)
(if (setq en (car (entsel "\n选择路径曲线:")))
(redraw en 3)
(*error* "\n没有选到曲线!")
)
(if (= nil (setq dist (getreal "\n给定间距<50m>:")))
(setq dist 50.0)
)
(setq objen (vlax-ename->vla-object en))
(setq objen_l (vlax-curve-getDistAtPoint
objen
(vlax-curve-getEndPoint objen)
)
)
(setq nn (fix (/ objen_l dist)))
(repeat nn
(setq pt1 (vlax-curve-getPointAtDist objen (* nn dist)))
(setq zhz (* nn dist))
(if (< zhz 1000.0)
(setq str_1 (strcat "K0+" (rtos zhz 2 3) "m"))
)
(if (>= zhz 1000.0)
(progn
(setq nn1 (fix (/ zhz 1000.0)))
(setq nn2 (- zhz (* 1000.0 nn1)))
(setq str_1 (strcat "K" (rtos nn1 2) "+" (rtos nn2 2 3) "m"))
(if (= nn2 0.0)
(setq str_1 (strcat "K" (rtos nn1 2) "+000m"))
)
)
)
(setq ang (a-get-Angle objen pt1))
(setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
(setq nn (1- nn))
)
;; (redraw en 4)
(setvar "osmode" os)
(princ)
)
;;切线角度pt-ang
(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:www ()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq
str_2 (strcat "\n给定文字高度<" (rtos (getvar "textsize") 2) ">:")
)
(setq th (getreal str_2))
(if (= th nil)
(setq th (getvar "textsize"))
)
(if (setq en (car (entsel "\n选择路径曲线:")))
(redraw en 3)
(*error* "\n没有选到曲线!")
)
(if (= nil (setq dist (getreal "\n给定间距<50m>:")))
(setq dist 50.0)
)
(setq objen (vlax-ename->vla-object en))
(setq objen_l (vlax-curve-getDistAtPoint
objen
(vlax-curve-getEndPoint objen)
)
)
(setq pt1 (vlax-curve-getstartpoint objen))
(setq ang (a-get-Angle objen pt1))
(setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 "K0+000m")
(setq nn (fix (/ objen_l dist)))
(repeat nn
(setq pt1 (vlax-curve-getPointAtDist objen (* nn dist)))
(setq zhz (* nn dist))
(if (< zhz 1000.0)
(setq str_1 (strcat "K0+" (rtos zhz 2 3) "m"))
)
(if (>= zhz 1000.0)
(progn
(setq nn1 (fix (/ zhz 1000.0)))
(setq nn2 (- zhz (* 1000.0 nn1)))
(setq str_1 (strcat "K" (rtos nn1 2) "+" (rtos nn2 2 3) "m"))
(if (= nn2 0.0)
(setq str_1 (strcat "K" (rtos nn1 2) "+000m"))
)
)
)
(setq ang (a-get-Angle objen pt1))
(setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
(setq nn (1- nn))
)
(setq zhz (vlax-curve-getDistAtPoint
objen
(vlax-curve-getendpoint objen)
)
)
(if (< zhz 1000.0)
(setq str_1 (strcat "K0+" (rtos zhz 2 3) "m"))
)
(if (>= zhz 1000.0)
(progn
(setq nn1 (fix (/ zhz 1000.0)))
(setq nn2 (- zhz (* 1000.0 nn1)))
(setq str_1 (strcat "K" (rtos nn1 2) "+" (rtos nn2 2 3) "m"))
(if (= nn2 0.0)
(setq str_1 (strcat "K" (rtos nn1 2) "+000m"))
)
)
)
(setq pt1 (vlax-curve-getendpoint objen))
(setq ang (a-get-Angle objen pt1))
(setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
;; (redraw en 4)
(setvar "osmode" os)
(princ)
)
;;切线角度pt-ang
(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
)
不过这个程序还有点小缺陷，就是不能选起始点。应该是选取点离哪个端点近那个就是起始点。今天没时间了哪天再给你发一个。 不过这个程序还有点小缺陷，就是不能选起始点。应该是选取点离哪个端点近那个就是起始点。今天没时间了哪天再给你发一个。 感谢关注并予以帮忙！关于起点的问题，可以通过更改多段线方向来完成，论坛里也有单独的LISP。当然了，整合在这个里面更好。另外，能否加上可以选择法线的位置呢，就是可以在线路左边也可选择在右边。再次感谢nxchenjk！！！ 补充一下：起点里程不是0的情况也有，加个询问起点里程的就更好，比方输入1230，如输入20米间距，则程序自动标注K1+250m,k1+270m............默认为从0开始即可 按楼主的要求改了一下。你再试一试。呵呵
(defun c:www ()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(if (setq en (car (entsel "\n在近起点处选择路径曲线:")))
(redraw en 3)
(progn
(alert "没有选到曲线!程序退出")
(exit)
)
)
(vl-load-com)
(setq pttxt (cadr (grread T 1)))
(setq startm (getreal "\n输入起始里程<0>:"))
(if (= startm nil)
(setq startm 0)
)
(setq faxian (getreal "\n输入起始法线长度<20.0>:"))
(if(= faxian nil)(setq faxian 20.0))
(princ "\n0.两侧 1.左侧2.右侧")
(setq typ (getint "\n选择法线方向<0>:"))
(if (= typ nil)(setq typ 0))
(if (= nil (setq dist (getreal "\n给定间距<50.0m>:")))(setq dist 50.0))
(setq th(getreal "\字体高度<0.2>:"))
(if(= th nil)(setq th 0.2))
(setq objen(vlax-ename->vla-object en))
(setq objen_l(vlax-curve-getDistAtPoint objen (vlax-curve-getEndPoint objen)))
(setq pt0(vlax-curve-getClosestPointTo objen pttxt))
(setq line_l(vlax-curve-getDistAtPoint objen pt0))
(if (< line_l (/ objen_l 2))
(progn
(setq pt1 (vlax-curve-getstartpoint objen))
(setq ang (a-get-Angle objen pt1))
(setq zhz startm)
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0)))
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0)))
)
(if (/= lic2 (fix lic2))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3)))
)
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
(setq nn (fix(/ objen_l dist)))
(setq uu 0)
(repeat nn
(setq pt1 (vlax-curve-getPointAtDist objen(+(* uu dist)(- dist(rem startm dist)))))
(if(= uu 0)(setq zhz(+ startm(- dist(rem startm dist))))(setq zhz(+ dist(* uu dist)(*(fix(/ startm dist))dist))))
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0)))
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0)))
)
(if(/= lic2 (fix lic2))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3)))
)
(setq ang (a-get-Angle objen pt1))
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
(setq uu (1+ uu))
(setq nn (1- nn))
)
(setq zhz (+ objen_l startm))
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq
str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0))
)
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1
(strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0))
)
)
(if (/= lic2 (fix lic2))
(setq
str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3))
)
)
(setq pt1 (vlax-curve-getendpoint objen))
(setq ang (a-get-Angle objen pt1))
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
)
;反向
(progn
(setq pt1 (vlax-curve-getendpoint objen))
(setq ang (a-get-Angle objen pt1))
(setq zhz startm)
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0)))
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0)))
)
(if (/= lic2 (fix lic2))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3)))
)
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
(setq nn (fix (/ objen_l dist)))
(setq uu 0)
(repeat nn
(setq pt1 (vlax-curve-getPointAtDist objen (- objen_l(- dist(rem startm dist))(* uu dist))))
(if (= uu 0)
(setq zhz (+ startm (- dist (rem startm dist))))
(setq zhz (+ dist (* uu dist) (* (fix (/ startm dist)) dist)))
)
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0)))
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0)))
)
(if (/= lic2 (fix lic2))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3)))
)
(setq ang (a-get-Angle objen pt1))
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt2 pt1 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
(setq uu (1+ uu))
(setq nn (1- nn))
)
(setq zhz (+ objen_l startm))
(setq lic1 (fix (/ zhz 1000.0))
lic2 (- zhz (* lic1 1000.0))
)
(if (= lic2 0)
(setq str_1 (strcat "K" (rtos lic1 2 0) "+000"))
)
(if (and (>= lic2 100.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 0)))
)
(if (and (> 100.0 lic2 0.0) (= lic2 (fix lic2)))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+0" (rtos lic2 2 0)))
)
(if (/= lic2 (fix lic2))
(setq str_1 (strcat "K" (rtos lic1 2 0) "+" (rtos lic2 2 3)))
)
(setq pt1 (vlax-curve-getstartpoint objen))
(setq ang (a-get-Angle objen pt1))
(cond
((= typ 0)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) (/ faxian 2))
pt3 (polar pt1 (+ (* pi 1.5) ang) (/ faxian 2))
)
(command "line" pt3 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
((= typ 1)
(progn
(setq pt2 (polar pt1 (+ (* pi 1.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt2 pt1) 180) pi))
(command "text" "bl" pt2 th ang2 str_1)
)
)
((= typ 2)
(progn
(setq pt2 (polar pt1 (+ (* pi 0.5) ang) faxian))
(command "line" pt1 pt2 "")
(setq ang2 (/ (* (angle pt1 pt2) 180) pi))
(command "text" "br" pt2 th ang2 str_1)
)
)
)
)
)
(setvar "osmode" os)
(princ)
)
;;切线角度pt-ang
(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
)
感谢再出援手！先试用一下，明天评论！
页:
[1]
2