明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 2248|回复: 13

发了个动态桩号标注的程序,望高手不吝赐教

[复制链接]
发表于 2015-1-19 16:51 | 显示全部楼层 |阅读模式
本帖最后由 newbuser 于 2015-1-22 09:39 编辑

以此抛出个茅坑又脏又硬的砖头,希望引来更多的美玉。现将小程序发于此处,程序运行过程中扔有些瑕疵,正如gif动画中在圆上标注桩号时演示的那样,程序总是在无键盘和鼠标左右键交互的指令下自动终止,还请高手多多指教,鄙人愿闻其详。此程序仍需完善,比如加入捕捉或者循环标注等功能。还望高手不吝赐教啊。
[code="lisp] (defun c:zh (/ os e obj  loop el  code mod val p l K m mstr ptmun  m.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)
)
[/code]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

本帖被以下淘专辑推荐:

发表于 2015-1-20 08:51 | 显示全部楼层
给一个测试grread返回值的程序,估计是因按“回车键”时的同时,产生了附加码引起的
;;;============================================
;;; 测试 (grread t 4 2) 返回值,按键盘上的“空格”键结束,屏蔽了鼠标移动过程中的显示值
(while(/=(cadr(setq tmp(grread t 4 2)))32)(if(/=(car tmp)5)(progn(princ"\n")(princ tmp))))
;;;============================================
 楼主| 发表于 2015-1-22 09:35 | 显示全部楼层
找到原因了,问题出在那个里程桩号生成的那个函数上。
在程序开始时保存dimzin和unitmode变量并将该两项变量设置为0,程序运行完后再回复该两项系统变量即可。代码已更新,在楼顶。
发表于 2015-1-22 10:39 | 显示全部楼层
帮楼主顶贴
发表于 2015-3-13 11:14 | 显示全部楼层
楼主这个赞,动态的不错哦!
发表于 2015-4-23 22:34 | 显示全部楼层
赞,不错啊  支持啊··~~~
发表于 2015-5-11 09:05 | 显示全部楼层
支持下  能指定标注桩号就更好!!
发表于 2015-5-16 13:16 | 显示全部楼层
顶!!!!!!!!!!!
发表于 2015-7-28 17:20 | 显示全部楼层
帮顶一个   
发表于 2015-11-8 23:47 | 显示全部楼层
这个程序不错,很实用
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-7-23 13:46 , Processed in 0.299614 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表