Faster

[adaptacad]

I found this code on the internet, it works very well, but it is slow, is there a way to make it faster?

(defun rnd (/ modulus multiplier increment rand)
  (if (not seed)
    (setq seed (getvar "DATE"))
  )
  (setq modulus    65536
        multiplier 25173
        increment  13849
        seed  (rem (+ (* multiplier seed) increment) modulus)
        rand     (/ seed modulus)
  )
)

(defun GroupByNum ( lst n / r)
  (if lst
    (cons
      (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r))
      (GroupByNum lst n)
    )
  )
)

(defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
  (setq vec12 (mapcar '- pt2 pt1))
  (setq vec12 (reverse (cdr (reverse vec12))))
  (setq vec1p (mapcar '- pt pt1))
  (setq vec1p (reverse (cdr (reverse vec1p))))
  (setq vec2p (mapcar '- pt2 pt))
  (setq vec2p (reverse (cdr (reverse vec2p))))
  (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
  (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil))
  result
)

(defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
  (vl-load-com)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq ptt (vlax-curve-getclosestpointto ent pt))
  (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
  (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
  (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
  (setq k 0)
  (while (< (setq k (1+ k)) (length int))
    (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
  )
  (setq tst (reverse tst))
  (setq k 0)
  (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
  (vla-delete xlin)
  (if kk
    (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
    (setq result nil)
  )
  result
)

(load "extrim.lsp")
(defun c:MExTrim ( / ss n en ed enA minpt maxpt dx dy pt dxx dyy ) (vl-load-com)
  (prompt "\nSelect closed entities: ")
  (if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(70 . 11) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
    (progn
      (setq n (sslength ss))
      (while (>= (setq n (1- n)) 0)
        (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
          (vla-getboundingbox enA 'minpoint 'maxpoint)
        (setq
         minpt (vlax-safearray->list minpoint)
         maxpt (vlax-safearray->list maxpoint)
        )
        (setq dx (- (car maxpt) (car minpt)))
        (setq dy (- (cadr maxpt) (cadr minpt)))
        (setq pt '(0.0 0.0 0.0))
        (while (not (ptinsideent pt en))
          (setq dxx (* dx (rnd)))
          (setq dyy (* dy (rnd)))
          (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
        )
        (etrim en pt)
      )
    )
  )
  (princ)
)

[dlanorh]

Do you have "extrim.lsp"? It might speed it up a bit if it didn't have to load this and it was part of the file.

Some of it looks like "Lee Mac's" code, I'd ask at "CADTutor" or "The Swamp" re speeding it up.

[adaptacad]

@dlanorh
This LSP works differently than EXTRIM, so I can select multiple circles and it cuts out all the lines that are inside.
The problem is that it is very very slow, I wanted to correct this, but I believe that it is not possible,
Thank you very much for the feedback.

[dlanorh]

---

@adaptacad wrote:

I found this code on the internet, it works very well, but it is slow, is there a way to make it faster?

(defun rnd (/ modulus multiplier increment rand)
  (if (not seed)
    (setq seed (getvar "DATE"))
  )
  (setq modulus    65536
        multiplier 25173
        increment  13849
        seed  (rem (+ (* multiplier seed) increment) modulus)
        rand     (/ seed modulus)
  )
)

(defun GroupByNum ( lst n / r)
  (if lst
    (cons
      (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r))
      (GroupByNum lst n)
    )
  )
)

(defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
  (setq vec12 (mapcar '- pt2 pt1))
  (setq vec12 (reverse (cdr (reverse vec12))))
  (setq vec1p (mapcar '- pt pt1))
  (setq vec1p (reverse (cdr (reverse vec1p))))
  (setq vec2p (mapcar '- pt2 pt))
  (setq vec2p (reverse (cdr (reverse vec2p))))
  (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
  (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil))
  result
)

(defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
  (vl-load-com)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq ptt (vlax-curve-getclosestpointto ent pt))
  (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
  (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
  (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
  (setq k 0)
  (while (< (setq k (1+ k)) (length int))
    (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
  )
  (setq tst (reverse tst))
  (setq k 0)
  (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
  (vla-delete xlin)
  (if kk
    (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
    (setq result nil)
  )
  result
)

(load "extrim.lsp")
(defun c:MExTrim ( / ss n en ed enA minpt maxpt dx dy pt dxx dyy ) (vl-load-com)
  (prompt "\nSelect closed entities: ")
  (if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(70 . 11) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
    (progn
      (setq n (sslength ss))
      (while (>= (setq n (1- n)) 0)
        (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
          (vla-getboundingbox enA 'minpoint 'maxpoint)
        (setq
         minpt (vlax-safearray->list minpoint)
         maxpt (vlax-safearray->list maxpoint)
        )
        (setq dx (- (car maxpt) (car minpt)))
        (setq dy (- (cadr maxpt) (cadr minpt)))
        (setq pt '(0.0 0.0 0.0))
        (while (not (ptinsideent pt en))
          (setq dxx (* dx (rnd)))
          (setq dyy (* dy (rnd)))
          (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
        )
        (etrim en pt)
      )
    )
  )
  (princ)
)

---

Your Lisp is loading extrim and using a function from it (see red items above). It would be faster if it didn't do this and it was part of the same file

[adaptacad]

@dlanorh
I'm beginning to understand, but I'm bad at coding, in practice how would it be done?

[roland.r71]

...by opening the extrim.lsp with notepad.

Select the entire etrim function

(defun etrim ()
   ; >existing code for function<
)

Switch to your own lisp & paste it somewhere between your own.

While you're at it, delete ALL (vl-load-com) statements, and insert 1 at the very top of the file.

(vl-load-com) only has to load 1x. NEVER use it within a function. Especially a function which is called several times! (Which will at least save some time for the system to check and see it is already loaded ...)

& combining your (setq vars...) into 1 setq helps a tiny bit too.

Example:

  (setq vec12 (mapcar '- pt2 pt1))
  (setq vec12 (reverse (cdr (reverse vec12))))
  (setq vec1p (mapcar '- pt pt1))
  (setq vec1p (reverse (cdr (reverse vec1p))))

...etc...

Can also be written as:

(setq vec12 (reverse (cdr (reverse (mapcar '- pt2 pt1))))

           vec1p (reverse (cdr (reverse (mapcar '- pt2 pt1))))

 ...etc...

)

Which is a (undetectable) bit faster. Especially with repeating code, it can help speed things up.

Compiling the code will surely get you the best speed improvement.

[adaptacad]

Thanks @roland.r71 @dlanorhI will try here, any questions I ask one more time.

[john.uhden]

My @group function is about 20% faster than your Groupbynum function, but I just think you are doing a lot of calculations.  The subject of a point inside has been debated here for decades, and I don't think anyone as yet has come up with a 99% solution.  It was thought that if there were an odd number of intersections of a ray with a closed figure that that would indicate the point was inside.  But there's the possibility that the ray might intersect at a point of tangency or at one vertex, which means nothing.  I was close to solving the challenge by adopting the theory that the sum of the deflection angles from the PIQ to around the figure must equal (* 2 pi).  But that theory is hampered by bulged polyline segments.  I intend to solve it before I die.

   ;; Function to group a list of items into a list of
   ;; multiple lists, each of length N, e.g.
   ;; '(A B C D E F G H I) -> '((A B C)(D E F)(G H I))
   (defun @group (lst n / item new)
     (foreach element (reverse lst)
       (setq item (cons element item))
       (if (= (length item) n)
         (setq new (cons item new) item nil)
       )
     )
     new
   )