[编程交流] 多段线截取

;; Polyline Self-Intersection  -  Lee Mac
;; Returns T if the supplied LWPolyline intersects itself
(defun LM:polyselfintersect-p ( ent / lst obj )
   (setq obj (vlax-ename->vla-object ent)
         lst (mapcar '(lambda ( x ) (trans x ent 0)) (LM:groupbynum (vlax-get obj 'coordinates) 2))
   )
   (vl-some '(lambda ( x ) (not (vl-some '(lambda ( y ) (equal x y 1e-) lst)))
       (LM:groupbynum (vlax-invoke obj 'intersectwith obj acextendnone) 3)
   )
)
;; Group by Number  -  Lee Mac
;; Groups a list into a list of lists, each of length 'n'
(defun LM:groupbynum ( l n / r )
   (if l
       (cons
           (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
           (LM:groupbynum l n)
       )
   )
)

(defun c:test ( / ent )
   (if (setq ent (car (entsel)))
       (LM:polyselfintersect-p ent)
   )
)

(mapcar
 '(lambda (x) (vlax-curve-getparamatpoint ent x))
  (LM:groupbynum (vlax-invoke obj 'intersectwith obj acextendnone) 3)
)

(defun c:test ( / ent lst obj sel )
   (if (setq sel (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
       (progn
           (setq ent (ssname sel 0)
                 obj (vlax-ename->vla-object ent)
                 lst (mapcar '(lambda ( x ) (trans x ent 0)) (LM:groupbynum (vlax-get obj 'coordinates) 2))
           )
           (foreach int (LM:groupbynum (vlax-invoke obj 'intersectwith obj acextendnone) 3)
               (if (not (vl-some '(lambda ( vtx ) (equal int vtx 1e-) lst))
                   (entmake (list '(0 . "POINT") (cons 10 int)))
               )
           )
       )
   )
   (princ)
)
;; Group by Number  -  Lee Mac
;; Groups a list into a list of lists, each of length 'n'
(defun LM:groupbynum ( l n / r )
   (if l
       (cons
           (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
           (LM:groupbynum l n)
       )
   )
)

5