线段两端连线

kkq0305

瞎写主要是练习表函数 lisp语言的和别的最大不同


(defun c:tt1 ()
  (setq ss (ssget '((0 . "LINE"))))
  (setq        entlst (vl-remove-if-not
                 '(lambda (x) (= 'ENAME (type x)))
                 (apply 'append (ssnamex ss))
               )
  );获取图元表
  (setq        ptlst
         (mapcar
           '(lambda (x)
              (mapcar 'cdr
                      (vl-remove-if-not
                        '(lambda (a) (or (= 10 (car a)) (= 11 (car a))))
                        (entget x)
                      )
              )
            )
           entlst
         )
  );获取端点表
  (setq        ptlst
         (mapcar
           '(lambda (x)
              (apply
                '(lambda (a b)
                   (if
                     (or (< (car a) (car b))
                         (and (= (car a) (car b)) (< (cadr a) (cadr b)))
                     )
                      (list a b)
                      (list b a)
                   )
                 )
                x
              )
            )
           ptlst
         )
  );将端点按左右分类
  (setq pt0 (apply 'mapcar (cons 'min (apply 'append ptlst))));求基准点
  (mapcar
    '(lambda (lst)
       (entmake
         (append
           (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 (cons 90 (length lst))
                 '(62 . 1)
           )
           (mapcar
             '(lambda (pt) (cons 10 pt))
             (vl-sort lst
                      '(lambda (a b) (< (angle pt0 a) (angle pt0 b)));按照与基准点角度大小排序
             )
           )
         )
       )
     );生成多段线
    (apply 'mapcar (cons 'list ptlst));将端点表分开
  )
  (princ)
)
另外一种思路，方法一有bug  主要是基点位置选择影响大


(defun c:tt2 ()
  (defun ltt (lst ptl / npt);函数确定lst线段在pt线的左右位置都在左返回t 否则nil lst (ptl1 ptl2 ...ptln)组成的线段表ptl 包含两个不同pt点的表
    (setq npt (mapcar '* '(1.0 1.0) (mapcar '- (cadr ptl) (car ptl))));保存ptl的向量
    (vl-every
      '(lambda (a) (>= a 0))
      (mapcar '(lambda (x)
                 (apply        '(lambda (a b c d) (- (* a d) (* b c)))
                        (append npt (mapcar '* '(1.0 1.0) (mapcar '- (car x) (car ptl))))
                 );计算lst表中每个线段在ptl的位置
               )
              lst
      )
    );表中元素都不为负返回t否则nil
  )
  (setq ss (ssget))
  (setq        entlst (vl-remove-if-not
                 '(lambda (x) (= 'ENAME (type x)))
                 (apply 'append (ssnamex ss))
               )
  );获取图元表
  (setq        ptlst
         (mapcar
           '(lambda (x)
              (mapcar 'cdr
                      (vl-remove-if-not
                        '(lambda (a) (or (= 10 (car a)) (= 11 (car a))))
                        (entget x)
                      )
              )
            )
           entlst
         )
  );获取端点表
  (setq        ptlst
         (mapcar
           '(lambda (x)
              (apply
                '(lambda (a b)
                   (if
                     (or (< (car a) (car b))
                         (and (= (car a) (car b)) (< (cadr a) (cadr b)))
                     )
                      (list a b)
                      (list b a)
                   )
                 )
                x
              )
            )
           ptlst
         )
  );将端点按左右分类
  (setq ptclst '())
  (while ptlst
    (setq pt (car (vl-remove-if-not '(lambda (x) (ltt ptlst x)) ptlst)))
    (setq ptlst (vl-remove pt ptlst))
    (setq ptclst (cons pt ptclst)));按照顺序输出ptl表保存在ptclst中
  (mapcar
    '(lambda (lst)
       (entmake
         (append
           (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 (cons 90 (length lst))
                 '(62 . 1)
           )
           (mapcar
             '(lambda (pt) (cons 10 pt))
             lst
           )
         )
       )
     );生成多段线
    (apply 'mapcar (cons 'list ptclst));将端点表分开
  )
  (princ)
)

llsheng_73

1. (defun PToLn(p p1 p2)
   
2.   (trans(mapcar(function -)p1 p)0(mapcar(function -)p1 p2)))
   
3. (defun startend(e)
   
4.   (list(vlax-curve-getstartpoint e)
   
5.        (vlax-curve-getendpoint e)))
   
6. (defun makepl(arg)
   
7.       (entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr arg)))
   
8.                       (cons(cons 90(length(car arg)))(cons(cons 70(if(cadr arg)(cadr arg)0))(mapcar'(lambda(x)(cons 10 x))(car arg)))))))
   
9. (defun c:tt(/ ss pt i e)
   
10.   (vl-load-com)
    
11.   (and(setq i 0 ss(ssget'((-4 . "<or")(0 . "line")(-4 . "<and")(0 . "*polyline")(-4 . "=")(90 . 2)(-4 . "and>")(-4 . "or>"))))
    
12.       (vl-every(function set)'(p1 p2)(startend(ssname ss 0)))
    
13.       (setq pt(list(List(vl-list* 0 0 0 p1))(list(vl-list* 0 0 1 p2))))
    
14.       (while(setq i(+ i 1)e(ssname ss i))
    
15.         (setq pt(mapcar(function cons)
    
16.                (vl-sort(mapcar(function(lambda(x)(append(PToLn x p1 p2)x)))(startend e))
    
17.                 (function(lambda(x y)(<(caddr x)(caddr y)))))pt)))
    
18.       (setq pt(mapcar(function(lambda(x fun)(mapcar(function cdddr)(vl-sort x(function(lambda(x y)(fun(car x)(car y))))))))pt(list < >)))
    
19.       (makepl(list(apply(function append)pt)1))))

(defun PToLn(p p1 p2)<br />   (trans(mapcar(function -)p1 p)0(mapcar(function -)p1 p2)))<br /> (defun startend(e)<br />   (list(vlax-curve-getstartpoint e)<br />        (vlax-curve-getendpoint e)))<br /> (defun makepl(arg)<br />       (entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr arg)))<br />                       (cons(cons 90(length(car arg)))(cons(cons 70(if(cadr arg)(cadr arg)0))(mapcar'(lambda(x)(cons 10 x))(car arg)))))))<br /> (defun c:tt(/ ss pt i e)<br />   (vl-load-com)<br />   (and(setq i 0 ss(ssget'((-4 . "<or")(0 . "line")(-4 . "<and")(0 . "*polyline")(-4 . "=")(90 . 2)(-4 . "and>")(-4 . "or>"))))<br />       (vl-every(function set)'(p1 p2)(startend(ssname ss 0)))<br />       (setq pt(list(List(vl-list* 0 0 0 p1))(list(vl-list* 0 0 1 p2))))<br />       (while(setq i(+ i 1)e(ssname ss i))<br />         (setq pt(mapcar(function cons)<br />                (vl-sort(mapcar(function(lambda(x)(append(PToLn x p1 p2)x)))(startend e))<br />                 (function(lambda(x y)(<(caddr x)(caddr y)))))pt)))<br />       (setq pt(mapcar(function(lambda(x fun)(mapcar(function cdddr)(vl-sort x(function(lambda(x y)(fun(car x)(car y))))))))pt(list < >)))<br />       (makepl(list(apply(function append)pt)1))))

;;;取选择集第一条线为基准线
;;;其它线求它们的起止点到基准线的投影，按投影后所在位置区分左右端点
;;;分别对左右端点表按到基准线的距离排序（左端点从小到大，右端点从大到小）
;;;用排序后的眼点集绘制闭合多段线

1681008

xyp1964 发表于 2023-4-12 20:17
需要提供dwg文件及目的要求

多线段批量连接
多谢大神出手相助，谢谢！

kkq0305

1681008 发表于 2023-4-13 06:10
感谢大神出手相助
静待分享，谢谢！

主要是展示  表函数的 用法的  没有对应功能的开发

Klein

端点分类排序是精髓，如何将点表按需求分类确实很考验技术

Noangler

这些用在什么地方呀.

guosheyang

感谢两位大佬的分享！

菜鸟初来乍到

感谢楼主分享

chenbh2

这个厉害了！

丶吟游诗人灬

看起来很高级

nijiea123

不错不错 看起来很不错

Carter丶Bo

高级！！！！！