cmd+num 命令简称加任意数字组成智能命令[07.20]
本帖最后由 gbhsu 于 2012-10-20 21:42 编辑;;;这几天不用画图了，有时间编编小程，到也觉得轻松！呵呵
;;;感谢明经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组成命令
现已解决了：
filletf100 f150.5即f+任意数字可成命令
move m100mr100向右移100 ;move right
mL100向左移100 ;move left
mu100向上移100 ;move up
md100向下移100 ;move down
m45X10045度方向移动100
m-45X-100-45度方向移动-100 ;极标坐标
m100,200 移动到相对坐标 100,200 ;相对坐标
m,200 移动到相对坐标0,200 ;可以略零
circle c100 画半径为100的圆
选取D[仅选一次即可]画直径为100的圆 ;2011.07.20add
chamfery100 cha100 倒角100
y100x200 倒角100X200 ;2011.07.19add
y100,200 倒角100X200 ;2011.07.19add
stretchs100 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
c45X10045度方向拷贝100
c-45X-100-45度方向拷贝-100 ;极标坐标
c100,200 拷贝到相对坐标 100,200 ;相对坐标;2011.07.19add
c,200 拷贝到相对坐标0,200 ;可以略零
offset o100
scale sc100放大100
rotate rt45ro45逆时针旋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
690994 发表于 2011-9-21 10:12
我以前也是将自己常用的定义成命令，但这样还是不够用，
全部定义又太多命令了，不知会不会影响速度。
...
还是看不明白怎么使重复命令有效运行的，能否贴一个能直接运行的简单的完整的程序出来供大家调整、修改？谢谢！！！ gbhsu 发表于 2011-9-20 21:47 static/image/common/back.gif
没看到你的源码，这样做每次可能还要出现未知命令的提示
我是将未知命令重新定义成命令，可能是繁了点， ...
我以前也是将自己常用的定义成命令，但这样还是不够用，
全部定义又太多命令了，不知会不会影响速度。
至于未知命令提示还是不能消除，好象是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) "")) ;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 ",###,####,#####,######,#######,########")
(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)
)
690994 发表于 2021-9-15 18:02
你还没有明白你的问题，(sam_fillet 0.0 nil)就是一个子函数，能用任何lisp命令，包括vla-sendcommand，v ...
(vl-load-com)
(or *doc*
(setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *unknownCommand*
(setq *unknownCommand*
(vlr-editor-reactor
nil
'((:vlr-unknownCommand . unknownCommand))
)
)
)
(defun unknownCommand (a b / CMD CMDLST CMDSTR FLAG I NV UNCMDSTR)
;;---------------------------------------------------
(setq UNCmdStr (strcase (car b)))
(setq cmdLst (list "DE" "CH"))
(setq flag T
i 0
)
;;---------------------------------------------------
(while (and flag (< i (length cmdLst)))
(progn
(if (wcmatch UNCmdStr (strcat (nth i cmdLst) "*"))
(progn
(setq flag nil)
(setq cmd (nth i cmdLst))
)
)
(setq i (+ i 1))
)
)
;;---------------------------------------------------
(if flag
(progn
(princ "\n UNKOWNCOMMAND：未找到对应的命令!")
(exit)
)
(progn
;;-------------------------------
(cond
((= cmd "DE")
(progn
(setq NV (substr UNCmdStr (+ (strlen cmd) 1)))
(setq FCTN (strcat "(XP-UNKOWNCMD-LengthenDE "
(vl-princ-to-string NV)
") "
)
)
)
)
)
;;-------------------------------
(cond
((= cmd "CH")
(progn
(setq NV (substr UNCmdStr (+ (strlen cmd) 1)))
(setq FCTN (strcat "(XP-UNKOWNCMD-Chamfer "
(vl-princ-to-string NV)
") "
)
)
)
)
)
;;-------------------------------
(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)
(vl-catch-all-apply 'eval (list (read FCTN)))
(setvar "cmdecho" 1)
(vla-endundomark *doc*)
(princ)
)
(defun XP-UNKOWNCMD-LengthenDE (NV /)
(vl-cmdf "._Lengthen" "DE" NV)
)
(defun XP-UNKOWNCMD-Chamfer (NV /)
(vl-cmdf "Chamfer" "D" NV NV "Chamfer")
)
请帮我看看。上面代码中的 XP-UNKOWNCMD-LengthenDE相当于(sam_fillet)，(FCTN)相当于(samcom)。
麻烦将XP-UNKOWNCMD-LengthenDE中的vl-cmdf改用vla-sendcommand调试一下。 欢迎大家批评指正！ 谢谢！还没时间细看，不过很强大，下了有时间学习学习！
再次感谢楼主！ 我也下来学习学习，楼主辛苦了！ 本帖最后由 lincctw_ccl 于 2011-7-18 22:58 编辑
很棒的程式!!
最近忙的頭暈
等過些日子清醒點再來好好研究一下!!
感謝樓主分享!! 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))
后面可参照更改 感谢版主！ 这个思路非常好哦..可以很灵活的使用命令 想法不错,举一反三,支持一下.
好程式，支持一个。望楼主持续扩展