社区 › AutoLISP/Visual LISP 编程技术 › 线段两端连线

kkq0305 发表于 2023-4-4 14:16:48

线段两端连线

本帖最后由 kkq0305 于 2023-4-13 10:43 编辑

瞎写主要是练习表函数 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 发表于 2023-4-4 16:02:14

本帖最后由 llsheng_73 于 2023-4-4 16:14 编辑

(defun PToLn(p p1 p2)
(trans(mapcar(function -)p1 p)0(mapcar(function -)p1 p2)))
(defun startend(e)
(list(vlax-curve-getstartpoint e)
       (vlax-curve-getendpoint e)))
(defun makepl(arg)
      (entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr arg)))
                      (cons(cons 90(length(car arg)))(cons(cons 70(if(cadr arg)(cadr arg)0))(mapcar'(lambda(x)(cons 10 x))(car arg)))))))
(defun c:tt(/ ss pt i e)
(vl-load-com)
(and(setq i 0 ss(ssget'((-4 . "<or")(0 . "line")(-4 . "<and")(0 . "*polyline")(-4 . "=")(90 . 2)(-4 . "and>")(-4 . "or>"))))
      (vl-every(function set)'(p1 p2)(startend(ssname ss 0)))
      (setq pt(list(List(vl-list* 0 0 0 p1))(list(vl-list* 0 0 1 p2))))
      (while(setq i(+ i 1)e(ssname ss i))
      (setq pt(mapcar(function cons)
               (vl-sort(mapcar(function(lambda(x)(append(PToLn x p1 p2)x)))(startend e))
                (function(lambda(x y)(<(caddr x)(caddr y)))))pt)))
      (setq pt(mapcar(function(lambda(x fun)(mapcar(function cdddr)(vl-sort x(function(lambda(x y)(fun(car x)(car y))))))))pt(list < >)))
      (makepl(list(apply(function append)pt)1))))
;;;取选择集第一条线为基准线
;;;其它线求它们的起止点到基准线的投影，按投影后所在位置区分左右端点
;;;分别对左右端点表按到基准线的距离排序（左端点从小到大，右端点从大到小）
;;;用排序后的眼点集绘制闭合多段线

1681008 发表于 2023-4-12 20:45:20

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





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

kkq0305 发表于 2023-4-13 10:46:50

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

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

Klein 发表于 2023-4-4 15:34:36

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

Noangler 发表于 2023-4-4 17:14:28

这些用在什么地方呀.

guosheyang 发表于 2023-4-4 18:18:34

感谢两位大佬的分享！

菜鸟初来乍到 发表于 2023-4-8 07:08:09

感谢楼主分享

chenbh2 发表于 2023-4-8 20:23:22

这个厉害了！

丶吟游诗人灬 发表于 2023-4-9 14:11:25

看起来很高级

nijiea123 发表于 2023-4-10 14:20:55

不错不错 看起来很不错

Carter丶Bo 发表于 2023-4-10 15:33:26

高级！！！！！

查看完整版本: 线段两端连线