发了个动态桩号标注的程序，望高手不吝赐教
本帖最后由 newbuser 于 2015-1-22 09:39 编辑以此抛出个茅坑又脏又硬的砖头，希望引来更多的美玉。现将小程序发于此处，程序运行过程中扔有些瑕疵，正如gif动画中在圆上标注桩号时演示的那样，程序总是在无键盘和鼠标左右键交互的指令下自动终止，还请高手多多指教，鄙人愿闻其详。此程序仍需完善，比如加入捕捉或者循环标注等功能。还望高手不吝赐教啊。
(defun c:zh (/ os e objloop elcode mod val p l K m mstr ptmunm.back
plist)
(setq dim (getvar "DIMZIN"))
(setq unt (getvar "UNITMODE"))
(setvar "DIMZIN" 0)
(setvar "UNITMODE" 0)
(setq os (getvar "osmode"))
(setq e (car (entsel "\n 请选择需要标注的多段线=>> ")))
(prompt "\n <<****欢迎使用逐桩标注程序****>>")
(setq obj (vlax-ename->vla-object e))
(entmake (list '(0 . "TEXT")
(cons 1 "0")
'(10 0 0 0)
(cons 40 1)
(cons 62 3)
(cons 8 "桩号标注")
)
)
(setq el (entget (entlast)))
;;;(setq p (getpoint "\n 请选择需要标注的点位 "))
(setq loop T)
(while loop
(setq code (grread T 4 1)
mod(car code)
val(cadr code)
)
(cond ((= 5 mod)
;;获取离曲线最近的点
(setq p (vlax-curve-getClosestPointTo
obj
val
)
)
(redraw)
(grdraw val p 3)
;;指定点到起点的距离
(setq l (vlax-curve-getDistAtPoint obj p)
K (fix (* 0.001 l))
m (- (* 0.001 l) K)
)
(setq mstr (rtos m 2 6))
(setq ptnum (vl-string-search "." mstr))
(setq m.back (substr mstr (+ 5 ptnum) 3))
(setq
m.back (cond ((= 0 (strlen m.back)) (strcat m.back "000"))
((= 1 (strlen m.back)) (strcat m.back "00"))
((= 2 (strlen m.back)) (strcat m.back "0"))
((= 3 (strlen m.back)) m.back)
)
)
;;里程桩内容
(setq str (strcat "K"
(itoa K)
"+"
(substr mstr (+ 2 ptnum) 3)
"."
m.back
)
)
;;找出X或者Y坐标值小的点
(setq plist (if (= (car val) (car p))
(progn
(vl-sort (list val p)
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2))
)
)
)
)
;;如果X值相等，Y值小的在前面
(progn
(vl-sort
(list val p)
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
;;否则X值小的在前面
)
)
(setq ang (angle (car plist) (cadr plist)))
(setq el (subst (cons 1 str) (assoc 1 el) el))
;;坐标
(setq el (subst (cons 10 val) (assoc 10 el) el))
;;角度
(setq el (subst (cons 50 ang) (assoc 50 el) el))
;;高度
(setq el (subst (cons 40 (* 0.05 (distance val p)))
(assoc 40 el)
el
)
)
;;更新图元名列表
(entmod el)
)
;;鼠标左键、右键退出画线
((or (= 25 mod) (= 3 mod))
(entmake (list '(0 . "LINE")
(cons 10 p)
(cons 11 val)
(cons 8 "桩号标注")
(cons 62 1)
)
)
(setq loop nil)
)
)
)
(setvar "DIMZIN" dim)
(setvar "UNITMODE" unt)
(setvar "osmode" os)
;;;(redraw)
)
给一个测试grread返回值的程序，估计是因按“回车键”时的同时，产生了附加码引起的
;;;============================================
;;; 测试 (grread t 4 2) 返回值，按键盘上的“空格”键结束，屏蔽了鼠标移动过程中的显示值
(while(/=(cadr(setq tmp(grread t 4 2)))32)(if(/=(car tmp)5)(progn(princ"\n")(princ tmp))))
;;;============================================ 找到原因了，问题出在那个里程桩号生成的那个函数上。
在程序开始时保存dimzin和unitmode变量并将该两项变量设置为0，程序运行完后再回复该两项系统变量即可。代码已更新，在楼顶。 帮楼主顶贴 楼主这个赞，动态的不错哦！ 赞，不错啊支持啊··～～～ 支持下能指定标注桩号就更好！！ 顶！！！！！！！！！！！ 帮顶一个 这个程序不错，很实用