我经常要做这样的事

357785513

各位高手,我经常要做这样的事,就是把四根线用一根多段线
连起来有没有什么办法框选四根线就，一根多段线把他们连起来了

357785513

这是画找坡线，经常要画这些东东

xyp1964

357785513

院长可以呀，对了24942984我怎么加不进去呀，

357785513

无院院长核心代码

aihuyujian

框选四条直线 并获取框选时的角点左边 然后获取直线顶点坐标 筛选在框选范围内的顶点坐标 用这些顶点坐标生成pl线  感觉就是这样

424069638

支持一下，，，，，，

香田里浪人

可以根据下面程序请楼主再修改一下
;;;------------------------TSP------------------------------------------------------------;;;
;;;---------------------------------------------------------------------------------------;;;
(defun c:ylx (/ foo f2 ptl lst l n i d0 l0 l1 d1)  
  (defun foo (l / D D0 D1)
    (setq l0 (mapcar (function list) (cons (last l) l) l)) ;_  setq
;_  defun
    (setq d0 (get-closedpolygon-length l))
    (while
      (> d0
         (progn
           (foreach a l0
             (setq d (get-closedpolygon-length l))
             (setq l1 (vl-remove (car a) (vl-remove (cadr a) l)))
             (setq l1 (f1 (car a) l1))
             (setq l1 (f1 (cadr a) l1))
             (if (> d
                    (setq d1 (get-closedpolygon-length l1))
                 )
               (setq d d1
                     l l1
               ) ;_  setq
             ) ;_  if
             (setq l1 (vl-remove (car a) (vl-remove (cadr a) l)))
             (setq l1 (f1 (cadr a) l1))
             (setq l1 (f1 (car a) l1))
             (if (> d
                    (setq d1 (get-closedpolygon-length l1))
                 )
               (setq d d1
                     l l1
               )
             )
           )
           d
         ) ;_  progn
      ) ;_  <
       (setq d0 d)
    ) ;_  while   
    (setq d (get-closedpolygon-length l))   
    l
  )
  (defun f1 (a l)
    (ins-lst a (get-closest-i l a) l)
  )
  (defun f2 (lst)
    (mapcar (function (lambda (p0 p p1 / a)
                        (setq a (- (angle p p0) (angle p p1)))
                        (if (< a (- pi))
                          (abs (+ a pi pi))
                          (if (> a pi)
                            (abs (- a pi pi))
                            (abs a)
                          )
                        )
                      )
            )
            (cons (last lst) lst)
            lst
            (reverse (cons (car lst) (reverse (cdr lst))))
    )
  )
  (setq        ptl (my-getpt)
        ptl (mapcar (function (lambda (p) (list (car p) (cadr p)))) ptl)
  )
  (setq t1 (getvar "MilliSecs"))
  (setq lst (Graham-scan ptl))
  (foreach a lst
    (setq ptl (vl-remove a ptl))
  )
  (while (and (> (length ptl) 2) (setq l (Graham-scan ptl)))
    (foreach p l
      (setq ptl (vl-remove p ptl))
      (setq n (get-minadddist-i lst p))
      (setq lst (ins-lst p n lst))
    )
  )
  (if ptl
    (foreach p ptl
      (setq n (get-minadddist-i lst p))
      (setq lst (ins-lst p n lst))
    )
  )
  (setq lst (foo lst))
  (setq l (f2 lst))
  (setq        i  0
        l0 lst
        n  (length lst)
        d0 (get-closedpolygon-length lst)
  )
  (foreach a l
    (if        (and (< a _pi3) (= (setq p (nth i lst)) (nth i l0)))
      (progn
        (if (= i 0)
          (setq p0 (last lst))
          (setq p0 (nth (1- i) lst))
        )
        (if (= i (1- n))
          (setq p1 (car lst))
          (setq p1 (nth (1+ i) lst))
        )
        (setq m        (list (list p0 p1 p)
                      (list p1 p p0)
                      (list p1 p0 p)
                      (list p p0 p1)
                      (list p p1 p0)
                )
        )
        (setq l1
               (car (vl-sort (mapcar (function (lambda (x)
                                                 (ch-para-lst x i lst)
                                               )
                                     )
                                     m
                             )
                             (function (lambda (e1 e2)
                                         (< (get-closedpolygon-length e1)
                                            (get-closedpolygon-length e2)
                                         )
                                       )
                             )
                    )
               )
        )
        (setq d1 (get-closedpolygon-length l1))
        (if (< d1 d0)
          (setq        d0  d1
                lst l1
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (setq l (f2 lst))
  (setq        i  0
        l0 lst
        d0 (get-closedpolygon-length lst)
  )
  (foreach a l
    (if        (and (< a _pi2) (setq p (nth i l0)))
      (progn
        (setq l1 (f1 p (vl-remove p lst)))
        (setq d1 (get-closedpolygon-length l1))
        (if (< d1 d0)
          (setq        d0  d1
                lst l1
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (entmake
    (append (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(8 . "temp")
                  '(62 . 1)
                  '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                  '(70 . 1)
            )
            (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
  (setq t2 (getvar "MilliSecs"))
  (princ (strcat "\nTSP Length :" (rtos d0 2 0) "."))
  (princ (strcat "\nUse Time :" (rtos (- t2 t1) 2 0) "ms."))
  (princ)
)
;;;Use Funtions
;;;--------------------------------------------------------------
;; Convex hull of pts , Graham scan method
;; by Highflybird
  (defun Graham-scan (ptl / hPs rPs PsY Pt0 sPs P Q)
    (if        (< (length ptl) 4)                ;3点以下
      ptl                                ;是本集合
      (progn
        (setq rPs (mapcar (function (lambda (x)
                                      (if (= (length x) 3)
                                        (cdr x)        x)))
                          (mapcar 'reverse ptl));_点表的X和Y交换
              PsY (mapcar 'cadr ptl) ;_点表的Y值的表
              Pt0 (reverse (assoc (apply 'min PsY) rPs)) ;_最下面的点      
              sPs (sort-ad ptl Pt0) ;_按角度距离排序点集
              hPs (list (caddr sPs) (cadr sPs) Pt0) ;_开始的三点
        )
        (foreach n (cdddr sPs)                ;从第4点开始
          (setq        hPs (cons n hPs)        ;把Pi加入到凸集
                P   (cadr hPs)                ;Pi-1
                Q   (caddr hPs)                ;Pi-2
          )
          (while (and q (> (det n P Q) -1e-6)) ;如果左转
            (setq hPs (cons n (cddr hPs)) ;删除Pi-1点
                  P   (cadr hPs)        ;得到新的Pi-1点
                  Q   (caddr hPs)        ;得到新的Pi-2点
            )))
        hPs                                ;返回凸集
      ))
  )
;;;以最下面的点为基点，按照角度和距离分类点集
(defun sort-ad (pl pt)
  (vl-sort pl
           (function (lambda (e1 e2 / an1 an2)
               (setq an1 (angle pt e1)
                     an2 (angle pt e2))
               (if (equal an1 an2 1e-6);_这里降低误差，以适应工程需求
                 (< (distance pt e1) (distance pt e2))
                 (< an1 an2)
               ))))
)
;;定义三点的行列式,即三点之倍面积
(defun det (p1 p2 p3)
  (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
     (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
  ))
;;;
;;;------------------------
(defun my-getpt        (/ ss i en l)
  (setq ss (ssget '((0 . "*line,LWPOLYLINE"))));;选择点
  (setq i -1)
  (while (setq en (ssname ss (setq i (1+ i))))
    (setq l (cons (cdr (assoc 10 (entget en))) l))
  )
)
;;;------------------------
;;;
;;(ins-lst 10 5 '(1 2 3 4 5))
;; i 为新插入元素的位置
(defun ins-lst (new i lst / len fst)
  (cond
    ((minusp i)
     lst
    )
    ((> i (setq len (length lst)))
     lst
    )
    ((> i (/ len 2))
     (reverse (ins-lst new (- len i) (reverse lst)))
    )
    (t
     (append
       (progn
         (setq fst nil)
         (repeat (rem i 4)
           (setq fst (cons (car lst) fst)
                 lst (cdr lst)
           )
         )
         (repeat (/ i 4)
           (setq fst (cons (cadddr lst)
                           (cons (caddr lst)
                                 (cons
                                   (cadr lst)
                                   (cons
                                     (car lst)
                                     fst
                                   )
                                 )
                           )
                     )
                 lst (cddddr lst)
           )
         )
         (reverse fst)
       )
       (list new)
       lst
     )
    )
  )
)
;;;------------------------
;;
;;(ch-para-lst '(7 8 9) 3 '(1 2 3 4 5))
(defun ch-para-lst (para i lst / len fst)
  (setq len (length lst))
  (cond
    ((minusp i)
     lst
    )
    ((> i (1- len))
     lst
    )
    ((= i 0)
     (cons (cadr para)
           (cons (caddr para)
                 (reverse (cons (car para) (cdr (reverse (cddr lst)))))
           )
     )
    )
    ((= i (1- len))
     (reverse
       (append (cdr (reverse para))
               (cddr (reverse (cons (last para) (cdr lst))))
       )
     )
    )
    ((> i (/ len 2))
     (reverse
       (ch-para-lst (reverse para) (- len i 1) (reverse lst))
     )
    )
    (t
     (append
       (progn
         (setq fst nil)
         (repeat (rem i 4)
           (setq fst (cons (car lst) fst)
                 lst (cdr lst)
           )
         )
         (repeat (/ i 4)
           (setq fst (cons (cadddr lst)
                           (cons (caddr lst)
                                 (cons
                                   (cadr lst)
                                   (cons
                                     (car lst)
                                     fst
                                   )
                                 )
                           )
                     )
                 lst (cddddr lst)
           )
         )
         (reverse
           (cons (caddr para)
                 (cons (cadr para) (cons (car para) (cdr fst)))
           )
         )
       )
       (cdr lst)
     )
    )
  )
)
;;;------------------------
;;
(defun get-minadddist-i        (lst p)
  (car
    (vl-sort-i
      (mapcar (function        (lambda        (p1 p2)
                          (- (+ (distance p p1) (distance p p2))
                             (distance p1 p2)
                          )
                        )
              )
              (cons (last lst) lst)
              lst
      )
      '<
    )
  )
)
;;;------------------------
(defun get-closest-i (lst p)
  (car
    (vl-sort-i
      (mapcar
        (function
          (lambda (p1 p2 / pt d d1 d2)
            (setq pt (inters p
                             (polar p (+ (/ pi 2.) (angle p1 p2)) 1.)
                             p1
                             p2
                             nil
                     )
                  d  (distance p1 p2)
                  d1 (distance p p1)
                  d2 (distance p p2)
            )
            (if        pt
              (if (equal (+ (distance pt p1) (distance pt p2)) d 1e-8)
                (distance p pt)
                d2
              )
              1e99
            )
          )
        )
        (cons (last lst) lst)
        lst
      )
      '<
    )
  )
)
;;;------------------------
;;
(defun get-closedpolygon-length        (l)
  (apply (function +)
         (mapcar (function (lambda (p1 p2)
                             (distance p1 p2)
                           )
                 )
                 (cons (last l) l)
                 l
         )
  )
)

357785513

八楼的高手，为什么 有的会是反的呀，难道是起点的原因

香田里浪人

357785513 发表于 2016-1-18 21:14
八楼的高手，为什么 有的会是反的呀，难道是起点的原因

我不是什么高手，程序是偷来的，是的，该程序是与画线起点有关，仅考虑起点，未考虑其他（如终点）。