求助画矩形的改造优化
本帖最后由 andyzha 于 2020-4-14 14:14 编辑经常用矩形，希望达到像wowan1314大神一样的改造，实现如下功能：1.默认不点右键是输入长和高画矩形模式。且长+高可以用“/”分格，例如画20*50的矩形，就输入20/50。2.运行命令后右键进入正常点选画矩形，
大神们可以参考一下的lisp：
(defun c:recc ( / pt2 pt3 cen yy xx)
(if (= nil (setq pt3 (getpoint "\n请输入矩形对角点<回车进入输入长宽模式>"(setq cen (getpoint "\n请输入矩形起点")))))
(progn
(setq xx (car cen)
yy (cadr cen))
(setq X- (getdist"\n请输入长度"))
(if (= x- nil) (quit ))
(setq y- (getdist"\n请输入宽度"))
(if (= y- nil) (quit ))
(setq pt2 (list (+ x- xx)(+ y- yy)))
(command"RECTANG" cen pt2 )
)
(progn
(command"RECTANG" cen pt3 )
)
)
(princ)
)
本帖最后由 lee50310 于 2020-4-16 00:10 编辑
1.默认不点右键是输入长和高画矩形模式。且长+高可以用“/”分格，例如画20*50的矩形，就输入20/50。2.运行命令后右键进入正常点选画矩形，
(defun c:test ()
(setq ss (getstring "\n输入 长/高 画矩形模式: "))
(setq pt (getpoint "\n指定基点:"))
(setq x (carpt))
(setq y (cadr pt))
(setqnn (strlen ss)
break nil
lst nil
j 1
)
(repeat nn
(setq tt (substr ss j 1))
(if (= tt "/")(setq break j))
(setq j (1+ j))
)
(if (and (/= break nil)(< break j))
(progn
(setq t1 (read(substr ss 1 (- break 1 ))) ) ;;取/前字符串 (不含/)
(setq t2 (read(substr ss (+ break 1 )(- nn break)))) ;;取/后字符串 (不含/)
)
)
(setq pt2 (list (+ x t1) (+ y t2)))
(command "RECTANG" pt pt2 )
)
本帖最后由 cq4920 于 2020-4-16 21:42 编辑
andyzha 发表于 2020-4-16 13:16
能加入右键模式更好，默认是选两点画矩形，右键是输入20/30模式画矩形。
参考了黄大师的代码终于实现了！
可以空格输入尺寸也可以回车或者右键输入尺寸
尺寸数字中间可以是任意符号
这里有个瑕疵 就是当指定下一点的时候 如果不小心输入了字母那么安空格就会提示错误
如果可以加入只要不是点击下一点不管是按空格还是不小心输入了文字再按空都转到输入尺寸画矩形就好了
优化一下 防止习惯按D不能继续命令！如果按D可以继续按原始方法继续画！
<div class="blockcode"><blockquote>(defun C:rec(/ x y pta ptb)
(setq pta (getpoint "\n指定基点"))
(initget "A D R")
(if (setq ptb (getcorner pta "\n>>>指定下一点:【空格：尺寸输入】[面积(S)/尺寸(D)/旋转(R)]:"))
(command "rectang" pta ptb)
(progn
(setq lst (getNumberS(setq ss (getstring "\n 宽 & 高 : <30*30>"))))
(setq x (car lst))
(setq y (cadr lst))
(command "rectang" pta "d" x y pause)
)
)
(princ)
)
;;自贡黄明儒--提取数字
(defun getNumberS (str / ASC N STR1 STRN)
(setq n 1)
(setq str1 "")
(repeat (strlen str)
(setq strn (substr str n 1))
(setq Asc (ascii strn))
(if(or (and (> Asc 47) (< Asc 58)) (= Asc 46))
(setq str1 (strcat str1 strn))
(setq str1 (strcat str1 " "))
)
(setq n (1+ n))
)
(strinSplitS str1)
)
(defun strinSplitS (str / lst)
(setq str (STRCAT "(" str ")"))
(setq lst (read str))
(setq lst (mapcar 'VL-PRINC-TO-STRING lst))
)
本帖最后由 lee50310 于 2020-4-16 18:56 编辑
1.能在优化一下吗，空格尺寸以后直接输入20/30或者20,30就直接画20*30的矩形了。
2.能加入右键模式更好，默认是选两点画矩形，右键是输入20/30模式画矩形。
問題1.輸入尺寸後 總要把矩形框插入圖面,指定位置因此需要插入點詢問
除非你的插入點都一律固定在座標原點 (0,0)位置
也許可改另一種方式 把常用的一個尺寸加入到詢問尺寸輸入內
例: "輸入 長/高 畫矩形模式< 30/50 >:"
若不需輸入其他尺寸按 空格或enter鍵 點選插入點繪出 30*50矩型
問題2."[默认是选两点画矩形，右键是输入20/30模式画矩形。]"
若要兩點畫矩型 ,就不能輸入固定尺寸例:20/30
因為尺寸要依谁為準呢?
用api吧，lisp做jig限制太多。就算是pointMonitor也比grread强太多 (defun C:rec(/ x y pta ptb)
(setq pta (getpoint "\n指定基点"))
(if (setq ptb (getcorner pta "\n指定下一点<空格尺寸>"))
(command "rectang" pta ptb)
(progn
(if (= (setq x (getdist"\n设置水平宽度<默认值30>")) nil)
(setq x 30))
(if (= (setq y (getdist"\n设置垂直高度<默认值同宽>")) nil)
(setq y x))
(command "rectang" pta "d" x y pause)
)
)
(princ)
)
cq4920 发表于 2020-4-14 19:29
基本上也能满足我的需求了，多谢多谢 能不能改下：用空格代替/? lee50310 发表于 2020-4-16 00:00
cad的默认矩形希望也能加上就好了 本帖最后由 lee50310 于 2020-4-16 11:35 编辑
bai2000 发表于 2020-4-16 09:56
能不能改下：用空格代替/?
要用什麼代替 只需將式中的 "/"換成想要替代的
例 30x50那判斷式改成 (if (= tt "x")
30*50那判斷式改成 (if (= tt "*")
30 50 空格 則改成 (if (= tt " ")
空格可改但行不通
因為空格在AutoCad代表 Enter鍵
會結束此行執行下一行
cq4920 发表于 2020-4-14 19:29
能在优化一下吗，空格尺寸以后直接输入20/30或者20,30就直接画20*30的矩形了。 本帖最后由 andyzha 于 2020-4-16 13:19 编辑
cq4920 发表于 2020-4-14 19:29
能加入右键模式更好，默认是选两点画矩形，右键是输入20/30模式画矩形。
页:
[1]
2