### Author Topic: Trim routine  (Read 4835 times)

0 Members and 1 Guest are viewing this topic.

#### ronjonp

• Needs a day job
• Posts: 7478
##### Re: Trim routine
« Reply #15 on: May 26, 2010, 05:42:42 PM »
how can i add something like that?
(if (= 0 (rem (vl-list-length (vlax-invoke f 'intersectwith x acextendnone)) 2)))

Give this a whirl

Code: [Select]
`(defun c:chopchop (/ f lyr pt pts ss x)  (if (and (setq f (car (entsel "\nSelect fence: ")))    (setq f (vlax-ename->vla-object f))    (setq lyr (vla-get-layer f))    (setq ss (ssget '((0 . "lwpolyline,circle"))))      )    (progn ;;get intersections    (setq      x (apply 'append (vl-remove-if-not    '(lambda (l) (zerop (rem (length l) 2)))    (mapcar '(lambda (x) (vlax-invoke f 'intersectwith x acextendthisentity))    (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)      )    )    ;;sort the points    (setq pts (vl-sort pts (function (lambda (a b) (< (apply '+ a) (apply '+ b))))))    ;;add lines    (while (setq pt (cadr pts))      (entmakex (list '(0 . "LINE") (cons 8 lyr) (cons 10 (car pts)) (cons 11 pt)))      (setq pts (cddr pts))    )    ;;remove fence    (vla-delete f)    )  )  (princ))`

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

• Guest
##### Re: Trim routine
« Reply #16 on: May 27, 2010, 06:18:19 AM »
fantastic i am one step to the result:
Why do I get a million of points, finding all the intersection points?

Code: [Select]
`(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]
« Last Edit: May 27, 2010, 10:47:14 AM by ozimad »

#### Lee Mac

• Seagull
• Posts: 12764
• London, England
##### Re: Trim routine
« Reply #17 on: May 27, 2010, 08:03:45 AM »