求一个能对多线段及曲线自动标上桩号的程序（已有源代码及其他解决方案）
本帖最后由 zhanglan_0 于 2009-3-16 12:42 编辑求一个能对多线段及曲线自动标上桩号的程序，要求能自行设定桩距、自定义字体，字体要与线段方向铅直。希望有这种程序的人给我发一下，谢谢 本帖最后由 zhanglan_0 于 2009-3-16 12:39 编辑
我有。
源码：http://zml84.blog.sohu.com/104360732.html
通用动态grread研究.lsp
--------------------------------------------------------------------------------
;;;========================================================
;;; 练习
;;;功能：通用grread研究
(vl-load-com)
;;=================================================
;;通用grread定义
(defun ZML-GRREAD (LST / test tmp mode val tmp2)
(setq TEST t)
(while TEST
(setq TMP(grread 2)
MODE (car TMP)
val(cadr tmp)
)
(cond ((= mode 2)
(if (and (setq TMP2 (assoc mode LST))
(setq tmp2 (cdr tmp2))
(setq tmp2 (assoc val tmp2))
)
(eval (cons 'progn (cdr TMP2)))
()
)
)
((setq TMP2 (assoc MODE LST))
(eval (cons 'progn (cdr TMP2)))
)
(t (princ tmp))
)
)
)
;;;========================================================
;;;测试
(defun c:tt (/ lst)
(setq LST (list
'(2
(13 (princ "回车"))
(32 (princ "空格"))
(49 (alert "按下了数字键 1 "))
)
'(5 (princ "\n移动啦"))
'(3 (princ "\n>>>>") (princ "左键"))
'(11 (setq test nil))
'(25 (setq test nil))
)
)
(ZML-GRREAD lst)
)
;;;========================================================
;;;练习 点到线的最近距离
(vl-load-com)
(defun C:TT1 (/ SS lst PT PT0)
(if (and
(setq SS (entsel "\n点取线: "))
(princ "\n")
)
(progn
(setq LST
(list '(5
(setq pt val)
;;计算最近点
(setq
PT0
(vlax-curve-getclosestpointto (car SS) pt)
)
(princ
(strcat
"\r距离: "
(vl-princ-to-string (distance pt PT0))
)
)
;;
(redraw)
(grdraw PT PT0 1)
)
;;左击
'
(3
(setq pt val)
;;计算最近点
(setq
PT0
(vlax-curve-getclosestpointto (car SS) PT)
)
;;绘制直线
(entmake
(list
(cons 0 "LINE")
(cons 62 2)
(cons 10 PT)
(cons 11 PT0)
)
)
)
'(25
(redraw)
(setq TEST NIL)
)
'(11
(redraw)
(setq TEST NIL)
)
)
)
(ZML-GRREAD lst)
)
)
(princ)
)
;;;========================================================
;;;功能：三点绘制矩形（grread动态显示）
(defun C:TT2 (/ fun-pt PT1 PT2 PT33 pt22 PT44 lst)
;;功能计算 pt22 pt44
(defun fun-pt (pt1 pt2 pt33 / ang pt_tmp h pt22 pt44)
(setq ANG (angle PT1 PT2)
ANG (+ ANG (* 0.5 pi))
PT_tmp (polar PT33 ANG 100)
PT22 (inters PT1 PT2 PT33 PT_tmp NIL)
)
(setq H (distance PT33 PT22)
ANG(angle PT33 pt22)
PT44 (polar PT1 (+ ANG pi) H)
)
;;返回
(list pt22 pt44)
)
(while (setq PT1 (getpoint "\n第一点:"))
(if (setq PT2 (getpoint PT1 " >> 第二点:"))
(progn
(princ " >>> 第三点:")
(setq lst (list
'(3
(setq pt33 val)
(setq
tmp
(fun-pt pt1 pt2 pt33)
pt22
(car tmp)
pt44
(cadr tmp)
)
(command"_.pline" "non"
PT1 "non" PT22 "non"
PT33 "non" PT44 "c"
)
(command "_.regen")
(setq TEST NIL)
)
'(5
(setq pt33 val)
(setq
tmp
(fun-pt pt1 pt2 pt33)
pt22
(car tmp)
pt44
(cadr tmp)
)
(redraw)
(grdraw PT1 PT22 1)
(grdraw PT22 PT33 1)
(grdraw PT33 PT44 1)
(grdraw PT44 PT1 1)
)
)
)
(ZML-GRREAD lst)
)
)
)
(princ)
) 呵呵。鸿业道路就可以:) zml84 老兄，你这个怎么用呀？我输入grread怎么不行呀，能教下我吗？ 好像易桥也有类似功能。 能不能发给我一个呀我的邮箱是hfjhfj@163.com zml84 老兄，你这个怎么用呀？我输入grread怎么不行呀，能教下我吗？
忧伤的男人 发表于 2008-12-20 08:58
源码：http://zml84.blog.sohu.com/106910115.html
有用就拿去。 下来，学习学习！ 下了,试下,可以用,不能对其编辑及选择,有点缺陷. 9# chaoxiu
请详细说明。
页:
[1]