cmd+num 命令简称加任意数字组成智能命令[07.20]

gbhsu

;;;这几天不用画图了，有时间编编小程，到也觉得轻松！呵呵
;;;感谢明经LISP编程QQ群里的朋友们的热忱，现将此程序源代码奉献给大家！
;;;命令简称加任意数字组成智能命令这种想法在过去多少年中一直均有，因时间或能力问题一直未能如愿。
;;;如今终于完成了大部分的命令，欢迎大家测试。最初的程序是论坛里找的，非常有用，本人也只是深化了一下而已。
;;;不敢独享，希望大家在工作中能时时运用，提高效率！
;;本程序由燕川布衣编者编写，QQ:112100528
;;;作者对本程序不提供任何使用上的保证。
;;本程序不得用于商业目的，复制传播请保留以上信息
;;;附件最新更新时间2011.07.21
(vl-load-com)
(or *doc* (setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object))))
(or *hsu:commandall* (setq *hsu:commandall* (vlr-editor-reactor nil '((:vlr-unknownCommand . hsu:commandall)))))
(defun hsu:commandall (a b / c s l hsu:vla-sendcommand-string ANG key )
  (prompt "\ncmd+num组成命令
  现已解决了：
  fillet  f100 f150.5  即f+任意数字可成命令
  move    m100  mr100  向右移100     ;move right
                mL100  向左移100     ;move left
                mu100  向上移100     ;move up
                md100  向下移100     ;move down
                m45X100  45度方向移动100
                m-45X-100  -45度方向移动-100          ;极标坐标
                m100,200   移动到相对坐标 100,200     ;相对坐标
                m,200      移动到相对坐标  0,200      ;可以略零
  circle   c100 画半径为100的圆
           选取D[仅选一次即可]画直径为100的圆         ;2011.07.20add
  chamfer  y100 cha100 倒角100
           y100x200    倒角100X200                    ;2011.07.19add
           y100,200    倒角100X200                    ;2011.07.19add
  stretch  s100 sr100  向右拉伸100   ;stretch right
                sL100  向左拉伸100   ;stretch left
                su100  向上拉伸100   ;stretch up
                sd100  向下拉伸100   ;stretch down
  line     L100 lr100  向右画线100   ;line right
                LL100  向左画线100   ;line left
                Lu100  向上画线100   ;line up
                Ld100  向下画线100   ;line down
                L45X100    45度方向画线100             ;极标坐标
                L-45X-100  -45度方向画线-100           ;极标坐标
                L100,300   相对坐标100,300画线         ;相对坐标 ;2011.07.19add
  copy     cc100 co100 向右拷贝100   ;copy right
                cL100  向左拷贝100   ;copy left
                cu100  向上拷贝100   ;copy up
                cd100  向下拷贝100   ;copy down
                c45X100  45度方向拷贝100
                c-45X-100  -45度方向拷贝-100          ;极标坐标
                c100,200   拷贝到相对坐标 100,200     ;相对坐标  ;2011.07.19add
                c,200      拷贝到相对坐标  0,200      ;可以略零               
  offset        o100
  scale         sc100  放大100
  rotate        rt45  ro45  逆时针旋45度
                rt-45 ro-45 顺时针旋45度
  rectang       rec100x200  绘制矩形100x200
  square        sq100       绘制边长100的正方形
   ")
  (prompt "/n
  zoom          za=zoom a;zd=zoom d; ze=zoom e; zo=zoom o;
                zv=zoom v; zp=zoom p;                                2011.07.21add               
  分数亦可以实现，如sc1/2则为SCALE命令缩小0.5倍!
  pscale为调整绘图比例的命令,选取时回车亦可调整绘图比例,默认比例为1:1.
                燕川布衣 QQ:112100528
  ")
        (princ)
  );defun

etoxp

690994 发表于 2011-9-21 10:12
我以前也是将自己常用的定义成命令，但这样还是不够用，
全部定义又太多命令了，不知会不会影响速度。
...

还是看不明白怎么使重复命令有效运行的，能否贴一个能直接运行的简单的完整的程序出来供大家调整、修改？谢谢！！！

690994

gbhsu 发表于 2011-9-20 21:47
没看到你的源码，这样做每次可能还要出现未知命令的提示
我是将未知命令重新定义成命令，可能是繁了点， ...

我以前也是将自己常用的定义成命令，但这样还是不够用，
全部定义又太多命令了，不知会不会影响速度。
至于未知命令提示还是不能消除，好象是CAD判断是未知命令
后才会执行我们定义的程序。好象在论坛看到有个变量能控制
SSGET不显示请选择实体提示的，对这个不知有没在效。
这个不影响使用，我也就懒得试了。
我的代码如下，samcom对应内容是我自己定义的功能。
(defun unknownCommand (calling-reactor commandInfo / c n)        
    (setq c (strcase (car commandInfo)))
    (if (and(setq n(vl-string-search "." c))(wcmatch(substr c n 1) "[A-Z]")) ;f.5>F0.5
        (setq c (strcat(substr c 1 n)"0"(substr c (1+ n))))
    )
    (setq n t)
  (cond
  ((or(wcmatch c "0,200,201,255,256")
     (and(wcmatch c "##")(wcmatch c "~0#"))
    )   
   (setq samcom(strcat"(sam_activelayer \""(vl-princ-to-string c)"\") "))
  )
    ((wcmatch c "[1-9],###,####,#####,######,#######,########")
      (if(= c "345")(setq c "12345"))
      (if(= c "678")(setq c "6789"))
   (setq samcom(strcat "(sam_onlayer \"" (vl-princ-to-string c)"\") "))
  )
  ((and(=(substr c 1 1) "O")
    (numberp (setq n(read(substr c 2))))
    (>= n 10.0)
   )
   (setq samcom(strcat "(sam_laycopy \"" (vl-princ-to-string n) "\") "))
  )
  ((and(=(substr c 1 1) "M")
    (numberp (setq n(read(substr c 2))))
    (>= n 10.0)
   )
   (setq samcom(strcat "(sam_laymove \"" (vl-princ-to-string n) "\") "))
  )
  ((and(=(substr c 1 1) "F")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_fillet " (vl-princ-to-string n) " nil) "))
  )
  ((= c "FF")   
   (setq samcom "(sam_fillet 0.0 nil) ")
  )  
  ((and(=(substr c 1 1) "C")
    (numberp (setq n(read (substr c 2))))
   )
    (setq samcom(strcat "(sam_fillet " (vl-princ-to-string n) " t) "))
  )
  ((and(=(substr c 1 1) "N")
    (numberp (setq n(read(substr c 2))))
   )
   (if(= n 0.0)
      (setq samcom "(sam_co_lts nil nil) ")
      (setq samcom(strcat "(sam_co_lts " (vl-princ-to-string (fix n)) " nil) "))
   )
  )  
  ((and(=(substr c 1 1) "L")
    (numberp (setq n (read (substr c 2))))
   )
    (setq samcom(strcat "(sam_co_lts nil " (vl-princ-to-string n) ") "))
  )
  ((and(=(substr c 1 1) "X")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_xline " (vl-princ-to-string n) ") "))
  )
  ((and(=(substr c 1 1) "D")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_dimbit " (vl-princ-to-string n) ") "))
  )
  ((and(=(substr c 1 1) "H")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_ha_sc " (vl-princ-to-string n) ") "))
  )
  ((and(=(substr c 1 1) "T")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_text_h " (vl-princ-to-string n) ") "))
  )   
  ((and(=(substr c 1 1) "J")
    (numberp (setq n(read(substr c 2))))
   )
   (setq samcom(strcat "(sam_jion_select " (vl-princ-to-string n) ") "))
  )
  (t (setq n nil))
)
(if n(vl-catch-all-apply 'vla-SendCommand (list(vla-get-ActiveDocument (vlax-get-acad-object)) "SmartCommand ")))
(princ)
)
(defun c:SmartCommand( / *doc* )
   (vla-startundomark (setq *doc*(vla-get-activedocument (vlax-get-acad-object))))
   (setvar "cmdecho" 0)      
   (if(and (=(type samcom) 'str)(wcmatch samcom "(sam_*\) "))
      (vl-catch-all-apply 'eval  (list (read samcom))))
  (setvar "cmdecho" 1)
  (vla-endundomark *doc*)
  (princ)
)

etoxp

690994 发表于 2021-9-15 18:02
你还没有明白你的问题，(sam_fillet 0.0 nil)就是一个子函数，能用任何lisp命令，包括vla-sendcommand，v ...

2. 
   
3. (vl-load-com)
   
4. (or *doc*
   
5.     (setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object)))
   
6. )
   
7. (or *unknownCommand*
   
8.     (setq *unknownCommand*
   
9.            (vlr-editor-reactor
   
10.              nil
    
11.              '((:vlr-unknownCommand . unknownCommand))
    
12.            )
    
13.     )
    
14. )
    
15. 
    
16. 
    
17. (defun unknownCommand (a b / CMD CMDLST CMDSTR FLAG I NV UNCMDSTR)
    
18.   ;;---------------------------------------------------
    
19.   (setq UNCmdStr (strcase (car b)))
    
20.   (setq cmdLst (list "DE" "CH"))
    
21.   (setq        flag T
    
22.         i 0
    
23.   )
    
24.   ;;---------------------------------------------------
    
25.   (while (and flag (< i (length cmdLst)))
    
26.     (progn
    
27.       (if (wcmatch UNCmdStr (strcat (nth i cmdLst) "*"))
    
28.         (progn
    
29.           (setq flag nil)
    
30.           (setq cmd (nth i cmdLst))
    
31.         )
    
32.       )
    
33.       (setq i (+ i 1))
    
34.     )
    
35.   )
    
36.   ;;---------------------------------------------------
    
37.   (if flag
    
38.     (progn
    
39.       (princ "\n UNKOWNCOMMAND：未找到对应的命令!")
    
40.       (exit)
    
41.     )
    
42.     (progn      
    
43.       ;;-------------------------------
    
44.       (cond
    
45.         ((= cmd "DE")
    
46.          (progn
    
47.            (setq NV (substr UNCmdStr (+ (strlen cmd) 1)))
    
48.            (setq FCTN (strcat "(XP-UNKOWNCMD-LengthenDE "
    
49.                               (vl-princ-to-string NV)
    
50.                               ") "
    
51.                       )
    
52.            )
    
53.          )
    
54.         )
    
55.       )
    
56.       ;;-------------------------------
    
57.       (cond
    
58.         ((= cmd "CH")
    
59.          (progn
    
60.            (setq NV (substr UNCmdStr (+ (strlen cmd) 1)))
    
61.            (setq FCTN (strcat "(XP-UNKOWNCMD-Chamfer "
    
62.                               (vl-princ-to-string NV)
    
63.                               ") "
    
64.                       )
    
65.            )
    
66.          )
    
67.         )
    
68.       )
    
69.       ;;-------------------------------
    
70.       (vl-catch-all-apply
    
71.         'vla-SendCommand
    
72.         (list (vla-get-ActiveDocument (vlax-get-acad-object))
    
73.               "SmartCommand "
    
74.         )
    
75.       )
    
76.       ;;-------------------------------
    
77.     )
    
78.   )
    
79.   ;;---------------------------------------------------
    
80.   (princ)
    
81. )
    
82. 
    
83. (defun c:SmartCommand (/ *doc*)
    
84.   (vla-startundomark
    
85.     (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
    
86.   )
    
87.   (setvar "cmdecho" 0)
    
88.   (vl-catch-all-apply 'eval (list (read FCTN)))
    
89.   (setvar "cmdecho" 1)
    
90.   (vla-endundomark *doc*)
    
91.   (princ)
    
92. )
    
93. 
    
94. 
    
95. (defun XP-UNKOWNCMD-LengthenDE (NV /)
    
96.   (vl-cmdf "._Lengthen" "DE" NV)
    
97. )
    
98. 
    
99. (defun XP-UNKOWNCMD-Chamfer (NV /)
    
100.   (vl-cmdf "Chamfer" "D" NV NV "Chamfer")
     
101. )
     

<br /> (vl-load-com)<br /> (or *doc*<br />     (setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object)))<br /> )<br /> (or *unknownCommand*<br />     (setq *unknownCommand*<br />            (vlr-editor-reactor<br />              nil<br />              '((:vlr-unknownCommand . unknownCommand))<br />            )<br />     )<br /> )<br /> <br /> <br /> (defun unknownCommand (a b / CMD CMDLST CMDSTR FLAG I NV UNCMDSTR)<br />   ;;---------------------------------------------------<br />   (setq UNCmdStr (strcase (car b)))<br />   (setq cmdLst (list "DE" "CH"))<br />   (setq        flag T<br />         i 0<br />   )<br />   ;;---------------------------------------------------<br />   (while (and flag (< i (length cmdLst)))<br />     (progn<br />       (if (wcmatch UNCmdStr (strcat (nth i cmdLst) "*"))<br />         (progn<br />           (setq flag nil)<br />           (setq cmd (nth i cmdLst))<br />         )<br />       )<br />       (setq i (+ i 1))<br />     )<br />   )<br />   ;;---------------------------------------------------<br />   (if flag<br />     (progn<br />       (princ "\n UNKOWNCOMMAND：未找到对应的命令!")<br />       (exit)<br />     )<br />     (progn      <br />       ;;-------------------------------<br />       (cond<br />         ((= cmd "DE")<br />          (progn<br />            (setq NV (substr UNCmdStr (+ (strlen cmd) 1)))<br />            (setq FCTN (strcat "(XP-UNKOWNCMD-LengthenDE "<br />                               (vl-princ-to-string NV)<br />                               ") "<br />                       )<br />            )<br />          )<br />         )<br />       )<br />       ;;-------------------------------<br />       (cond<br />         ((= cmd "CH")<br />          (progn<br />            (setq NV (substr UNCmdStr (+ (strlen cmd) 1)))<br />            (setq FCTN (strcat "(XP-UNKOWNCMD-Chamfer "<br />                               (vl-princ-to-string NV)<br />                               ") "<br />                       )<br />            )<br />          )<br />         )<br />       )<br />       ;;-------------------------------<br />       (vl-catch-all-apply<br />         'vla-SendCommand<br />         (list (vla-get-ActiveDocument (vlax-get-acad-object))<br />               "SmartCommand "<br />         )<br />       )<br />       ;;-------------------------------<br />     )<br />   )<br />   ;;---------------------------------------------------<br />   (princ)<br /> )<br /> <br /> (defun c:SmartCommand (/ *doc*)<br />   (vla-startundomark<br />     (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))<br />   )<br />   (setvar "cmdecho" 0)<br />   (vl-catch-all-apply 'eval (list (read FCTN)))<br />   (setvar "cmdecho" 1)<br />   (vla-endundomark *doc*)<br />   (princ)<br /> )<br /> <br /> <br /> (defun XP-UNKOWNCMD-LengthenDE (NV /)<br />   (vl-cmdf "._Lengthen" "DE" NV)<br /> )<br /> <br /> (defun XP-UNKOWNCMD-Chamfer (NV /)<br />   (vl-cmdf "Chamfer" "D" NV NV "Chamfer")<br /> )<br />

请帮我看看。上面代码中的 XP-UNKOWNCMD-LengthenDE相当于(sam_fillet)，(FCTN)相当于(samcom)。
麻烦将XP-UNKOWNCMD-LengthenDE中的vl-cmdf改用vla-sendcommand调试一下。

gbhsu

欢迎大家批评指正！

198526

谢谢！还没时间细看，不过很强大，下了有时间学习学习！
再次感谢楼主！

MJCADLWF

我也下来学习学习，楼主辛苦了！

lincctw_ccl

很棒的程式!!
最近忙的頭暈
等過些日子清醒點再來好好研究一下!!
感謝樓主分享!!

ZZXXQQ

cond中的判断可以再简化一下
如：(and (or (eq s "M") (eq s "MOVE") (eq s "ML") (eq s "MR") (eq s "MU") (eq s "MD"))
         (numberp n))
可改为：(and (eq (substr s 1 1) "M") (numberp n))
后面可参照更改

gbhsu

感谢版主！

raimo

这个思路非常好哦..可以很灵活的使用命令

ljpnb

想法不错,举一反三,支持一下.

xiaxiang

好程式，支持一个。望楼主持续扩展