fuccaro Posted May 30, 2023 Posted May 30, 2023 Try this: (defun c:pp(/); l1 l2 l3 p1 p2 p3 p4 p area h h1 ang) (setq l1 3.0 l2 2.0 l3 4) (setq p1 (list 0 0) p2 (list 0 l1)) (setq p (* (+ l1 l2 l3) 0.5)) (setq area (sqrt (* p (- p l1) (- p l2) (- p l3)))) (setq h (/ area l1 0.5)) (setq h1 (sqrt (- (* l2 l2) (* h h)))) (setq ang (atan h h1)) (setq ang (if (> (* l3 l3) (+ (* l1 l1) (* h h))) (- PI ang) ang)) (setq p3 (polar p1 (+ ang (angle p1 p2)) l2)) (setq p4 (polar p1 (- (angle p1 p2) ang) l2)) (command "line" p1 p2 p3 p1 p4 p2 "") ) 1 Quote
vanowm Posted May 30, 2023 Author Posted May 30, 2023 (edited) @fuccaro Thank you very much it's working perfectly now. My old code would process 2000 triangles and draw outline in 35 seconds in wireframe view and 1m10s in shaded, with this algorithm it takes 3 seconds regardless of the view type. Huge improvement! Edited May 30, 2023 by vanowm Quote
fuccaro Posted May 31, 2023 Posted May 31, 2023 Wow! that's more than 10 times faster! Even if I wrote that Lisp in a rush, I felt good lisping. Enjoy! Quote
fuccaro Posted June 22, 2023 Posted June 22, 2023 After reading again the program, I can see that it can be improved for speed. Not big deal, but the variable “h” is raised at square twice, in two different program lines. You could place the result of (* h h) in a variable when it first occurs, and use that value instead of calculating it again. With this change it will process those 2000 triangles in 2.99999999 secs instead of 3! 1 Quote
Steven P Posted June 22, 2023 Posted June 22, 2023 5 hours ago, fuccaro said: With this change it will process those 2000 triangles in 2.99999999 secs instead of 3! Just need to do that 4,000,000 times in a day and that's me gaining enough time for a nice cup of tea!! (however also to make future updates easier I find doing a calculation once, as a variable, means I only have to update it once) Quote
Lee Mac Posted June 22, 2023 Posted June 22, 2023 (edited) Here's another possible method - (defun tri-ppll ( p1 p2 l1 l2 / a b p x ) (if (< 0 (setq a (distance p1 p2))) (setq b (* l1 l1) x (/ (+ (- (* a a) (* l2 l2)) b) (+ a a)) p (mapcar '+ p1 (trans (list (sqrt (- b (* x x))) 0.0 x) (mapcar '- p2 p1) 0)) ) ) ) To test: (defun c:test ( / a b p q x ) (if (and (setq p (getpoint "\nSpecify 1st point: ")) (setq q (getpoint "\nSpecify 2nd point: ")) (setq a (getdist p "\nSpecify 1st side length: ")) (setq b (getdist q "\nSpecify 2nd side length: ")) ) (if (setq x (tri-ppll p q a b)) (mapcar 'l (list p q x) (list q x p)) (princ "\nThe two points must be distinct!") ) ) (princ) ) (defun l ( a b ) (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 b)))) Edited June 22, 2023 by Lee Mac Quote
BIGAL Posted June 22, 2023 Posted June 22, 2023 (edited) Would a defun for entmake pline '(p1 p2 p3 p1 p4 p2) then explode maybe take 2.9 seconds ? Edited June 22, 2023 by BIGAL 1 Quote
Lee Mac Posted June 23, 2023 Posted June 23, 2023 13 hours ago, BIGAL said: Would a defun for entmake pline '(p1 p2 p3 p1 p4 p2) then explode maybe take 2.9 seconds ? I don't understand your point? The purpose of the function is to calculate the points... Quote
Steven P Posted June 23, 2023 Posted June 23, 2023 56 minutes ago, Lee Mac said: I don't understand your point? The purpose of the function is to calculate the points... Think he was refereing to Fuccaros comment on saving 0.00001 by a second with a slight change in the code - rather than the code itself Quote
BIGAL Posted June 23, 2023 Posted June 23, 2023 (edited) I was just having a laugh shaving micro seconds may be all you gain some times for an hours work. Yes have code huge task took 45 minutes 1st go using command, 3rd version is now 2 minutes. Using entmakes and VL. Versus manual edit was around 4 hours so client is very happy. Edited June 23, 2023 by BIGAL 1 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.