求高手看看“沿曲线标注桩号”的小问题

yfanzi

(defun c:ezhbz ()
　　 (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 nn 1)
　　 (while
　　 (setq pt1 (vlax-curve-getPointAtDist en (* 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 en pt1))
　　 (setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
　　 (command "line" pt1 pt2 "")
　　 (setq ang2 (r2d (angle pt2 pt1)))
　　 (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
　　)

yfanzi

此程序急用，但是有错误，高手能改一下么

ljpnb

修改了一下

zhynt

我也改了一下

yfanzi

感谢两位的精彩演绎，同学们都可以进来看看，学习一下。还可以在此基础上适当发挥，搞成合适自己的。

yfanzi

我把两位的源码贴出来，LJPNJ的
(defun c:ezhbz ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (command "undo" "be")
  (setq
    str_2 (strcat "\n给定文字高度<" (rtos (getvar "textsize") 2) ">:")
  )
  (setq th (getreal str_2))
  (if (= th nil)
    (setq th (getvar "textsize"))
    (setvar "textsize" th)
  )
  (if (setq en (car (entsel "\n选择路径曲线:")))
    (progn
      (redraw en 3)
      (if (= nil (setq dist (getreal "\n给定间距<50m>:")))
        (setq dist 50.0)
      )
      (setq nn 1)
      (setq endpoint (vlax-curve-getEndPoint en))
      (setq l (vlax-curve-getDistAtPoint en endpoint))
      (while (<= (setq zhz (* nn dist)) l)
        (setq pt1 (vlax-curve-getPointAtDist en zhz))
        (if (< zhz 1000.0)
          (setq str_1 (strcat "K0+" (rtos zhz 2 3) "m"))
          (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 en pt1))
        (setq pt2 (polar pt1 (+ (/ pi 2) ang) (* th 8)))
        (command "line" "non" pt1 "non" pt2 "")
        (setq ang2 (angle pt2 pt1))
        (command "text" "bl" "non" pt2 th ang2 str_1)
        (setq nn (1+ nn))
      )
      (redraw en 4)
    )
    (princ "\n没有选到曲线!")
  )
  (setvar "osmode" os)
  (command "undo" "e")
  (setvar "cmdecho" 1)
  (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

ZHYNT的
(defun c:ezhbz ()
  (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
  　　
)

yxh1202

yfanzi 发表于 2011-7-1 17:44
ZHYNT的
(defun c:ezhbz ()
  (setvar "cmdecho" 0)

出现错误，错误: no function definition: VLAX-ENAME->VLA-OBJECT
怎么回事，谢谢。

zdqwy19

yxh1202 发表于 2012-5-14 17:14
出现错误，错误: no function definition: VLAX-ENAME->VLA-OBJECT
怎么回事，谢谢。

加上（vl-load-com）就可以了。有一部分扩展函数高版本CAD没有自动加载，需要手动加载。

yxh1202

zdqwy19 发表于 2012-5-15 06:58
加上（vl-load-com）就可以了。有一部分扩展函数高版本CAD没有自动加载，需要手动加载。

谢谢，俺的lisp知识还是太浅了，再次感谢各位。