求优化折断线命令。

yyz123121

从明经找到一个折断线的代码，此代码每次均需输入比例，并且每次只能画一条折断线。
请求大神优化：
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

(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)
)

bssurvey

看看是不是這個樣子
(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)
)

yyz123121

bssurvey 发表于 2020-12-21 08:28
看看是不是這個樣子
(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
  (setvar "cmdecho" 0)

大神你好，测试，在选取第一点和第二点的时候不能捕捉，我把关闭捕捉代码删除后，出来的折断线不管比例是多少，都特别的小。
能不能再优化一下，可以捕捉。

yyz123121

我大致明白是在line代码画线之前需要关闭捕捉，然后恢复捕捉，但是我自己试着改了一下，还是不行。

bssurvey

yyz123121 发表于 2020-12-21 11:36
我大致明白是在line代码画线之前需要关闭捕捉，然后恢复捕捉，但是我自己试着改了一下，还是不行。

有沒有圖檔或實例 可以參考

yyz123121

bssurvey 发表于 2020-12-21 11:45
有沒有圖檔或實例 可以參考

不需要图档，您可以新建一个文件，空白都可以，然后输入命令，可以看看，选取第一点和第二点的时候，是无法捕捉的

yyz123121

bssurvey 发表于 2020-12-21 14:03
(setvar "osmode" 0) 是把捕捉關閉
1 是捕捉END(端點)
捕捉的代碼可以參閱

非常完美，我把捕捉代码改成我常用的6143了，谢谢！！

yyz123121

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)                                       
)                 

bssurvey

其實我不是大神啦，大家互相學習，和大家互相切磋，大家一起進步
試看看是不是這樣
(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)                                       
)