明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 6032|回复: 31

[提问] 求助关于动态标注(grread)键盘输入值

  [复制链接]
发表于 2018-7-13 22:55 | 显示全部楼层 |阅读模式
10明经币
借助 langjs 大师的grread 捕捉子函数和网友惊惊帮助,还有论坛上大师们的代码,自己东拼西凑,
弄了一个动态线性标注的小程序,谈不上什么实用性,只是在视觉上感觉比自带良好一下下而已。
现在的问题是:无法通过输入值来确定标注的距离,有劳大师们帮忙改进一下,
让程序可以像CAD自带的_dimlinear 一样可以通过输入值来确定标注距离

(defun c:13(/ oc ss jd ro) ;动态标注
(if (not o)(setq o (getpoint"\n请指标注起点:")))
(setq os (getvar "osmode")) ;记录捕捉
(setvar'osmode 0) ;关闭捕捉
(if (/= o nil)(command"dimlinear"o o o""))
(setq ss(ssadd) ss(ssadd(entlast)ss))
(command "delay" 100);延时(1000=1秒)
(if(member(car(grread 3))'(3 5))(setq oc(cadr(grread 3)))) ;光标位置
(setq jd (/(* (angle o oc) 180) pi)) ;两点与X轴的角度
(setq dx 14)
(if (setq ro (cond ((and(>= jd 45)(<= jd 135)) 90)
                   ((and(>= jd 225)(<= jd 315))270)))
(if (not oo)(command"_rotate" ss "" o ro "")(command"_rotate" ss "" oo ro "") )
)
(setvar'osmode os) ;恢复捕捉模式
(ydd ss)(setq dx nil)
(if (= sc 1)(ydd ss)(command "_.erase" ss ""))
(setq o nil sc nil oo nil ss nil)
(princ))


;grread 捕捉子函数 langjs 2017-12-25 http://bbs.mjtd.com/thread-176190-1-1.html
;name 为移动的图元名,pt为光标点
;返回值:如果有捕捉点则返回捕捉点,无则返回光标点
(defun osnappt (name pt / color d h k lst nearpt nearpt2 osmo pt1 pt2 pt3 pt4 pt5 ptx pty x)
  (if name (entdel name))
  (redraw)
  (if (< (getvar "osmode") 16384)
    (progn
      (setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
            h (/ (getvar "viewsize") (cadr (getvar "screensize"))) d (getvar "pickbox")
            lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 1.5 d h))
      (if (setq nearpt (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_TAN,_EXT"))(setq osmo 1))
      (if (and(setq nearpt2 (osnap pt "_NEA"))(not (equal nearpt nearpt2 k)))
        (setq osmo 2 nearpt nearpt2))
      (if (and(setq nearpt2 (osnap pt "_MID"))(equal nearpt nearpt2 k))
        (setq osmo 3 nearpt nearpt2))
      (if (and(setq nearpt2 (osnap pt "_INT"))(equal nearpt nearpt2 k))
        (setq osmo 4 nearpt nearpt2))))
  (if name(entdel name))
  (if nearpt
    (progn
      (setq ptx (car nearpt)pty (cadr nearpt))
      (foreach x lst
        (setq pt1 (list (- ptx x) (- pty x)) pt2 (list (+ ptx x) (- pty x))
              pt3 (list (+ ptx x) (+ pty x)) pt4 (list (- ptx x) (+ pty x))
              pt5 (list ptx (+ pty x)))
        (cond
          ((= osmo 1)(grvecs (list color pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1)))
          ((= osmo 2)(grvecs (list color pt1 pt2 pt2 pt4 pt3 pt4 pt3 pt1)))
          ((= osmo 3) (grvecs (list color pt1 pt2 pt2 pt5 pt5 pt1)))
          ((= osmo 4) (grvecs (list color pt1 pt3 color pt2 pt4)))))
      (setq pt nearpt)))
  pt
)

;动态移动对象
(defun c:yd()(ydd (ssget ":e:s")))
(defun ydd(#s# / code ent gr loop name pt)
(cond((=(type #s#)'name) ;540762622(惊惊) 170919
             (setq name #s#))((=(type #s#)'pickset)
             (setq name (ssname #s# 0))))
  (if name ;(setq name (car (entsel"\n请选择要移动的对象:")))
    (progn
(if (not dx)(setq dx 10)) ;14标注终点
      (setq ent (entget name) loop t)
      (princ "\n请指定放置点:")
      (while loop
        (setq gr (grread t 15 0) code (car gr) pt (cadr gr))
        (cond
          ((= code 3)(redraw)(setq loop nil sc 1))  ; 鼠标左键
          ((= code 5)                  ; 鼠标移动
            (setq pt (osnappt name pt))
            (entmod (setq ent (subst(cons dx pt)(assoc dx ent)ent))))
          ((= code 2)                  ; 键盘输入
            (princ "\n键盘输入=")(princ pt))
          ((member code '(11 25))      ; 鼠标右击
            (redraw)  (setq loop nil) )))
(setq dx nil)
) )
  (princ)
)


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

最佳答案

查看完整内容

根据你最新的代码,全面改写了你的代码,修改了很多地方,重点是不仅支持输入数字和小数点还支持退格键,好像论坛上还没有,收点明经币 不知道如何更新附件,请下载前面的,前面的是最新的.
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2018-7-13 22:55 | 显示全部楼层
本帖最后由 namezg 于 2018-7-18 14:41 编辑

根据你最新的代码,全面改写了你的代码,修改了很多地方,重点是不仅支持输入数字和小数点还支持退格键,好像论坛上还没有,收点明经币
不知道如何更新附件,请下载前面的,前面的是最新的.

本帖子中包含更多资源

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

x

点评

非常感谢namezg大师,超乎想象中的完美!  发表于 2018-7-18 14:10
回复

使用道具 举报

 楼主| 发表于 2018-7-14 16:10 | 显示全部楼层
顶起来,大师们帮帮忙啦
回复

使用道具 举报

发表于 2018-7-14 19:08 | 显示全部楼层
是不是像這樣?

本帖子中包含更多资源

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

x
回复

使用道具 举报

 楼主| 发表于 2018-7-14 19:14 | 显示全部楼层

是的,不过是想在上面的程序里改,应该是在
((= code 2)                  ; 键盘输入
            (princ "\n键盘输入=")(princ pt))
这个地方改吧?
回复

使用道具 举报

发表于 2018-7-14 19:29 | 显示全部楼层
本帖最后由 bluefcc1 于 2018-7-14 19:33 编辑
669423907 发表于 2018-7-14 19:14
是的,不过是想在上面的程序里改,应该是在
((= code 2)                  ; 键盘输入
            ( ...

上面的test.gif 不是用上面的原碼修改的。
第2點應該是從相對於第1點的方向及距離求得。
回复

使用道具 举报

 楼主| 发表于 2018-7-14 19:42 | 显示全部楼层
bluefcc1 发表于 2018-7-14 19:29
上面的test.gif 不是用上面的原碼修改的。
第2點應該是從相對於第1點的方向及距離求得。

是的,我想让程序可以接受键盘输入的值
回复

使用道具 举报

发表于 2018-7-15 21:50 | 显示全部楼层
669423907 发表于 2018-7-14 19:42
是的,我想让程序可以接受键盘输入的值

      (setq str "")
      (while loop
        (setq gr (grread t 15 0))
        (setq code (car gr))
        (setq pt (cadr gr))
        (cond
          ((= code 3)                  ; 滑鼠左鍵
           (redraw)
           (setq loop nil)
           (setq sc 1)
           (setq pt (atof str))
         )  
          ((= code 5)                  ; 滑鼠移動
            (setq pt (osnappt name pt))
            (entmod (setq ent (subst(cons dx pt)(assoc dx ent)ent))))
          ((= code 2)                  ; 鍵盤輸入
            (princ "\n鍵盤輸入=")
            (setq str (strcat str (chr pt)))
            (princ str)        
          )
回复

使用道具 举报

发表于 2018-7-16 07:14 | 显示全部楼层
精彩,学习。。。。
回复

使用道具 举报

发表于 2018-7-16 12:14 | 显示全部楼层
我怎么不能上传附件啊,提示Server (IO) Error
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 13:39 , Processed in 0.276086 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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