fantastic i am one step to the result:
Why do I get a million of points, finding all the intersection points?
(defun c:chop (/ f lyr pt pts ss x)
(vl-load-com)
(setq ss0 (ssget '((0 . "lwpolyline,circle"))))
(setq ss (ssget '((0 . "lwpolyline,circle"))))
(repeat (setq i1 (sslength ss0))
(if (setq f (vlax-ename->vla-object
(setq obj1 (ssname ss0 (setq i1 (1- i1))))
)
)
(progn
;;get intersections div 2
(setq
x
(apply
'append
(vl-remove-if-not
'(lambda (l) (zerop (rem (length l) 2)))
(mapcar
'(lambda (x)
(vlax-invoke f 'intersectwith x acextendnone)
)
(vl-remove-if
'(lambda (e) (equal e f))
(mapcar
'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
)
)
)
)
;;convert to 3d points
(while (caddr x)
(setq pts (cons (list (car x) (cadr x) (caddr x)) pts)
x (cdddr x)
)
)
(setq x pts)
(setq pts "1")
;;sort the points
(while (not (= x nil))
(setq pmin (car x))
(repeat (setq i (VL-LIST-LENGTH x))
(if (> (vlax-curve-getdistatpoint f pmin)
(vlax-curve-getdistatpoint
f
(setq current (nth (setq i (1- i)) x))
)
)
(setq pmin current)
;;yes
(princ)
;;no
)
)
(setq x (vl-remove pmin x))
(if (= pts "1")
(setq pts (list pmin))
(setq pts (append pts (list pmin)))
)
)
;;;;;;;;;;;;;;all points
;;get intersections
(setq x
(apply
'append
(mapcar
'(lambda (x)
(vlax-invoke f 'intersectwith x acextendnone)
)
(vl-remove-if
'(lambda (e) (equal e f))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
)
)
)
;;convert to 3d points
(while (caddr x)
(setq pts1 (cons (list (car x) (cadr x) (caddr x)) pts1)
x (cdddr x)
)
)
(setq x pts1)
;;;sort point find min
(setq pmin (caar x))
(print x)
(repeat (setq i (VL-LIST-LENGTH x))
(if (> (vlax-curve-getdistatpoint f pmin)
(vlax-curve-getdistatpoint
f
(setq current (nth (setq i (1- i)) x))
)
)
(setq pmin current)
;;yes
(princ)
;;no
)
)
(print pmin)
;;;;;;situation
(if (= pmin (car pts))
(if (= pmin (vlax-curve-getstartpoint f))
;;no
;;1 p first
(progn
(setq pts (cdr pts))
)
;;yes2
(append (list (vlax-curve-getstartpoint f)) pts)
;;no2
)
(progn
(append (list pmin) pts)
)
)
;;add lines
(while (setq pt (car pts))
(setq pt2 (cadr pts))
(command "_.break" (list obj1 pt) pt2)
(setq obj1 (entlast))
(setq pts (cddr pts))
)
)
)
(princ)
)
)
[code]
[/code]