YANGF85 发表于 2014-2-26 09:08:42

求一个能实现这个功能的LISP,我手都要弄断了....


我现在是用多段线打断以后再一个个连接,实在太慢了,求大侠给个办法吧,

Gu_xl 发表于 2014-2-26 10:20:45

本帖最后由 Gu_xl 于 2014-2-28 09:19 编辑

;;(c:tt)
(defun c:tt (/ S1 S2 EL      P1 P2 PA PB PC PD ANG VEC N P3 P4 PL L1      L2 E1 E2)
(princ "\n选择要打断的线:")
(setq s1 (ssget '((0 . "line"))))
(if (not s1)
    (exit)
)
(princ "\n选择分割线:")
(setq s2 (ssget '((0 . "line"))))
(if (or (not s2)
          (/= 2 (sslength s2))
      )
    (exit)
)
(setq      el (entget (ssname s1 0))
      p1 (cdr (assoc 10 el))
      p2 (cdr (assoc 11 el))
      el (entget (setq e1 (ssname s2 0)))
      pa (cdr (assoc 10 el))
      pb (cdr (assoc 11 el))
      el (entget (setq e2 (ssname s2 1)))
      pc (cdr (assoc 10 el))
      pd (cdr (assoc 11 el))
)
(setq      ang (angle p1 p2)
      vec (list (cos ang) (sin ang)0)
)
(entdel e1)
(entdel e2)
(repeat (setq n (sslength s1))
    (setq el (entget (setq e1 (ssname s1 (setq n (1- n)))))
          p1 (trans (cdr (assoc 10 el)) 0 vec)
          p2 (trans (cdr (assoc 11 el)) 0 vec)
          p3 (trans
               (inters (cdr (assoc 10 el)) (cdr (assoc 11 el)) pa pb nil)
               0
               vec
             )
          p4 (trans
               (inters (cdr (assoc 10 el)) (cdr (assoc 11 el)) pc pd nil)
               0
               vec
             )
    )
    (entdel e1)
    (setq pl (cons (vl-sort (list p1 p2 p3 p4)
                            '(lambda (a b) (< (caddr a) (caddr b)))
                   )
                   pl
             )
    )
)
(setq pl (vl-sort pl '(lambda (a b) (> (caadr a) (caadr b)))))
(while (cadr pl)
    (setq l1 (car pl)
          l2 (cadr pl)
          p1 (car l1)
          p2 (cadr l1)
          p3 (cadr l2)
          p4 (car l2)
    )
    (entmake
      (list '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            '(90 . 4)
            '(70 . 1)
            '(43 . 0.0)
            '(38 . 0.0)
            '(39 . 0.0)
            (cons 10 (trans p1 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p2 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p3 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p4 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            '(210 0.0 0.0 1.0)
      )
    )
    (setq p1 (caddr l1)
          p2 (cadddr l1)
          p3 (cadddr l2)
          p4 (caddr l2)
    )
    (entmake
      (list '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            '(90 . 4)
            '(70 . 1)
            '(43 . 0.0)
            '(38 . 0.0)
            '(39 . 0.0)
            (cons 10 (trans p1 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p2 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p3 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            (cons 10 (trans p4 vec 0))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 0.0)
            '(210 0.0 0.0 1.0)
      )
    )
    (setq pl (cddr pl))
)
(princ)
)

xyp1964 发表于 2014-2-28 12:34:11



ll_j 发表于 2014-2-26 09:14:52

程序没有实用性,所以不会有人写。
使用CAD的命令的确有点麻烦,不过还是可以优化的:首先,你在两端画线封闭,然后使用BO命令,每个封闭多义线只要点一下即可,最后再删除不需要的,应该快很多。

lixuedong 发表于 2014-2-26 09:29:14

把第一条线 设为A1 和我A4 ,两交点为什么A2 A3
就得到(A1 A2 A3 A4 )
类推:第二条线(B1 B2 B3 B4)
N条线(N1 N2 N3 N4)
这就组成数组。
画线的规律是 A1 A2 B2 B1 A1
然后是 A3 A4 B4 B3 A3

荒野孤行 发表于 2014-2-26 10:37:25

用面域,差集很容易搞定

lixuedong 发表于 2014-2-26 11:31:38

Gu_xl 发表于 2014-2-26 10:20 static/image/common/back.gif


好厉害,这么快完整的程序出来了。大神。

YANGF85 发表于 2014-2-26 12:18:32

Gu_xl 发表于 2014-2-26 10:20 static/image/common/back.gif


大侠给个操作办法?怎么我弄出来是这个样子?

vlisp2012 发表于 2014-2-26 15:03:15

选择直线的时候,按照顺序来啊

Gu_xl 发表于 2014-2-26 15:15:11

YANGF85 发表于 2014-2-26 12:18 static/image/common/back.gif
大侠给个操作办法?怎么我弄出来是这个样子?

重新下载程序再试下!

vlisp2012 发表于 2014-2-26 16:53:27

Gu版,给力!!!
页: [1] 2
查看完整版本: 求一个能实现这个功能的LISP,我手都要弄断了....