公路测绘求助：进一步完善公路线路画法线标桩号（附源码）

yfanzi

原来贴了一个：求高手看看“沿曲线标注桩号”的小问题
http://bbs.mjtd.com/forum.php?mo ... &fromuid=280412
现在想继续升级此LISP，毕竟搞公路测绘的也经常用它。原来程序提示：字高？选择线路？间距？现在想这样：选择线路中线？（圆，直线，缓和曲线等多个线元组成的一条PL线，）-指定起点？-该点里程？（默认为0）-法线长度？（默认为20）-0两侧画1左侧画2右侧画？（默认为0）-0批量1指定里程（默认为0）-字高（默认字高0.2）。当选择批量的时候，再询问间距。指定里程的时候，只需输入里程数值，在相应的位置画一条法线。是不是要求高了，还请高手修改为盼！

yfanzi

上回高手改了的源码，还请继续升级！
(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
  　　
)
这个基本满足要求，就是起点和终点标不上。有没有有兴趣的，达到楼主的要求啊。=。。。。。。

txd720127

顶起，看哪个高手来完善！

nxchenjk

比较笨的办法。已给你解决。呵呵

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

nxchenjk

不过这个程序还有点小缺陷，就是不能选起始点。应该是选取点离哪个端点近那个就是起始点。今天没时间了哪天再给你发一个。

nxchenjk

不过这个程序还有点小缺陷，就是不能选起始点。应该是选取点离哪个端点近那个就是起始点。今天没时间了哪天再给你发一个。

yfanzi

感谢关注并予以帮忙！关于起点的问题，可以通过更改多段线方向来完成，论坛里也有单独的LISP。当然了，整合在这个里面更好。另外，能否加上可以选择法线的位置呢，就是可以在线路左边也可选择在右边。再次感谢  nxchenjk！！！

yfanzi

补充一下：起点里程不是0的情况也有，加个询问起点里程的就更好，比方输入1230，如输入20米间距，则程序自动标注K1+250m,k1+270m............默认为从0开始即可

nxchenjk

按楼主的要求改了一下。你再试一试。呵呵

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

yfanzi

感谢再出援手！先试用一下，明天评论！