基础函数的一点应用（四根线内内、外外分别相交）

mmh1

(defun zj1(l1 / a p1 p2 p1_x p2_x)
  (setq a (entget l1))
  (setq p1 (cdr(assoc 10 a)))
  (setq p2 (cdr(assoc 11 a)))
  (setq p1_x (car p1))
  (setq p2_x (car p2))
  (if (> p1_x p2_x)
    (setq du1 (angle p2 p1))
    (setq du1 (angle p1 p2))
    )
  )
(defun zj2(w1 w2)
  (setq p1 (cdr (assoc 10 (entget w1))))
  (setq p2 (cdr (assoc 11 (entget w1))))
  (setq p3 (cdr (assoc 10 (entget w2))))
  (setq p4 (cdr (assoc 11 (entget w2))))
  (setq p1_x (car p1))
  (setq p1_y (cadr p1))
  (setq p2_x (car p2))
  (setq p2_y (cadr p2))
  (setq p3_x (car p3))
  (setq p3_y (cadr p3))
  (setq p4_x (car p4))
  (setq p4_y (cadr p4))
  (setq p5y (+(* (/ (- p1_y p2_y) (- p1_x p2_x)) p3_x) (/(-(* p1_x p2_y)(* p2_x p1_y))(- p1_x p2_x))))
  )
(defun c:yy1()
  (setq ss (ssget))
  (setq m 0 n 0)
  (setq t1 (ssadd))
  (setq t2 (ssadd))
  (repeat (sslength ss)
    (setq en (ssname ss m))
    (zj1 en)
    (if (> du1 pi)
      (setq t1 (ssadd en t1))
      (setq t2 (ssadd en t2))
      )
    (setq m (1+ m))
    )
      (setq w1 (ssname t1 0))
      (setq w2 (ssname t1 1))
        (zj2 w1 w2)
      (if (< p5y p3_y)
        (progn
        (setq mm w1)
        (setq w1 w2)
        (setq w2 mm))
        )
      (setq w3 (ssname t2 0))
      (setq w4 (ssname t2 1))
        (zj2 w3 w4)
      (if (< p5y p3_y)
        (progn
        (setq nn w3)
        (setq w3 w4)
        (setq w4 nn))
        )
  (command "fillet" "r" 0)
  (command "fillet" w1 w3)
  (command "fillet" w2 w4)
  (princ)
  )
取两个八字形不相交的四条线！

cnks

不是很明白

ljpnb

测试了一下，有点问题

myjping

这个主要是算法上的问题