设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › Command扩展应用
返回列表 发新帖
查看: 1222|回复: 5

[研讨] Command扩展应用

[复制链接]
Free-Lancer
发表于 2013-9-7 08:46:20 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
本帖最后由 Free-Lancer 于 2013-9-7 08:48 编辑

在Lisp中使用 Command 后可以用 CmdActive 判断命令是否结束并允许用户交互输入最终完成命令，现在发现可以可以增加一个 Grread 监视用户输入完成额外的任务！以下是一个简单的“一笔画”模拟。

这个额外任务不能再用 command 方式，entmod vla- 均可

说明：修改 arc 使用了新函数，以下程序适用 CAD2011+！
更多应用欢迎大家一起探讨。

  1. (defun c:tt (/ GetOrthoPt aa p tf lent arc p0 d p1 p2 dw tf1 p11 p22 an
  2.       dis)
  3.   (defun GetOrthoPt (p p1 / p)
  4.     (if (= (getvar "ORTHOMODE") 1)
  5.       (if (or
  6.      (<= (angle p p1) (* 0.25 pi))
  7.      (> (angle p p1) (* 1.5 pi))
  8.      (<= (* 0.75 pi) (angle p p1) (* 1.25 pi))
  9.    )
  10. (setq p (list (car p1) (cadr p) 0.))
  11. (setq p (list (car p) (cadr p1) 0.))
  12.       )
  13.       p1
  14.     )
  15.   )
  16.   (defun mkline (p1 p2)
  17.     (entmakex (list '(0 . "LINE")
  18.       '(100 . "AcDbLine")
  19.       '(100 . "AcDbEntity")
  20.       (cons 10 p1)
  21.       (cons 11 p2)
  22.        )
  23.     )
  24.   )
  25.   (setvar "cmdecho" 1)
  26.   (setq lent (entlast)
  27. tf1  t
  28.   )
  29.   (if (and (setq p0 (getpoint "\nFirst Point: "))
  30.     (setq d (getdist p0 "\nWidth: "))
  31.       )
  32.     (progn
  33.       (setq dw (/ d 2.)
  34.      arc (entmakex (list '(0 . "arc")
  35.     '(100 . "AcDbArc")
  36.     '(100 . "AcDbEntity")
  37.     (cons 10 p0)
  38.     (cons 40 dw)
  39.     (cons 50 pi)
  40.     (cons 51 (* pi 2.))
  41.      )
  42.   )
  43.       )
  44.       (vl-cmdf ".line" p0)
  45.       (while (/= (getvar "cmdactive") 0)
  46. ;;(vl-cmdf pause)
  47. (setq aa (grread))
  48. (cond
  49.    ((= (car aa) 3)
  50.     (if tf
  51.       (progn
  52.         (setq p (getvar "lastpoint")
  53.        p (getorthopt p (cadr aa))
  54.         )
  55.         (vl-cmdf p)
  56.       )
  57.       (progn
  58.         (setq tf t)
  59.         (vl-cmdf (setq p (cadr aa)))
  60.       )
  61.     )
  62.     (setq dis (distance p0 p)
  63.    an  (angle p0 p)
  64.     )
  65.     (setq ln1 (mkline
  66.          (setq p1 (polar p0 (+ an (* pi 0.5)) dw))
  67.          (setq p11 (polar p1 an dis))
  68.        )
  69.    ln2 (mkline
  70.          (setq p2 (polar p0 (+ an (* pi -0.5)) dw))
  71.          (setq p22 (polar p2 an dis))
  72.        )
  73.     )
  74.     (if tf1
  75.       (progn
  76.         (setpropertyvalue arc "StartAngle" (angle p2 p1))
  77.         (setpropertyvalue arc "EndAngle" (+ (angle p2 p1) pi))
  78.         (setq tf1 nil)
  79.       )
  80.     )
  81.     (vl-cmdf "")
  82.     (vla-mirror
  83.       (vlax-ename->vla-object arc)
  84.       (vlax-3d-point
  85.         (polar p0 an (/ dis 2.))
  86.       )
  87.       (vlax-3d-point
  88.         (polar p2 an (/ dis 2.))
  89.       )
  90.     )
  91.     (setq p0 p)
  92.    )
  93.    ((= (cadr aa) 32)
  94.     (entdel arc)
  95.     (vl-cmdf "")
  96.    )
  97.    (t (entdel arc) (vl-cmdf pause))
  98. )
  99.       )
  100.     )
  101.   )
  102.   (princ)
  103. )

以上程序非实现该功能的最好方式，仅作为一种应用探讨！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

Free-Lancer
 楼主| 发表于 2013-9-7 16:22:06 | 显示全部楼层
本帖最后由 Free-Lancer 于 2013-9-7 16:23 编辑

另外一个改造为"一触即发"的 Offset 命令
  1. (defun c:ooo (/ aa)
  2.   (setvar "cmdecho" 1)
  3.   (vl-cmdf ".offset")
  4.   (while (/= (getvar "cmdactive") 0)
  5.     (setq aa (grread))
  6.     ;;(princ aa)
  7.     (cond
  8.       ((= (cadr aa) 99)
  9.        (vl-cmdf "c")
  10.       )
  11.       ((= (cadr aa) 115)
  12.        (vl-cmdf "s")
  13.       )
  14.       ((= (cadr aa) 116)
  15.        (vl-cmdf "t")
  16.       )
  17.       ((= (cadr aa) 101)
  18.        (vl-cmdf "E")
  19.       )
  20.       ((= (cadr aa) 110)
  21.        (vl-cmdf "n")
  22.       )
  23.       ((= (cadr aa) 121)
  24.        (vl-cmdf "y")
  25.       )
  26.       ((= (cadr aa) 108)
  27.        (vl-cmdf "L")
  28.       )
  29.       ((= (cadr aa) 109)
  30.        (vl-cmdf "m")
  31.       )
  32.       ((= (cadr aa) 107)
  33.        (vl-cmdf "U")
  34.       )
  35.       ((= (car aa) 3)
  36.        (vl-cmdf (cadr aa))
  37.       )
  38.       ((= (car aa) 2)
  39.        (vl-cmdf "")
  40.       )
  41.       (t (vl-cmdf pause))
  42.     )
  43.   )
  44.   (princ)
  45. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

newer

已领礼包: 40个

财富等级: 招财进宝
发表于 2013-9-7 17:15:45 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
你认为最好的方式是什么？

是不是可以总结整理下，写个通用的一键触发函数？

点评

/db_自贡黄明儒_
这个真的有？？？  发表于 2013-9-9 12:59
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-9-7 19:19:22 来自手机 | 显示全部楼层
看LZ应用是在command中插入键盘监视，由键盘触发执行事件，相当于命令执行其他操作，和DCL界面下执行vla异曲同工
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
 楼主| 发表于 2013-9-8 03:50:10 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
比较全面的 Grread 例子
http://www.theswamp.org/index.php?topic=12813.0
转一个
  1. (setq loop T)
  2. (while loop
  3. (setq code (grread T 8))
  4. (cond
  5.        ((= (car code) 5)     (do_Move))               ;;; mouse move
  6.        ((= (car code) 3)     (do_Left))               ;;; mouse left button
  7.        ((= (car code) 11)    (do_Right))              ;;; mouse right button, right button as return
  8.        ((= (car code) 25)    (do_Right))              ;;; mouse right button, right button as screen menu
  9.        ((equal code '(2 0))  (do_CTRL-@))             ;;; CTRL-@
  10.        ((equal code '(2 1))  (do_CTRL-A))             ;;; CTRL-A
  11.        ((equal code '(2 2))  (do_F9))                 ;;; CTRL-B or F9
  12.        ((equal code '(2 3))  (do_F12))                ;;; CTRL-C or F12
  13.        ((equal code '(2 4))  (do_F6))                 ;;; CTRL-D or F6
  14.        ((equal code '(2 5))  (do_F5))                 ;;; CTRL-E or F5
  15.        ((equal code '(2 6))  (do_F3))                 ;;; CTRL-F or F3
  16.        ((equal code '(2 7))  (do_F7))                 ;;; CTRL-G or F7
  17.        ((equal code '(2 8))  (do_Back))               ;;; CTRL-H or backspace
  18.        ((equal code '(2 9))  (do_Tab))                ;;; CTRL-I or Tab
  19.        ((equal code '(2 10)) (do_CTRL-J))             ;;; CTRL-J
  20.        ((equal code '(2 11)) (do_CTRL-K))             ;;; CTRL-K
  21.        ((equal code '(2 12)) (do_CTRL-L))             ;;; CTRL-L
  22.        ((equal code '(2 13)) (do_Return))             ;;; CTRL-M or return
  23.        ((equal code '(2 14)) (do_CTRL-N))             ;;; CTRL-N
  24.        ((equal code '(2 15)) (do_F8))                 ;;; CTRL-O or F8
  25.        ((equal code '(2 16)) (do_CTRL-P))             ;;; CTRL-P
  26.        ((equal code '(2 17)) (do_CTRL-Q))             ;;; CTRL-Q
  27.        ((equal code '(2 18)) (do_CTRL-R))             ;;; CTRL-R
  28.        ((equal code '(2 19)) (do_CTRL-S))             ;;; CTRL-S
  29.        ((equal code '(2 20)) (do_F4))                 ;;; CTRL-T or F4
  30.        ((equal code '(2 21)) (do_F10))                ;;; CTRL-U or F10
  31.        ((equal code '(2 22)) (do_CTRL-V))             ;;; CTRL-V
  32.        ((equal code '(2 23)) (do_F11))                ;;; CTRL-W or F11
  33.        ((equal code '(2 24)) (do_CTRL-X))             ;;; CTRL-X
  34.        ((equal code '(2 25)) (do_CTRL-Y))             ;;; CTRL-Y
  35.        ((equal code '(2 26)) (do_CTRL-Z))             ;;; CTRL-Z
  36.        ((equal code '(2 27)) (do_CTRL-[))             ;;; CTRL-[ or ESC
  37.        ((equal code '(2 28)) (do_CTRL-\))             ;;; CTRL-\
  38.        ((equal code '(2 29)) (do_CTRL-]))             ;;; CTRL-]
  39.        ((equal code '(2 30)) (do_CTRL-^))             ;;; CTRL-^
  40.        ((equal code '(2 31)) (do_CTRL-_))             ;;; CTRL-_
  41.        ((equal code '(2 32)) (do_Space))              ;;; space key
  42.        ((equal code '(2 33)) (do_ExclamationMark))    ;;; ! key
  43.        ((equal code '(2 34)) (do_DoubleQuote))        ;;; " key
  44.        ((equal code '(2 35)) (do_Hash))               ;;; # key
  45.        ((equal code '(2 36)) (do_Dollar))             ;;; $ key
  46.        ((equal code '(2 37)) (do_Percent))            ;;; % key
  47.        ((equal code '(2 38)) (do_Ampersand))          ;;; & key
  48.        ((equal code '(2 39)) (do_Apostrophe))         ;;; ' key
  49.        ((equal code '(2 40)) (do_OpenParenthesis))    ;;;  ( key
  50.        ((equal code '(2 41)) (do_CloseParenthesis))   ;;; ) key
  51.        ((equal code '(2 42)) (do_Asterisk))           ;;; * key
  52.        ((equal code '(2 43)) (do_Plus))               ;;; + key
  53.        ((equal code '(2 44)) (do_Comma))              ;;; , key
  54.        ((equal code '(2 45)) (do_Minus))              ;;; - key
  55.        ((equal code '(2 46)) (do_Dot))                ;;; . key
  56.        ((equal code '(2 47)) (do_Slash))              ;;; / key
  57.        ((equal code '(2 48)) (do_0))                  ;;; 0 key
  58.        ((equal code '(2 49)) (do_1))                  ;;; 1 key
  59.        ((equal code '(2 50)) (do_2))                  ;;; 2 key
  60.        ((equal code '(2 51)) (do_3))                  ;;; 3 key
  61.        ((equal code '(2 52)) (do_4))                  ;;; 4 key
  62.        ((equal code '(2 53)) (do_5))                  ;;; 5 key
  63.        ((equal code '(2 54)) (do_6))                  ;;; 6 key
  64.        ((equal code '(2 55)) (do_7))                  ;;; 7 key
  65.        ((equal code '(2 56)) (do_8))                  ;;; 8 key
  66.        ((equal code '(2 57)) (do_9))                  ;;; 9 key
  67.        ((equal code '(2 58)) (do_Colon))              ;;; : key
  68.        ((equal code '(2 59)) (do_Semicolon))          ;;; ; key
  69.        ((equal code '(2 60)) (do_LessThan))           ;;; < key
  70.        ((equal code '(2 61)) (do_Equals))             ;;; = key
  71.        ((equal code '(2 62)) (do_GreatThan))          ;;; > key
  72.        ((equal code '(2 63)) (do_QuestionMark))       ;;; ? key
  73.        ((equal code '(2 64)) (do_At))                 ;;; @ key
  74.        ((equal code '(2 65)) (do_A))                  ;;; A key
  75.        ((equal code '(2 66)) (do_B))                  ;;; B key
  76.        ((equal code '(2 67)) (do_C))                  ;;; C key
  77.        ((equal code '(2 68)) (do_D))                  ;;; D key
  78.        ((equal code '(2 69)) (do_E))                  ;;; E key
  79.        ((equal code '(2 70)) (do_F))                  ;;; F key
  80.        ((equal code '(2 71)) (do_G))                  ;;; G key
  81.        ((equal code '(2 72)) (do_H))                  ;;; H key
  82.        ((equal code '(2 73)) (do_I))                  ;;; I key
  83.        ((equal code '(2 74)) (do_J))                  ;;; J key
  84.        ((equal code '(2 75)) (do_K))                  ;;; K key
  85.        ((equal code '(2 76)) (do_L))                  ;;; L key
  86.        ((equal code '(2 77)) (do_M))                  ;;; M key
  87.        ((equal code '(2 78)) (do_N))                  ;;; N key
  88.        ((equal code '(2 79)) (do_O))                  ;;; O key
  89.        ((equal code '(2 80)) (do_P))                  ;;; P key
  90.        ((equal code '(2 81)) (do_Q))                  ;;; Q key
  91.        ((equal code '(2 82)) (do_R))                  ;;; R key
  92.        ((equal code '(2 83)) (do_S))                  ;;; S key
  93.        ((equal code '(2 84)) (do_T))                  ;;; T key
  94.        ((equal code '(2 85)) (do_U))                  ;;; U key
  95.        ((equal code '(2 86)) (do_V))                  ;;; V key
  96.        ((equal code '(2 87)) (do_W))                  ;;; W key
  97.        ((equal code '(2 88)) (do_X))                  ;;; X key
  98.        ((equal code '(2 89)) (do_Y))                  ;;; Y key
  99.        ((equal code '(2 90)) (do_Z))                  ;;; Z key
  100.        ((equal code '(2 91)) (do_OpenSquareBracket))  ;;; [ key
  101.        ((equal code '(2 92)) (do_BackSlash))          ;;; \ key
  102.        ((equal code '(2 93)) (do_CloseSquareBracket)) ;;; ] key
  103.        ((equal code '(2 94)) (do_Caret))              ;;; ^ key
  104.        ((equal code '(2 95)) (do_UnderScore))         ;;; _ key
  105.        ((equal code '(2 96)) (do_BackQuote))          ;;; ` key
  106.        ((equal code '(2 97)) (do_a))                  ;;; a key
  107.        ((equal code '(2 98)) (do_b))                  ;;; b key
  108.        ((equal code '(2 99)) (do_c))                  ;;; c key
  109.        ((equal code '(2 100))(do_d))                  ;;; d key
  110.        ((equal code '(2 101))(do_e))                  ;;; e key
  111.        ((equal code '(2 102))(do_f))                  ;;; f key
  112.        ((equal code '(2 103))(do_g))                  ;;; g key
  113.        ((equal code '(2 104))(do_h))                  ;;; h key
  114.        ((equal code '(2 105))(do_i))                  ;;; i key
  115.        ((equal code '(2 106))(do_j))                  ;;; j key
  116.        ((equal code '(2 107))(do_k))                  ;;; k key
  117.        ((equal code '(2 108))(do_l))                  ;;; l key
  118.        ((equal code '(2 109))(do_m))                  ;;; m key
  119.        ((equal code '(2 110))(do_n))                  ;;; n key
  120.        ((equal code '(2 111))(do_o))                  ;;; o key
  121.        ((equal code '(2 112))(do_p))                  ;;; p key
  122.        ((equal code '(2 113))(do_q))                  ;;; q key
  123.        ((equal code '(2 114))(do_r))                  ;;; r key
  124.        ((equal code '(2 115))(do_s))                  ;;; s key
  125.        ((equal code '(2 116))(do_t))                  ;;; t key
  126.        ((equal code '(2 117))(do_u))                  ;;; u key
  127.        ((equal code '(2 118))(do_v))                  ;;; v key
  128.        ((equal code '(2 119))(do_w))                  ;;; w key
  129.        ((equal code '(2 120))(do_x))                  ;;; x key
  130.        ((equal code '(2 121))(do_y))                  ;;; y key
  131.        ((equal code '(2 122))(do_z))                  ;;; z key
  132.        ((equal code '(2 123))(do_OpenBrace))          ;;; { key
  133.        ((equal code '(2 124))(do_VerticalBar))        ;;; | key
  134.        ((equal code '(2 125))(do_CloseBrace))         ;;; } key
  135.        ((equal code '(2 126))(do_Tilde))              ;;; ~ key
  136.        ((equal code '(2 127))(do_Delete))             ;;; Delete key
  137.     )
  138. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-15 12:03 , Processed in 0.310914 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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