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

zb1374498780 发表于 2018-9-28 14:46:00

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

菜卷鱼 发表于 2018-9-28 15:06:19

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

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

start4444 发表于 2018-9-28 18:04:37

(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 发表于 2024-5-2 16:44:46

(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 sc (/ (distance p0 p1) 27))
(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)
)
按照选择两点的距离除一个系数得出折断线的比例，适合自己用，再次感谢楼主的分享

zb1374498780 发表于 2018-9-28 15:07:57

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

zb1374498780 发表于 2018-9-28 15:12:17

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

谢谢，我试试去。

菜卷鱼 发表于 2018-9-28 15:15:00

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

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

zb1374498780 发表于 2018-9-28 15:16:22

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

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

zb1374498780 发表于 2018-9-28 15:20:12

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

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

菜卷鱼 发表于 2018-9-28 15:23:09

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

删掉 ptlist2 的就可以啦

菜卷鱼 发表于 2018-9-28 15:28:22

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

设置比例试一试？？

yoyoho 发表于 2018-9-28 16:58:22

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

页: [1] 2

明经CAD社区's Archiver

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