求优化折断线命令。
从明经找到一个折断线的代码，此代码每次均需输入比例，并且每次只能画一条折断线。请求大神优化：
1.输入比例后可以记忆设置的比例（例如我输入比例为30，那么下次我在用折断线命令，比例那里自动为30）。
2.如果不退出的话可以一直画折断线。（退出命令可以是右键或者esc等）（就是选择完第二点后，再次让选择第一点，这样不主动退出的话，可以一次画很多条折断线）
以下为代码：
(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
(setq sc (getint "\n请输入出图比例<1>:"))
(if (not sc) (setq sc 1))
(setq p0 (getpoint "\n请选择第一点:"))
(setq p1 (getpoint p0 "\n请选择第二点:"))
(setq ang (angle p0 p1))
(setq p2 (polar p0 ang (/ (distance p0 p1) 2)))
(setq p3 (polar p2 (+ ang (* pi 0.56)) (* 2.25 sc)))
(setq p4 (polar p2 (+ ang (* pi 1.56)) (* 2.25 sc)))
(setq p5 (polar p2 (+ ang pi) (* 1.25 sc)))
(setq p6 (polar p2 ang (* 1.25 sc)))
(if (< (distance p0 p1) (* 7.0 sc))
(progn
(setq p0 (polar p5 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p6 ang (* 2.25 sc)))
)
(progn
(setq p0 (polar p0 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p1 ang (* 2.25 sc)))
)
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(command "PLINE" p0 p5 p3 p4 p6 p1"")
(setvar "osmode" os)
(princ)
)
本帖最后由 bssurvey 于 2020-12-21 14:12 编辑
(setvar "osmode" 0) 是把捕捉關閉
1 是捕捉END(端點)
捕捉的代碼可以參閱
http://docs.autodesk.com/ACD/201 ... 0c4a30acaf-4f1d.htm
(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(if (not scr) (setq scr 1))
(setq sc (getint (strcat "\n请输入出图比例<" (itoa scr) ">:")))
(if (not sc) (setq sc scr))
(setq scr sc)
(setvar "osmode" 1) ;可以放在這捕捉
(while (setq p0 (getpoint "\n请选择第一点:"))
(setvar "osmode" 128);垂直點
(setq p1 (getpoint p0 "\n请选择第二点:"))
(setvar "osmode" 0) ;關閉
(setq ang (angle p0 p1))
(setq p2 (polar p0 ang (/ (distance p0 p1) 2)))
(setq p3 (polar p2 (+ ang (* pi 0.56)) (* 2.25 sc)))
(setq p4 (polar p2 (+ ang (* pi 1.56)) (* 2.25 sc)))
(setq p5 (polar p2 (+ ang pi) (* 1.25 sc)))
(setq p6 (polar p2 ang (* 1.25 sc)))
(if (< (distance p0 p1) (* 7.0 sc))
(progn
(setq p0 (polar p5 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p6 ang (* 2.25 sc)))
)
(progn
(setq p0 (polar p0 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p1 ang (* 2.25 sc)))
)
)
(command "PLINE" p0 p5 p3 p4 p6 p1"")
(setvar "osmode" 1) ;端點
)
(setvar "osmode" os)
(setvar "cmdecho" 1)
(princ)
)
看看是不是這個樣子
(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(if (not scr) (setq scr 1))
(setq sc (getint (strcat "\n请输入出图比例<" (itoa scr) ">:")))
(if (not sc) (setq sc scr))
(setq scr sc)
(while (setq p0 (getpoint "\n请选择第一点:"))
(setq p1 (getpoint p0 "\n请选择第二点:"))
(setq ang (angle p0 p1))
(setq p2 (polar p0 ang (/ (distance p0 p1) 2)))
(setq p3 (polar p2 (+ ang (* pi 0.56)) (* 2.25 sc)))
(setq p4 (polar p2 (+ ang (* pi 1.56)) (* 2.25 sc)))
(setq p5 (polar p2 (+ ang pi) (* 1.25 sc)))
(setq p6 (polar p2 ang (* 1.25 sc)))
(if (< (distance p0 p1) (* 7.0 sc))
(progn
(setq p0 (polar p5 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p6 ang (* 2.25 sc)))
)
(progn
(setq p0 (polar p0 (+ ang pi) (* 2.25 sc)))
(setq p1 (polar p1 ang (* 2.25 sc)))
)
)
(command "PLINE" p0 p5 p3 p4 p6 p1"")
)
(setvar "osmode" os)
(setvar "cmdecho" 1)
(princ)
)
bssurvey 发表于 2020-12-21 08:28
看看是不是這個樣子
(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
(setvar "cmdecho" 0)
大神你好，测试，在选取第一点和第二点的时候不能捕捉，我把关闭捕捉代码删除后，出来的折断线不管比例是多少，都特别的小。
能不能再优化一下，可以捕捉。 我大致明白是在line代码画线之前需要关闭捕捉，然后恢复捕捉，但是我自己试着改了一下，还是不行。 yyz123121 发表于 2020-12-21 11:36
我大致明白是在line代码画线之前需要关闭捕捉，然后恢复捕捉，但是我自己试着改了一下，还是不行。
有沒有圖檔或實例 可以參考 bssurvey 发表于 2020-12-21 11:45
有沒有圖檔或實例 可以參考
不需要图档，您可以新建一个文件，空白都可以，然后输入命令，可以看看，选取第一点和第二点的时候，是无法捕捉的 bssurvey 发表于 2020-12-21 14:03
(setvar "osmode" 0) 是把捕捉關閉
1 是捕捉END(端點)
捕捉的代碼可以參閱
非常完美，我把捕捉代码改成我常用的6143了，谢谢！！ bssurvey 发表于 2020-12-20 18:19
(setvar "osmode" 0) 是把捕捉關閉
1 是捕捉END(端點)
捕捉的代碼可以參閱
大神 我看你给别人回复的新建图层的帖子，可以在优化一下吗
原帖地址：http://bbs.mjtd.com/thread-181622-2-1.html
可以优化成：输入命令后，依次让输入图层名/颜色/线型吗？
(defun c:XJ ()
(setq 0- (rtos (fix(getvar "cdate"))))
(if (= (tblsearch "layer" 0-) nil)
(progn
(setq ed1(getstring "\n请输入图层名称："))
(setq yans(getint "\n请输入颜色："))
(setq xianxing(getstring "\n请输入线型名称："));;输入线型的时候可以不输入全称，只输入co、ce、da就可以对应输入下边的三种线型
（continuous、center、dash);;这三种线型
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(290 . 1) ;1 设为打印 ,0 设为非打印
(cons 62 yans)
(cons 2 ed1)
(cons xxx xianxing);;线型代码
)
)
)
)
(setvar "clayer" ed1)
(princ)
) 其實我不是大神啦，大家互相學習，和大家互相切磋，大家一起進步
試看看是不是這樣
(defun c:XJ ()
(setvar "cmdecho" 0)
(setq ed1(getstring "\n请输入图层名称："))
(setq yans(getint "\n请输入颜色："))
(initget "c e d")
(setq xianxing(getkword "\n请输入线型名称 c<Continuous> e<Center> d<Dashed>："));;输入线型的时候可以不输入全称，只输入co、ce、da就可以对应输入下边的三种线型
;(continuous、center、dash);;这三种线型
(cond
((= xianxing "c")
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(290 . 1) ;1 设为打印 ,0 设为非打印
(cons 62 yans)
(cons 2 ed1)
(cons 6 "Continuous");;线型代码
)
)
)
((= xianxing "e")
(if (not (tblobjname "LTYPE" "CENTER"))
(command "linetype" "l" "CENTER" "acad.lin" "")
)
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(290 . 1) ;1 设为打印 ,0 设为非打印
(cons 62 yans)
(cons 2 ed1)
(cons 6 "CENTER");;线型代码
)
)
)
((= xianxing "d")
(if (not (tblobjname "LTYPE" "DASHED"))
(command "linetype" "l" "DASHED" "acad.lin" "")
)
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(290 . 1) ;1 设为打印 ,0 设为非打印
(cons 62 yans)
(cons 2 ed1)
(cons 6 "DASHED");;线型代码
)
)
)
)
(setvar "clayer" ed1)
(setvar "cmdecho" 1)
(princ)
)
页:
[1]
2