Leaderboard

Does anybody want to play? Years ago someone asked me in the forum for a Lisp program that wakes up in the morning, drives to work and does the job at full capacity 8 hours long… If reading the title of this thread you had something similar in your mind… then sorry but I will disappoint you. I plan to make a toy, and as part of planning ahead my actions, I wrote these Lisp programs, to optimize the design. So, the first program first: (defun c:DrawIt( / R0 R1 R2 PozAng1 PozAng2 Ang0 Ang1 Ang2 L1 L2 AngularStep Color Steps Angles Points Lines) (setq R0 150.0) (setq R1 100.0) (setq R2 50.0) (setq PozAng1 (/ PI -3)) (setq PozAng2 0) (setq Ang0 0) (setq Ang1 (/ PI 6)) (setq Ang2 0) (setq L1 250.0) (setq L2 280.0) (setq AngularStep (/ PI 200)) ;Quality/speed (setq color (list 7 40 43)) (setq steps (list (- AngularStep) (/ (* AngularStep R0) R1) (/ (* AngularStep R0) R2))) (setq angles (list Ang0 Ang1 Ang2)) (setq P0 (list 0 0 0) P1 (polar P0 PozAng1 (+ R0 R1)) P2 (polar P0 PozAng2 (+ R0 R2))) (setq lines (mapcar 'Draw (list P0 P1 P2) (list R0 R1 R2) angles color)) (setq Point (solve (setq Pa1 (polar P1 Ang1 R1)) (setq Pa2 (polar P2 Ang2 R2)) L1 L2 P0)) (entmake (list (cons 0 "POINT") (cons 10 Point) (cons 62 3)(cons 8 "Results"))) (setq Path (list (entlast))) (entmake (list (cons 0 "LINE") (cons 10 Pa1) (cons 11 Point) (cons 62 (Cadr color)))) (setq lines (reverse (cons (entlast) (reverse lines)))) (entmake (list (cons 0 "LINE") (cons 10 Pa2) (cons 11 Point) (cons 62 (Caddr color)))) (setq lines (reverse (cons (entlast) (reverse lines)))) (command "ZOOM" "E") (princ "Press and hold the ENTER key to run. ESC to exit") (while T (while (not (getstring))) (setq Angles (mapcar '+ Angles steps)) (setq Point (solve (setq Pa1 (polar P1 (cadr angles) R1)) (setq Pa2 (polar P2 (caddr angles) R2)) L1 L2 P0)) (mapcar 'Change lines (list P0 P1 P2 Pa1 Pa2) (append (mapcar 'polar (list p0 p1 p2) angles (list R0 R1 R2)) (list Point) (list Point))) (entmake (list (cons 0 "POINT") (cons 10 Point) (cons 62 3)(cons 8 "Results"))) (foreach P Path (RotatePoint p)) (setq Path (reverse (cons (entlast) (reverse Path)))) ) ) (defun Draw(Poz Rad Ang color) (entmake (list (cons 0 "CIRCLE") (cons 10 Poz) (cons 40 Rad) (cons 62 color))) (entmake (list (cons 0 "LINE") (cons 10 Poz) (cons 11 (polar Poz Ang Rad)) (cons 62 color))) (entlast) ) (defun solve(p1 p2 l1 l2 p) (repeat 10 (setq p (polar p1 (angle p1 p) l1)) (setq p (polar p2 (angle p2 p) l2)) ) ) (defun Change(e p10 p11 / el) (setq el (entget e) el (subst (cons 10 p10) (assoc 10 el) (subst (cons 11 p11) (assoc 11 el) el))) (entmod el) ) (defun RotatePoint(e / el a10 b10) (setq el (entget e) a10 (assoc 10 el) b10 (polar P0 (+ (car steps)(angle P0 (cdr a10))) (distance P0 (cdr a10))) el (subst (cons 10 b10) a10 el)) (entmod el) ) And here are some screen captures about the results: Finally, a drawing to help you dimension the elements: A final word: if the two lines L1 and L2 are too short, the program will extend them, to avoid runtime errors, but sometimes the drawing goes nuts. The second program is similar. I insert here some screen captures too. Have fun! (defun c:DrawMe( / R0 R1 E1 FixX FixY B1 B2 steps ang0 Dang0 Dang1 cen0 cen1) (setq R0 300 R1 150 e1 190 FixX 180 FixY 180 B1 330 B2 120) (setq steps 300) ; (setq ang0 (/ PI 2) ang1 (/ PI 2)) (setq Dang1 (/ PI 0.5 steps) Dang0 (/ (* Dang1 R1) R0)) (setq cen0 (list 0 0 0) cen1 (list 0 (+ R0 R1) 0)) (setq Pfix (list FixX FixY 0) PMob (polar cen1 ang1 e1)) (setq path nil) (setq color (cons 62 41) color1 (cons 62 3)) (setq Lmax (+ e1 (distance PFix cen1) 5)) (mapcar '(lambda(cen rad) (entmake (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad)))) (list cen0 cen1 PFix cen1) (list R0 R1 3 3)) (entmake (list (cons 0 "LINE") (cons 10 PMob) (cons 11 (polar PMob (angle PMob Pfix) Lmax)) color)) (setq Line1 (entlast)) (setq Pa (polar PMob (setq AngAux(angle Pmob PFix)) B1)) (setq Pb (polar Pa (- AngAux (/ PI 2)) B2)) (entmake (list (cons 0 "LINE") (cons 10 Pa) (cons 11 Pb) color)) (setq Line2 (entlast)) (entmake (list (cons 0 "LINE") (cons 10 cen1) (cons 11 PMob))) (setq crank (entlast)) (entmake (list (cons 0 "LINE") (cons 10 cen0) (cons 11 (polar cen0 ang0 (* 0.5 r0))))) (setq ray (entlast)) (entmake (list (cons 0 "POINT") (cons 10 Pb) (cons 8 "Result") color1)) (setq path (cons (entlast) path)) ; (while T (while (not (getstring "Hold ENT for run; Press ESC to stop"))) (setq ang0 (+ ang0 Dang0) ang1 (- ang1 Dang1)) (setq PMob (polar cen1 ang1 e1)) (setq Pa (polar PMob (setq AngAux(angle Pmob PFix)) B1)) (setq Pb (polar Pa (- AngAux (/ PI 2)) B2)) (foreach point path (setq el (entget point) el (subst (cons 10 (polar cen0 (+ Dang0 (angle cen0 (cdr (assoc 10 el)))) (distance cen0 (cdr (assoc 10 el))))) (assoc 10 el) el)) (entmod el) ) (entmake (list (cons 0 "POINT") (cons 10 Pb) (cons 8 "Result") color1)) (setq path (cons (entlast) path)) (mapcar '(lambda(e v va / el) (setq el (entget e) el (subst (cons v va) (assoc v el) el)) (entmod el)) (list Line1 Line1 Line2 Line2 crank ray) (list 10 11 10 11 11 11) (list PMob (polar PMob (angle PMob Pfix) Lmax) Pa Pb PMob (polar cen0 ang0 (* 0.5 r0))) ) ) ) P.S. To start the first program, type DRAWIT. The second one starts with the DRAWME command.

Perhaps the easiest way to create the dimension would be something like: (defun c:test ( / ln p1 p2 ) (if (setq p1 (getpoint "\nPunto inicial: ")) (progn (setq p2 (mapcar '+ p1 '(0.5 0 0)) ln (entmakex (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)) '(62 . 2))) ) (command "_.dimlinear" "" (list ln p1) "_non" (mapcar '+ p1 '(0 -0.5 0))) ) ) (princ) ) This approach also has the advantage of creating an associative dimension. The appearance and measurement formatting should be controlled by your Dimension Style.

To parse numbers as strings: ; (KGA_String_TokenizeAlt "lili/=0.50@@0.573#0.53" "0123456789.") (defun KGA_String_TokenizeAlt (str keepSet / ret sub) (setq keepSet (vl-string->list keepSet)) (setq str (vl-string->list str)) (repeat (1+ (length str)) (cond ((vl-position (car str) keepSet) (setq sub (cons (car str) sub)) ) (sub (setq ret (cons (vl-list->string (reverse sub)) ret)) (setq sub nil) ) ) (setq str (cdr str)) ) (reverse ret) )

You may want to consider the 'splitstring' function used by my Incremental Array program: (defun incarray:splitstring ( str / lst ) (setq lst (vl-string->list str)) (read (vl-list->string (vl-list* 40 34 (incarray:split lst (< 47 (car lst) 58))))) ) (defun incarray:split ( lst flg ) (cond ( (null lst) '(34 41)) ( (member (car lst) '(34 92)) (if flg (vl-list* 34 32 34 92 (car lst) (incarray:split (cdr lst) nil)) (vl-list* 92 (car lst) (incarray:split (cdr lst) flg)) ) ) ( (or (< 47 (car lst) 58) (and (= 46 (car lst)) flg (< 47 (cadr lst) 58))) (if flg (vl-list* (car lst) (incarray:split (cdr lst) flg)) (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) t)) ) ) ( flg (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) nil))) ( (vl-list* (car lst) (incarray:split (cdr lst) nil))) ) ) Example: _$ (incarray:splitstring "lili/=0.50@@0.573#0.53") ("lili/=" "0.50" "@@" "0.573" "#" "0.53")

Something like this perhaps: (defun ParseIt (str) (read (vl-list->string (append '(40) ; "(". (mapcar '(lambda (int) (if (or (= 46 int) (<= 48 int 57)) int 32)) (vl-string->list str) ) '(41) ; ")". ) ) ) )

Roy_043 It is absolutely essential to handle the OSMODE setting when using command calls. It is not. Depends on the situation as I say I have been programming for over 40 years and know when I need to use osmode. Know about a few other Gotcha that Autocad does to code as well.

Thanks Irm, Here's my code, where I used the Newton Raphson method, execution time for 10000 points = 0.0 seconds and for bisection method time = 10 seconds. I use curves C(x(t), y(t), z(t)), where x(t) is strictly increasing function. Also, thanks marko-ribar, where I replaced (setq curveObj (vlax-ename-> vla-object ent)) with (setq curveObj ent). In conclusion, the code is very fast. ; return time in seconds (defun timer ( / s ) (setq s (getvar "DATE")) (* 86400.0 (- s (fix s))) ) (defun c:fx ( / c c0 curve-obj delim dx eps fil name_file nz p param_e param_s pe ps p_deriv t1 u x0 x1 x2 xf xff xi ) ; ; Input ;---------------------------------------------------------------------------------------------------------- (setq eps 0.000001 delim " " nz 6 ; number of decimals ) (if (null *r*) (setq *r* 1.0) ) (initget 6) (if (setq dx (getreal (strcat "\nIncrement dx < " (rtos *r*) " >: "))) (setq *r* (* 1.0 dx)) (setq dx (* 1.0 *r*)) ) (setq name_file (getstring "\nFile out : ") curve-Obj (car (entsel)) fil (open (strcat (getvar "DWGPREFIX") name_file) "w") param_s (vlax-curve-getStartParam curve-Obj) param_e (vlax-curve-getEndParam curve-Obj) ps (vlax-curve-getStartPoint curve-Obj) pe (vlax-curve-getEndPoint curve-Obj) x1 (car ps) x2 (car pe) ) (setq xi (getstring "\nEnter(for ends of curve) or val. xi = ")) (if (= xi "") (if (< x1 x2) (setq xi x1 xf x2) (setq xi x2 xf x1) ) (setq xi (atof xi) xf (atof (getstring "\nxf = "))) ) ; End input ;---------------------------------------------------------------------------------------------------------- (setq t1 (timer)) (setq x0 xi xff (+ xf eps)) (setq c0 (* 0.5 (+ param_s param_e)) c c0 u 10000.0 ) (while (< x0 xff) ; Newton Raphson Method ;----------------------------------------------------- (while (> (abs u) eps) (setq p (vlax-curve-getPointAtParam curve-Obj c) p_deriv (vlax-curve-getFirstDeriv curve-obj c) u (/ (- (car p) x0) (car p_deriv)) c (- c u) ) ) ;----------------------------------------------------- (write-line (strcat (rtos x0 2 nz) delim (rtos (cadr p) 2 nz) delim (rtos (caddr p) 2 nz)) fil) (setq x0 (+ x0 dx) c c0 u 10000.0) ) (close fil) (princ "\n") (princ (- (timer) t1)) (princ "\nOK") (princ) )

If the solids are made using extrude command, with a height, not path, then you can extract the height like this: (defun c:test ( / e solid) (while (and (setq e (car (entsel))) (setq e (cdr (assoc 350 (entget e)))) (eq (cdr (assoc 0 (setq e (entget e)))) "ACSH_HISTORY_CLASS") (setq e (cdr (assoc 360 e))) (eq (cdr (assoc 0 (setq e (entget e)))) "ACAD_EVALUATION_GRAPH") (setq e (cdr (assoc 360 e))) (setq e (entget e)) (setq solid (cdr (assoc 0 e))) ) (cond ((eq solid "ACSH_EXTRUSION_CLASS") (princ (strcat "\nExtrusion Height: " (rtos (distance '(0 0 0) (cdr (assoc 10 e)))))) ) ((eq solid "ACSH_BOX_CLASS") (princ (strcat "\nBox Height: " (rtos (cdr (assoc 42 (reverse e)))))) ) ((eq solid "ACSH_CYLINDER_CLASS") (princ (strcat "\nCylinder Height: " (rtos (cdr (assoc 40 (reverse e)))))) ) (T (princ "\nUnable to extract solid height.") ) ) ) (princ) ) Doesn't work on edited solids, or modified by a boolean operation. Still, if the section of the solid (section perpendicular to extrusion direction) is a circle or a rectangle, you can find the height with some calculation over the geometric properties.

Here is an example of the 3d to 1d curve - upon which my theory can be tested with the VLAX functions. EqualParam.dwg

Fuccaro said "I will make such a drawing machine for my children". Google spirograph its a toy. Can spend hours on it. For the dcl have a look in downloads Multi getvals and Multi Radio buttons library defuns can be used in any code dynamic input only 2 lines of code to run.

I just find out that Inventor has a module for dynamic simulation. I built a simple mechanism and I started to learn by playing. I’ve got the some images like the ones I posted here before, showing the trace of the pen on the central disc. No Lisp or programming of any kind! I wish I knew this two years ago. However, I remember it was a pleasure to write those Lisp programs. Also I enjoyed discussing about it here in the forum. So, to make the short story even shorter: see here some screen captures.

haven't done much testing but here ya go... RlxDimensionPolyline.lsp