折断线lisp，加载有些情况生成不了。高手帮解决一下呗

zb1374498780

(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
        (setq sc (getint "\n请输入出图比例<100>:"))
        (if (not sc) (setq sc 100))
        (setq p0 (getpoint "1"))
        (setq p1 (getpoint p0 "2"))
        (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)))
                )
        )
        (点表多段线 (list p0 p5 p3 p4 p6 p1) 0 3)
        (princ)
)

;;点表生成多段线
(defun 点表多段线(点表 线宽 颜色)
  (entmake (append (list '(0 . "LWPOLYLINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbPolyline")
                         (cons 90 (length 点表))
                         (cons 43 线宽)
                         (cons 62 颜色)
                        )
                        (mapcar '(lambda (pt)
                                        (cons 10 pt)
                                )
                                点表
                        )
                )
        )
)

菜卷鱼

第一次看到有这么多中文变量的程序，来试一下我的吧，一次画2条

1. (defun c:qx  (/ qxscale pts pte dis ang sc ptl  ptu ptc  ptr ptd  ptlist
   
2.          ptlist2)
   
3.   (if (= (getenv "qxscale") nil)(setenv "qxscale" "50"))
   
4.   (mapcar 'princ (list "当前比例: " (getenv "qxscale")))
   
5.   (initget "s")
   
6.   (setq pts (getpoint "\n起点[比例设置(S)]:"))
   
7.   (while (= pts "s")
   
8.     (setq qxscale (getreal "\n切断线比例:"))
   
9.     (setenv "qxscale" (rtos qxscale 2 2))
   
10.     (setq pts (getpoint "\n起点:"))
    
11.     )
    
12.   (setq pts (trans pts 1 0))
    
13.   (setq pte (getpoint pts "\n终点:"))
    
14.   (setq pte (trans pte 1 0))
    
15.   (setq dis (distance pts pte))
    
16.   (setq ang (angle ptS ptE))
    
17.   (setq sc (atof (getenv "qxscale")))
    
18.   (setq ctp (mapcar '/ (mapcar '+ pts pte) '(2 2 2)))
    
19.   (setq ptl (polar ctp (+ pi ang) (* 4 sc)))
    
20. ;;;;左点
    
21.   (setq ptu (polar ctp (+ ang (angtof "108")) (* 4 sc)))
    
22. ;;;;上点
    
23.   (setq ptd (polar ctp (+ ang (angtof "288")) (* 4 sc)))
    
24. ;;;;下点
    
25.   (setq ptr (polar ctp (+ 0 ang) (* 4 sc)))
    
26. ;;;;右点
    
27.   (setq ptlist (list pts ptl ptu ctp ptd ptr pte))
    
28. ;;; (undobe)
    
29.   (entmake
    
30.     (append (list '(0 . "LWPOLYLINE")
    
31.       '(100 . "AcDbEntity")
    
32.       '(100 . "AcDbPolyline")
    
33.       (cons 90 (length ptlist)))
    
34.       (mapcar '(lambda (pt) (cons 10 pt)) ptlist)))
    
35.   (setq  ptlist2
    
36.    (mapcar
    
37.      '(lambda (x) (polar x (+ ang (angtof "262")) (* 3 sc)))
    
38.      ptlist))
    
39.   (entmake
    
40.     (append (list '(0 . "LWPOLYLINE")
    
41.       '(100 . "AcDbEntity")
    
42.       '(100 . "AcDbPolyline")
    
43.       (cons 90 (length ptlist2)))
    
44.       (mapcar '(lambda (pt) (cons 10 pt)) ptlist2)))
    
45. ;;; (undoe)
    
46.   (prin1)
    
47.   )

(defun c:qx  (/ qxscale pts pte dis ang sc ptl  ptu ptc  ptr ptd  ptlist<br />          ptlist2)<br />   (if (= (getenv "qxscale") nil)(setenv "qxscale" "50"))<br />   (mapcar 'princ (list "当前比例: " (getenv "qxscale")))<br />   (initget "s")<br />   (setq pts (getpoint "\n起点[比例设置(S)]:"))<br />   (while (= pts "s")<br />     (setq qxscale (getreal "\n切断线比例:"))<br />     (setenv "qxscale" (rtos qxscale 2 2))<br />     (setq pts (getpoint "\n起点:"))<br />     )<br />   (setq pts (trans pts 1 0))<br />   (setq pte (getpoint pts "\n终点:"))<br />   (setq pte (trans pte 1 0))<br />   (setq dis (distance pts pte))<br />   (setq ang (angle ptS ptE))<br />   (setq sc (atof (getenv "qxscale")))<br />   (setq ctp (mapcar '/ (mapcar '+ pts pte) '(2 2 2)))<br />   (setq ptl (polar ctp (+ pi ang) (* 4 sc)))<br /> ;;;;左点<br />   (setq ptu (polar ctp (+ ang (angtof "108")) (* 4 sc)))<br /> ;;;;上点<br />   (setq ptd (polar ctp (+ ang (angtof "288")) (* 4 sc)))<br /> ;;;;下点<br />   (setq ptr (polar ctp (+ 0 ang) (* 4 sc)))<br /> ;;;;右点<br />   (setq ptlist (list pts ptl ptu ctp ptd ptr pte))<br /> ;;; (undobe)<br />   (entmake<br />     (append (list '(0 . "LWPOLYLINE")<br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbPolyline")<br />       (cons 90 (length ptlist)))<br />       (mapcar '(lambda (pt) (cons 10 pt)) ptlist)))<br />   (setq  ptlist2<br />    (mapcar<br />      '(lambda (x) (polar x (+ ang (angtof "262")) (* 3 sc)))<br />      ptlist))<br />   (entmake<br />     (append (list '(0 . "LWPOLYLINE")<br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbPolyline")<br />       (cons 90 (length ptlist2)))<br />       (mapcar '(lambda (pt) (cons 10 pt)) ptlist2)))<br /> ;;; (undoe)<br />   (prin1)<br />   )

start4444

(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
        (setq sc (getint "\n请输入出图比例<100>:"))
        (if (not sc) (setq sc 100))
        (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)
)


是不是自定义函数搞错了，直接改成command吧

Qwer1243

1. (defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)
   
2.         ;(setq sc (getint "\n请输入出图比例<100>:"))
   
3.         ;(if (not sc) (setq sc 100))
   
4.         (setq p0 (getpoint "\n请选择第一点:"))
   
5.         (setq p1 (getpoint p0 "\n请选择第二点:"))
   
6.         (setq sc (/ (distance p0 p1) 27))
   
7.         (setq ang (angle p0 p1))
   
8.         (setq p2 (polar p0 ang (/ (distance p0 p1) 2)))
   
9.         (setq p3 (polar p2 (+ ang (* pi 0.56)) (* 2.25 sc)))
   
10.         (setq p4 (polar p2 (+ ang (* pi 1.56)) (* 2.25 sc)))
    
11.         (setq p5 (polar p2 (+ ang pi) (* 1.25 sc)))
    
12.         (setq p6 (polar p2 ang (* 1.25 sc)))
    
13.         (if (< (distance p0 p1) (* 7.0 sc))
    
14.                 (progn
    
15.                         (setq p0 (polar p5 (+ ang pi) (* 2.25 sc)))
    
16.                         (setq p1 (polar p6 ang (* 2.25 sc)))
    
17.                 )
    
18.                 (progn
    
19.                         (setq p0 (polar p0 (+ ang pi) (* 2.25 sc)))
    
20.                         (setq p1 (polar p1 ang (* 2.25 sc)))
    
21.                 )
    
22.         )
    
23.         (setq os (getvar "osmode"))
    
24.   (setvar "osmode" 0)
    
25.         (command "PLINE" p0 p5 p3 p4 p6 p1"")
    
26.         (setvar "osmode" os)
    
27.   (princ)
    
28. )

(defun c:zdx(/ ang p0 p1 p2 p3 p4 p5 p6 sc)<br />         ;(setq sc (getint "\n请输入出图比例<100>:"))<br />         ;(if (not sc) (setq sc 100))<br />         (setq p0 (getpoint "\n请选择第一点:"))<br />         (setq p1 (getpoint p0 "\n请选择第二点:"))<br />         (setq sc (/ (distance p0 p1) 27))<br />         (setq ang (angle p0 p1))<br />         (setq p2 (polar p0 ang (/ (distance p0 p1) 2)))<br />         (setq p3 (polar p2 (+ ang (* pi 0.56)) (* 2.25 sc)))<br />         (setq p4 (polar p2 (+ ang (* pi 1.56)) (* 2.25 sc)))<br />         (setq p5 (polar p2 (+ ang pi) (* 1.25 sc)))<br />         (setq p6 (polar p2 ang (* 1.25 sc)))<br />         (if (< (distance p0 p1) (* 7.0 sc))<br />                 (progn<br />                         (setq p0 (polar p5 (+ ang pi) (* 2.25 sc)))<br />                         (setq p1 (polar p6 ang (* 2.25 sc)))<br />                 )<br />                 (progn<br />                         (setq p0 (polar p0 (+ ang pi) (* 2.25 sc)))<br />                         (setq p1 (polar p1 ang (* 2.25 sc)))<br />                 )<br />         )<br />         (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />         (command "PLINE" p0 p5 p3 p4 p6 p1"")<br />         (setvar "osmode" os)<br />   (princ)<br /> )

按照选择两点的距离除一个系数得出折断线的比例，适合自己用，再次感谢楼主的分享

zb1374498780

拾取了交点，但是发现剖断线在其他位置生成了，没有在我拾取得两个交点之间生成。这是为什么？

zb1374498780

菜卷鱼 发表于 2018-9-28 15:06
第一次看到有这么多中文变量的程序，来试一下我的吧，一次画2条

谢谢，我试试去。

菜卷鱼

zb1374498780 发表于 2018-9-28 15:12
谢谢，我试试去。

(setq pts (trans pts 1 0))  
也许是你差这一句

zb1374498780

菜卷鱼 发表于 2018-9-28 15:06
第一次看到有这么多中文变量的程序，来试一下我的吧，一次画2条

有没有，单线的，我一条的折断线用的较多

zb1374498780

菜卷鱼 发表于 2018-9-28 15:06
第一次看到有这么多中文变量的程序，来试一下我的吧，一次画2条

还有一个问题，生成的双线条折断线两边为啥是光秃秃的，没有伸出来一点

菜卷鱼

zb1374498780 发表于 2018-9-28 15:20
还有一个问题，生成的双线条折断线两边为啥是光秃秃的，没有伸出来一点

删掉 ptlist2 的就可以啦

菜卷鱼

zb1374498780 发表于 2018-9-28 15:20
还有一个问题，生成的双线条折断线两边为啥是光秃秃的，没有伸出来一点

设置比例试一试？？

yoyoho

谢谢! 两位分享学习!!!!