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

yfanzi 发表于 2011-6-30 01:24:45

(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 发表于 2011-7-1 02:19:37

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

ljpnb 发表于 2011-7-1 06:32:05

修改了一下

zhynt 发表于 2011-7-1 08:29:27

我也改了一下

yfanzi 发表于 2011-7-1 17:39:38

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

yfanzi 发表于 2011-7-1 17:42:40

我把两位的源码贴出来，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 发表于 2011-7-1 17:44:57

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 发表于 2012-5-14 17:14:17

yfanzi 发表于 2011-7-1 17:44 static/image/common/back.gif
ZHYNT的
(defun c:ezhbz ()
(setvar "cmdecho" 0)

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

zdqwy19 发表于 2012-5-15 06:58:19

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

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

yxh1202 发表于 2012-5-15 08:14:10

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

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

页: [1] 2

明经CAD社区's Archiver

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