Author Topic: Trim routine  (Read 5568 times)

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Trim routine
« Reply #15 on: May 26, 2010, 05:42:42 PM »
Please help me...
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

ozimad

  • 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?  :lol:

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: 12906
  • London, England
Re: Trim routine
« Reply #17 on: May 27, 2010, 08:03:45 AM »

ozimad

  • Guest
Re: Trim routine
« Reply #18 on: May 27, 2010, 10:47:31 AM »
thanks lee!