fuccaro Posted October 10, 2017 Posted October 10, 2017 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. 1 Quote
Jef! Posted October 10, 2017 Posted October 10, 2017 Your toys are always fun and inspiring. Nicely done, thanks for sharing Quote
Dadgad Posted October 11, 2017 Posted October 11, 2017 There is much to be said for consistency. Outstanding, as always! Quote
BIGAL Posted October 11, 2017 Posted October 11, 2017 Wow will run at work my laptop is a bit slow. Quote
fuccaro Posted October 11, 2017 Author Posted October 11, 2017 Bigal: you are right, it works better on machines with generous hardware. You can increase the angular step in the first program from (/ PI 200) to (/ PI 100) or even more. In the second program lower the steps: change the line (setq steps 300) with (setq steps 100). I did so while experimenting, to get fast results, and I changed back to get a nice looking image. Also modify the values at the beginning of the programs to get other output shapes. If you like it, post some images. Everybody: thanks for playing with my lisp! Quote
marko_ribar Posted October 11, 2017 Posted October 11, 2017 (edited) Here, I think I improved a little (c:DrawIt)... Now it draws SPLINE entity, has user input prompts and no need for holding down ENTER to spoil the key... For other one I don't have a time and perhaps knowledge and I leave it to someone else... Regards, M.R. (defun c:DrawIt ( / Draw solve RotatePoint R0 R1 R2 PozAng1 PozAng2 Ang0 Ang1 Ang2 L1 L2 AngularStep AngularStepfact Color Steps Angles P0 P1 P2 Point Path cecol ti ) (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 RotatePoint ( P ) (polar P0 (+ (car steps) (angle P0 P)) (distance P0 P)) ) (setq cecol (getvar 'cecolor)) (initget 6) (setq R0 (getreal "\nRadius of main circle <150.0> : ")) (if (null R0) (setq R0 150.0) ) (initget 6) (setq PozAng1 (getreal "\nPositionAngle1 of first helper circle in decimal degrees in CW direction <60.0> : ")) (if (null PozAng1) (setq PozAng1 (/ PI -3)) (setq PozAng1 (cvunit (- PozAng1) "degree" "radian")) ) (initget 0) (setq Ang1 (getreal "\nRotationAngle1 of radius line of first helper circle in decimal degrees (positive - CCW; negative - CW; 0.0) <30.0> : ")) (if (null Ang1) (setq Ang1 (/ PI 6)) (setq Ang1 (cvunit Ang1 "degree" "radian")) ) (initget 6) (setq R1 (getreal (strcat "\nRadius of first helper circle at angle " (rtos (cvunit PozAng1 "radian" "degree") 2 " <100.0> : "))) (if (null R1) (setq R1 100.0) ) (initget 6) (setq L1 (getreal (strcat "\nLength of Line 1 - from circle at angle " (rtos (cvunit PozAng1 "radian" "degree") 2 " <250.0> : "))) (if (null L1) (setq L1 250.0) ) (initget 6) (setq PozAng2 (getreal "\nPositionAngle2 of second helper circle in decimal degrees in CCW direction <0.0> : ")) (if (null PozAng2) (setq PozAng2 0.0) (setq PozAng2 (cvunit PozAng2 "degree" "radian")) ) (initget 0) (setq Ang2 (getreal "\nRotationAngle2 of radius line of second helper circle in decimal degrees (positive - CCW; negative - CW; 0.0) <0.0> : ")) (if (null Ang2) (setq Ang2 0.0) (setq Ang2 (cvunit Ang2 "degree" "radian")) ) (initget 6) (setq R2 (getreal (strcat "\nRadius of second helper circle at angle " (rtos (cvunit PozAng2 "radian" "degree") 2 " <50.0> : "))) (if (null R2) (setq R2 50.0) ) (initget 6) (setq L2 (getreal (strcat "\nLength of Line 2 - from circle at angle " (rtos (cvunit PozAng2 "radian" "degree") 2 " <280.0> : "))) (if (null L2) (setq L2 280.0) ) (setq Ang0 0.0) (initget 6) (setq AngularStepfact (getint "\nAngularStepFactor (/ PI n) <n=200> : ")) (if (null AngularStepfact) (setq AngularStep (/ PI 200)) ;Quality/speed (setq AngularStep (/ PI AngularStepfact)) ;Quality/speed ) (setq ti (car (_vl-times))) (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 Point (solve (setq Pa1 (polar P1 Ang1 R1)) (setq Pa2 (polar P2 Ang2 R2)) L1 L2 P0)) (setq Path (list Point)) (while (or (= (length Path) 1) (not (equal (car Path) (last Path) 1e-6))) (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)) (setq Path (mapcar '(lambda ( x ) (RotatePoint x)) Path)) (setq Path (reverse (cons Point (reverse Path)))) ) (mapcar 'Draw (list P0 P1 P2) (list R0 R1 R2) angles color) (entmake (list (cons 0 "LINE") (cons 10 Pa1) (cons 11 Point) (cons 62 (cadr color)))) (entmake (list (cons 0 "LINE") (cons 10 Pa2) (cons 11 Point) (cons 62 (caddr color)))) (setvar 'cecolor "3") (vl-cmdf "_.SPLINE") (foreach p (reverse (cdr (reverse Path))) (vl-cmdf "_non" p) ) (vl-cmdf "_C") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) (setvar 'cecolor cecol) (vl-cmdf "_.ZOOM" "_E") (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...") (princ) ) Cheers... Edited October 12, 2017 by marko_ribar Quote
fuccaro Posted October 11, 2017 Author Posted October 11, 2017 Marko_ribar Feel free to change it at your heart’s desire! I had my reasons to write it like that, you may have other solutions better suited for you. My target was to optimize the geometry without to spend a lot of time by developing. So I wrote no user interface; why to get through all the parameters if I want just to adjust one of them? Also I don’t ran the routine until it drew a “full circle”, often I aborted it on its way. And close to some special points I ran it step by step. As I mentioned earlier, I drew at low resolution (meaning high speed) at first and switched back only if the result was interesting. If written as a final product, probable the program would deserve a DCL user interface, options to save the current setting (maybe along a small image) and (why not?) a short-cut button to your PayPal account. Quote
marko_ribar Posted October 11, 2017 Posted October 11, 2017 As far as I know this forum is free for sharing and learning... If you planed to make business with posted code, then you shouldn't have posted it... This way everyone can use it the way he/she likes... I actually haven't changed much or original code and I think that you can only make it visually prettier with/out DCL and other things, but it works as it works... I mean if you can charge all the things you create then both of us would already be well rich... All I can say is that the code surely is valuable, but it is like many others thrown into waste... I don't mean that I/we don't appreciate your efforts, but I think you should have been more clever if you wanted to sell it... And by the way I don't have PayPal account and probably won't have it in the future - I am like you or anyone else used and am using others to gain what I can through www which I use and pay monthly for using it through my internet provider... Quote
fuccaro Posted October 12, 2017 Author Posted October 12, 2017 I don't intend to make profit with this program, I wrote it as a helper to optimize the design. I will make such a drawing machine for my children. Marko_ribar, your avatar looks like an image created by this program (almost) Quote
marko_ribar Posted October 12, 2017 Posted October 12, 2017 (edited) Hi, it's not so superb or who knows excellent or perfect, but it serves the purpose of decent compact DCL interface implemented to (c:DrawIt)... So now I've covered this routine to be decent application for drawing curves through SPLINE/PLINE command... Of course all the credits goes to @fuccaro - author... I've just made it more prettier and user friendly... I already use it very well... Congrats to me and author... Cheers, M.R. (defun c:DrawIt ( / txt2num makedcl solve RotatePoint Radio save R0 R1 R2 PozAng1 PozAng2 Ang0 Ang1 Ang2 L1 L2 AngularStep AngularStepfactor Steps Angles P0 P1 P2 Point Path cecol ti fname rtn c0 c1 c2 l0 l1 l2 l3 l4 mat ) (vl-load-com) (defun txt2num ( txt / num ) (if txt (or (setq num (distof txt 1)) (setq num (distof txt 2)) (setq num (distof txt 3)) (setq num (distof txt 4)) (setq num (distof txt 5)) ) ) (if (numberp num) num ) ) (defun makedcl ( fname / fn ) (setq fn (open fname "w")) (write-line "DrawIt : dialog {" fn) (write-line " label = \"DrawIt options\";" fn) (write-line " : row {" fn) (write-line " : boxed_radio_row {" fn) (write-line " key = \"Radio\";" fn) (write-line " label = \"SELECT ENTITY TYPE FOR GENERATING : \";" fn) (write-line " : radio_button {" fn) (write-line " key = \"P\";" fn) (write-line " label = \"LW (P)olyline\";" fn) (write-line " mnemonic = \"P\";" fn) (write-line " }" fn) (write-line " : radio_button {" fn) (write-line " key = \"S\";" fn) (write-line " label = \"(S)pline\";" fn) (write-line " mnemonic = \"S\";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : toggle {" fn) (write-line " key = \"save\";" fn) (write-line " label = \"Save [V]alues\";" fn) (write-line " mnemonic = \"V\";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : row {" fn) (write-line " : boxed_column {" fn) (write-line " width = 56;" fn) (write-line " : edit_box {" fn) (write-line " key = \"R0\";" fn) (write-line " label = \"R0 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"R0txt\";" fn) (write-line " value = \"Specify radius of main circle : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : boxed_column {" fn) (write-line " width = 59;" fn) (write-line " : edit_box {" fn) (write-line " key = \"step\";" fn) (write-line " label = \"step = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"steptxt\";" fn) (write-line " value = \"AngularStepFactor (/ PI n) <n=200> : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : row {" fn) (write-line " : boxed_column {" fn) (write-line " width = 56;" fn) (write-line " height = 20;" fn) (write-line " : edit_box {" fn) (write-line " key = \"R1\";" fn) (write-line " label = \"R1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"R1txt\";" fn) (write-line " value = \"Specify radius of first helper circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"PozAng1\";" fn) (write-line " label = \"PozAng1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"PozAng1txt\";" fn) (write-line " value = \"PositionAngle1 of first helper circle in decimal degrees : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"Ang1\";" fn) (write-line " label = \"Ang1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"Ang1txt\";" fn) (write-line " value = \"RotationAngle1 of radius line of first helper circle in decimal degrees : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"L1\";" fn) (write-line " label = \"L1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"L1txt\";" fn) (write-line " value = \"Length of Line 1 : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : boxed_column {" fn) (write-line " width = 59;" fn) (write-line " height = 20;" fn) (write-line " : edit_box {" fn) (write-line " key = \"R2\";" fn) (write-line " label = \"R2 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"R2txt\";" fn) (write-line " value = \"Specify radius of second helper circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"PozAng2\";" fn) (write-line " label = \"PozAng2 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"PozAng2txt\";" fn) (write-line " value = \"PositionAngle2 of second helper circle in decimal degrees : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"Ang2\";" fn) (write-line " label = \"Ang2 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"Ang2txt\";" fn) (write-line " value = \"RotationAngle2 of radius line of second helper circle in decimal degrees : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"L2\";" fn) (write-line " label = \"L2 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"L2txt\";" fn) (write-line " value = \"Length of Line 2 : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " }" fn) (write-line " ok_cancel;" fn) (write-line "}" fn) (close fn) ) (defun solve ( p1 p2 l1 l2 p ) (while (or (not (equal (distance p1 p) l1 5e-10)) (not (equal (distance p2 p) l2 5e-10))) (setq p (polar p1 (angle p1 p) l1)) (setq p (polar p2 (angle p2 p) l2)) ) p ) (defun RotatePoint ( P ) (polar P0 (+ (car steps) (angle P0 P)) (distance P0 P)) ) (setq cecol (getvar 'cecolor)) (setq fname (vl-filename-mktemp nil nil ".dcl")) (makedcl fname) (setq Dcl_Id% (load_dialog fname)) (new_dialog "DrawIt" Dcl_Id%) (setq Ang0 0.0) (setq Radio "S") (setq save "1") (if *drawit:values* (mapcar 'set '(R0 AngularStepfactor R1 PozAng1 Ang1 L1 R2 PozAng2 Ang2 L2) *drawit:values*) (mapcar 'set '(R0 AngularStepfactor R1 PozAng1 Ang1 L1 R2 PozAng2 Ang2 L2) (list "150.0" "200" "100.0" "-60.0" "30.0" "250.0" "50.0" "0.0" "0.0" "280.0")) ) (set_tile "R0" R0) (set_tile "step" AngularStepfactor) (set_tile "Radio" Radio) (set_tile "save" save) (set_tile "R1" R1) (set_tile "PozAng1" PozAng1) (set_tile "Ang1" Ang1) (set_tile "L1" L1) (set_tile "R2" R2) (set_tile "PozAng2" PozAng2) (set_tile "Ang2" Ang2) (set_tile "L2" L2) (action_tile "R0" "(setq R0 $value)") (action_tile "step" "(setq AngularStepfactor $value)") (action_tile "Radio" "(setq Radio $value)") (action_tile "save" "(setq save $value)") (action_tile "R1" "(setq R1 $value)") (action_tile "PozAng1" "(setq PozAng1 $value)") (action_tile "Ang1" "(setq Ang1 $value)") (action_tile "L1" "(setq L1 $value)") (action_tile "R2" "(setq R2 $value)") (action_tile "PozAng2" "(setq PozAng2 $value)") (action_tile "Ang2" "(setq Ang2 $value)") (action_tile "L2" "(setq L2 $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq rtn (start_dialog)) (unload_dialog Dcl_Id%) (vl-file-delete fname) (if (= save "1") (setq *drawit:values* (list R0 AngularStepfactor R1 PozAng1 Ang1 L1 R2 PozAng2 Ang2 L2)) (setq *drawit:values* nil) ) (if (= rtn 1) (setq R0 (txt2num R0) AngularStepfactor (txt2num AngularStepfactor) R1 (txt2num R1) PozAng1 (cvunit (txt2num PozAng1) "degree" "radian") Ang1 (cvunit (txt2num Ang1) "degree" "radian") L1 (txt2num L1) R2 (txt2num R2) PozAng2 (cvunit (txt2num PozAng2) "degree" "radian") Ang2 (cvunit (txt2num Ang2) "degree" "radian") L2 (txt2num L2)) ) (if (= rtn 0) (exit) ) (setq ti (car (_vl-times))) (setq mat (list (list (car (getvar 'ucsxdir)) (car (getvar 'ucsydir)) (car (trans '(0 0 1) 1 0 t)) (car (trans '(0 0 0) 1 0))) (list (cadr (getvar 'ucsxdir)) (cadr (getvar 'ucsydir)) (cadr (trans '(0 0 1) 1 0 t)) (cadr (trans '(0 0 0) 1 0))) (list (caddr (getvar 'ucsxdir)) (caddr (getvar 'ucsydir)) (caddr (trans '(0 0 1) 1 0 t)) (caddr (trans '(0 0 0) 1 0))) (list 0.0 0.0 0.0 1.0) ) ) (setq AngularStep (/ PI AngularStepfactor)) ;Quality/speed (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)) ) (if (<= (+ L1 L2) (+ (distance P1 P2) R1 R2)) (progn (prompt "\nInvalid L1, L2 specifications, sum of L1 and L2 should be greater than sum of distance between helper circles and their radiuses... Quitting, next time specify grater values for L1 and L2 lengths...") (exit) ) ) (setq Point (solve (setq Pa1 (polar P1 Ang1 R1)) (setq Pa2 (polar P2 Ang2 R2)) L1 L2 P0)) (setq Path (list Point)) (while (or (= (length Path) 1) (not (equal (car Path) (last Path) 1e-6))) (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)) (setq Path (mapcar '(lambda ( x ) (RotatePoint x)) Path)) (setq Path (reverse (cons Point (reverse Path)))) ) (setq c0 (entmakex (list (cons 0 "CIRCLE") (cons 10 P0) (cons 40 R0) (cons 62 7)))) (setq l0 (entmakex (list (cons 0 "LINE") (cons 10 P0) (cons 11 (polar P0 (car angles) R0)) (cons 62 7)))) (setq c1 (entmakex (list (cons 0 "CIRCLE") (cons 10 P1) (cons 40 R1) (cons 62 40)))) (setq l1 (entmakex (list (cons 0 "LINE") (cons 10 P1) (cons 11 (polar P1 (cadr angles) R1)) (cons 62 40)))) (setq c2 (entmakex (list (cons 0 "CIRCLE") (cons 10 P2) (cons 40 R2) (cons 62 43)))) (setq l2 (entmakex (list (cons 0 "LINE") (cons 10 P2) (cons 11 (polar P2 (caddr angles) R2)) (cons 62 43)))) (setq l3 (entmakex (list (cons 0 "LINE") (cons 10 Pa1) (cons 11 Point) (cons 62 40)))) (setq l4 (entmakex (list (cons 0 "LINE") (cons 10 Pa2) (cons 11 Point) (cons 62 43)))) (vla-transformby (vlax-ename->vla-object c0) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object l0) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object c1) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object l1) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object c2) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object l2) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object l3) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object l4) (vlax-tmatrix mat)) (setvar 'cecolor "3") (if (= Radio "S") (vl-cmdf "_.SPLINE") (vl-cmdf "_.PLINE") ) (foreach p (reverse (cdr (reverse Path))) (vl-cmdf "_non" p) ) (vl-cmdf "_C") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) (setvar 'cecolor cecol) (vl-cmdf "_.ZOOM" "_E") (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...") (princ) ) Edited October 15, 2017 by marko_ribar code updated finally... Quote
Grrr Posted October 13, 2017 Posted October 13, 2017 Cool program! Although not my type of coding (since my mind couldn't comprehend too much math), heres my input on the DCL part: ; http://www.cadtutor.net/forum/showthread.php?101919-Drawing-machine (defun C:DrawIt ( / tgassoc txt2num *error* dcl des dch dcf keys ) ; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T): ; (setq tgval (tgassoc (get_tile "tg"))) ; (set_tile "tg" (tgassoc tgval)) (defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) (setq txt2num (lambda ( txt / num ) (if (and txt (numberp (setq num (vl-some '(lambda (x) (distof txt x)) (list (getvar 'lunits) 1 2 3 4 5))))) num))) (defun *error* ( msg ) (and (< 0 dch) (unload_dialog dch)) (and (eq 'FILE (type des)) (close des)) (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl)) (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ) ); defun *error* (cond ( (not (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w")) (mapcar (function (lambda (x) (princ (strcat "\n" x) des))) '("DrawIt : dialog" "{ label = \"DrawIt options\";" " : row" " {" " : boxed_radio_row" " { key = \"Radio\"; label = \"SELECT ENTITY TYPE FOR GENERATING : \";" " : radio_button { key = \"P\"; label = \"LW (P)olyline\"; mnemonic = \"P\"; }" " : radio_button { key = \"S\"; label = \"(S)pline\"; mnemonic = \"S\"; }" " }" " : toggle { key = \"save\"; label = \"Save [V]alues\"; mnemonic = \"V\"; }" " }" " : row" " {" " : boxed_column" " { width = 56;" " : edit_box { key = \"R0\"; label = \"R0 = \"; edit_width = 10; }" " : text { key = \"R0txt\"; value = \"Specify radius of main circle : \"; }" " }" " : boxed_column" " { width = 59;" " : edit_box { key = \"step\"; label = \"step = \"; edit_width = 10; }" " : text { key = \"steptxt\"; value = \"AngularStepFactor (/ PI n) <n=200> : \"; }" " }" " }" " : row" " {" " : boxed_column" " { width = 56; height = 20;" " : edit_box { key = \"R1\"; label = \"R1 = \"; edit_width = 10; }" " : text { key = \"R1txt\"; value = \"Specify radius of first helper circle : \"; }" " : edit_box { key = \"PozAng1\"; label = \"PozAng1 = \"; edit_width = 10; }" " : text { key = \"PozAng1txt\"; value = \"PositionAngle1 of first helper circle in decimal degrees : \"; }" " : edit_box { key = \"Ang1\"; label = \"Ang1 = \"; edit_width = 10; }" " : text { key = \"Ang1txt\"; value = \"RotationAngle1 of radius line of first helper circle in decimal degrees : \"; }" " : edit_box { key = \"L1\"; label = \"L1 = \"; edit_width = 10; }" " : text { key = \"L1txt\"; value = \"Length of Line 1 : \"; }" " }" " : boxed_column" " { width = 59; height = 20;" " : edit_box { key = \"R2\"; label = \"R2 = \"; edit_width = 10; }" " : text { key = \"R2txt\"; value = \"Specify radius of second helper circle : \"; }" " : edit_box { key = \"PozAng2\"; label = \"PozAng2 = \"; edit_width = 10; }" " : text { key = \"PozAng2txt\"; value = \"PositionAngle2 of second helper circle in decimal degrees : \"; }" " : edit_box { key = \"Ang2\"; label = \"Ang2 = \"; edit_width = 10; }" " : text { key = \"Ang2txt\"; value = \"RotationAngle2 of radius line of second helper circle in decimal degrees : \"; }" " : edit_box { key = \"L2\"; label = \"L2 = \"; edit_width = 10; }" " : text { key = \"L2txt\"; value = \"Length of Line 2 : \"; }" " } " " } " " ok_cancel;" "}" ); list ); mapcar (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) ); and ); not (prompt "\nUnable to write or load the DCL file.") ) ( (not (new_dialog "DrawIt" dch)) (prompt "\nUnable to display the dialog") ) ( (progn (if *drawit:values* (setq keys *drawit:values*) (setq keys '(("Radio" "S") ("save" "1") ("R0" "150.0") ("step" "200") ("R1" "100.0") ("PozAng1" "-60.0") ("Ang1" "30.0") ("L1" "250.0") ("R2" "50.0") ("PozAng2" "0.0") ("Ang2" "0.0") ("L2""280.0") ) ); setq keys ); if (mapcar '(lambda (x) (apply 'client_data_tile x) (apply 'set_tile x)) keys) (mapcar '(lambda (x) (action_tile x (vl-prin1-to-string (quote ( (lambda ( / v ) (cond ( (setq v (txt2num $value)) (client_data_tile $key $value) ) ( (set_tile $key $data) ) ); cond ; (setq keys (subst (cons $key $data) (assoc $key keys) keys)) ; QUOTE/apostrophe ruins the 'strcase' status ); lambda ( / v ) ) ); quote ); vl-prin1-to-string ); action_tile x ); lambda (vl-remove '"Radio" (mapcar 'car keys)) ); mapcar (action_tile "accept" (vl-prin1-to-string '( (lambda ( L ) (setq keys (mapcar 'list L (mapcar 'get_tile L))) (if (tgassoc (cadr (assoc "save" keys))) (setq *drawit:values* keys)) (done_dialog 1) ); lambda ( L ) (mapcar 'car keys) ) ) ); action_tile "accept" (/= 1 (setq dcf (start_dialog))) ); progn (prompt "\nUser cancelled or terminated the dialog.") ) (T ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) keys))) ; just to check the inputs ( ; We've got the inputs.. lets draw it: (lambda ( / Radio save R0 step R1 PozAng1 Ang1 L1 R2 PozAng2 Ang2 L2 Draw solve RotatePoint cecol Ang0 AngularStep ti color steps angles P0 P1 P2 Point Pa1 Pa2 Path ) (mapcar 'set (mapcar 'read (mapcar 'car keys)) (mapcar 'txt2num (mapcar 'cadr keys))) ( (lambda (L) (mapcar 'set L (mapcar '(lambda (x) (cvunit x "degree" "radian")) (mapcar 'eval L)) ) ) '(PozAng1 Ang1 PozAng2 Ang2) ) (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 RotatePoint ( P ) (polar P0 (+ (car steps) (angle P0 P)) (distance P0 P)) ) (setq cecol (getvar 'cecolor)) (setq Ang0 0.0) ; Step = AngularStepfactor (setq AngularStep (/ PI step)) ;Quality/speed (setq ti (car (_vl-times))) (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 Point (solve (setq Pa1 (polar P1 Ang1 R1)) (setq Pa2 (polar P2 Ang2 R2)) L1 L2 P0)) (setq Path (list Point)) (while (or (= (length Path) 1) (not (equal (car Path) (last Path) 1e-6))) (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)) (setq Path (mapcar '(lambda ( x ) (RotatePoint x)) Path)) (setq Path (reverse (cons Point (reverse Path)))) ; (setq Path (append Path (list Point))) ) (mapcar 'Draw (list P0 P1 P2) (list R0 R1 R2) angles color) (entmake (list (cons 0 "LINE") (cons 10 Pa1) (cons 11 Point) (cons 62 (cadr color)))) (entmake (list (cons 0 "LINE") (cons 10 Pa2) (cons 11 Point) (cons 62 (caddr color)))) (setvar 'cecolor "3") (if (= Radio "S") (vl-cmdf "_.SPLINE") (vl-cmdf "_.PLINE") ) (foreach p (reverse (cdr (reverse Path))) (vl-cmdf "_non" p) ) (vl-cmdf "_C") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) (setvar 'cecolor cecol) (vl-cmdf "_.ZOOM" "_E") (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...") (princ) ); lambda ) ); T ); cond (*error* nil) (princ) ); defun C:test Behaves the same as Marko's code, so no change from user's perspective (perhaps a bit) - but thats my preference about how I would write the dialog part (and might help for the guys that are willing to give inputs on fuccaro's idea). (Using obviously Lee Mac's technique to create'n'run DCL code on the fly.) Quote
marko_ribar Posted October 13, 2017 Posted October 13, 2017 (edited) And second example of author @fuccaro... Now Grrr will also have to revise it - if he likes it... (defun c:DrawMe ( / txt2num makedcl RotatePoint R0 R1 E1 FixX FixY B1 B2 steps angfact cecol ang0 ang1 Dang0 Dang1 cen0 cen1 Pfix Pmob path Lmax Pa AngAux Pb Line1 Line2 crank ray Radio save ti fname rtn c0 c1 c2 c3 mat ) (vl-load-com) (defun txt2num ( txt / num ) (if txt (or (setq num (distof txt 1)) (setq num (distof txt 2)) (setq num (distof txt 3)) (setq num (distof txt 4)) (setq num (distof txt 5)) ) ) (if (numberp num) num ) ) (defun makedcl ( fname / fn ) (setq fn (open fname "w")) (write-line "DrawMe : dialog {" fn) (write-line " label = \"DrawMe options\";" fn) (write-line " : row {" fn) (write-line " : boxed_radio_row {" fn) (write-line " key = \"Radio\";" fn) (write-line " label = \"SELECT ENTITY TYPE FOR GENERATING : \";" fn) (write-line " : radio_button {" fn) (write-line " key = \"P\";" fn) (write-line " label = \"LW (P)olyline\";" fn) (write-line " mnemonic = \"P\";" fn) (write-line " }" fn) (write-line " : radio_button {" fn) (write-line " key = \"S\";" fn) (write-line " label = \"(S)pline\";" fn) (write-line " mnemonic = \"S\";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : toggle {" fn) (write-line " key = \"save\";" fn) (write-line " label = \"Save [V]alues\";" fn) (write-line " mnemonic = \"V\";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"steps\";" fn) (write-line " label = \"steps = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"stepstxt\";" fn) (write-line " value = \"Specify density of generating points : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " : row {" fn) (write-line " : boxed_column {" fn) (write-line " width = 60;" fn) (write-line " height = 20;" fn) (write-line " : edit_box {" fn) (write-line " key = \"R0\";" fn) (write-line " label = \"R0 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"R0txt\";" fn) (write-line " value = \"Specify radius main circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"R1\";" fn) (write-line " label = \"R1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"R1txt\";" fn) (write-line " value = \"Specify radius of helper circle at position PI/2 above main circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"ang1\";" fn) (write-line " label = \"ang1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"ang1txt\";" fn) (write-line " value = \"Specify starting angle of helper circle at position PI/2 above main circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"angfact\";" fn) (write-line " label = \"angfact = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"angfacttxt\";" fn) (write-line " value = \"Specify mult. factor of unit angle for helper circle unit rotation (2PI/steps*angfact) : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"E1\";" fn) (write-line " label = \"E1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"E1txt\";" fn) (write-line " value = \"Specify length of extension rotation line from center of helper circle : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"FixX\";" fn) (write-line " label = \"FixX = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"FixXtxt\";" fn) (write-line " value = \"X coordinate of point through which main line is passing : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"FixY\";" fn) (write-line " label = \"FixY = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"FixYtxt\";" fn) (write-line " value = \"Y coordinate of point through which main line is passing : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"B1\";" fn) (write-line " label = \"B1 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"B1txt\";" fn) (write-line " value = \"Specify distance from end point of rotation line of helper circle to Aux point on main line : \";" fn) (write-line " }" fn) (write-line " : edit_box {" fn) (write-line " key = \"B2\";" fn) (write-line " label = \"B2 = \";" fn) (write-line " edit_width = 10;" fn) (write-line " }" fn) (write-line " : text {" fn) (write-line " key = \"B2txt\";" fn) (write-line " value = \"Specify length of perpendicular line from main line (distance from Aux point to generating point) : \";" fn) (write-line " }" fn) (write-line " }" fn) (write-line " }" fn) (write-line " ok_cancel;" fn) (write-line "}" fn) (close fn) ) (defun RotatePoint ( p p0 ang ) (polar p0 (+ ang (angle p0 p)) (distance p0 p)) ) (setq fname (vl-filename-mktemp nil nil ".dcl")) (makedcl fname) (setq Dcl_Id% (load_dialog fname)) (new_dialog "DrawMe" Dcl_Id%) (setq Radio "S") (setq save "1") (if *drawme:values* (mapcar 'set '(R0 R1 ang1 angfact E1 FixX FixY B1 B2 steps) *drawme:values*) (mapcar 'set '(R0 R1 ang1 angfact E1 FixX FixY B1 B2 steps) (list "300.0" "150.0" "90.0" "2" "190.0" "180.0" "180.0" "330.0" "120.0" "300")) ) (set_tile "Radio" Radio) (set_tile "save" save) (set_tile "R0" R0) (set_tile "R1" R1) (set_tile "ang1" ang1) (set_tile "angfact" angfact) (set_tile "E1" E1) (set_tile "FixX" FixX) (set_tile "FixY" FixY) (set_tile "B1" B1) (set_tile "B2" B2) (set_tile "steps" steps) (action_tile "Radio" "(setq Radio $value)") (action_tile "save" "(setq save $value)") (action_tile "R0" "(setq R0 $value)") (action_tile "R1" "(setq R1 $value)") (action_tile "ang1" "(setq ang1 $value)") (action_tile "angfact" "(setq angfact $value)") (action_tile "E1" "(setq E1 $value)") (action_tile "FixX" "(setq FixX $value)") (action_tile "FixY" "(setq FixY $value)") (action_tile "B1" "(setq B1 $value)") (action_tile "B2" "(setq B2 $value)") (action_tile "steps" "(setq steps $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq rtn (start_dialog)) (unload_dialog Dcl_Id%) (vl-file-delete fname) (if (= save "1") (setq *drawme:values* (list R0 R1 ang1 angfact E1 FixX FixY B1 B2 steps)) (setq *drawme:values* nil) ) (if (= rtn 1) (setq R0 (txt2num R0) R1 (txt2num R1) ang1 (cvunit (txt2num ang1) "degree" "radian") angfact (txt2num angfact) E1 (txt2num E1) FixX (txt2num FixX) FixY (txt2num FixY) B1 (txt2num B1) B2 (txt2num B2) steps (txt2num steps)) ) (if (= rtn 0) (exit) ) (setq ti (car (_vl-times))) (setq cecol (getvar 'cecolor)) (setq mat (list (list (car (getvar 'ucsxdir)) (car (getvar 'ucsydir)) (car (trans '(0 0 1) 1 0 t)) (car (trans '(0 0 0) 1 0))) (list (cadr (getvar 'ucsxdir)) (cadr (getvar 'ucsydir)) (cadr (trans '(0 0 1) 1 0 t)) (cadr (trans '(0 0 0) 1 0))) (list (caddr (getvar 'ucsxdir)) (caddr (getvar 'ucsydir)) (caddr (trans '(0 0 1) 1 0 t)) (caddr (trans '(0 0 0) 1 0))) (list 0.0 0.0 0.0 1.0) ) ) (setq ang0 (/ PI 2)) (setq Dang0 (/ PI 0.5 steps) Dang1 (* Dang0 angfact)) (setq cen0 (list 0 0 0) cen1 (list 0 (+ R0 R1) 0)) (setq Pfix (list FixX FixY 0) PMob (polar cen1 ang1 e1)) (setq Lmax (+ e1 (distance PFix cen1) 5)) ; length of main line (setq Pa (polar PMob (setq AngAux (angle Pmob PFix)) B1)) (setq Pb (polar Pa (- AngAux (/ PI 2)) B2)) (setq path (cons Pb path)) (while (or (= (length path) 1) (not (equal (car path) (last path) 1e-6))) (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)) (setq path (mapcar '(lambda ( x ) (RotatePoint x cen0 Dang0)) path)) (setq path (cons Pb path)) ) (setq c0 (entmakex (list (cons 0 "CIRCLE") (cons 10 cen0) (cons 40 R0)))) (setq c1 (entmakex (list (cons 0 "CIRCLE") (cons 10 cen1) (cons 40 R1)))) (setq c2 (entmakex (list (cons 0 "CIRCLE") (cons 10 PFix) (cons 40 3.0)))) (setq c3 (entmakex (list (cons 0 "CIRCLE") (cons 10 cen1) (cons 40 3.0)))) (setq Line1 (entmakex (list (cons 0 "LINE") (cons 10 PMob) (cons 11 (polar PMob (angle PMob Pfix) Lmax)) (cons 62 41)))) (setq Line2 (entmakex (list (cons 0 "LINE") (cons 10 Pa) (cons 11 Pb) (cons 62 41)))) (setq crank (entmakex (list (cons 0 "LINE") (cons 10 cen1) (cons 11 PMob)))) (setq ray (entmakex (list (cons 0 "LINE") (cons 10 cen0) (cons 11 (polar cen0 ang0 (* 0.5 r0)))))) (vla-transformby (vlax-ename->vla-object c0) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object c1) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object c2) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object c3) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object Line1) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object Line2) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object crank) (vlax-tmatrix mat)) (vla-transformby (vlax-ename->vla-object ray) (vlax-tmatrix mat)) (setvar 'cecolor "3") (if (= Radio "S") (vl-cmdf "_.SPLINE") (vl-cmdf "_.PLINE") ) (foreach p path (vl-cmdf "_non" p) ) (vl-cmdf "_C") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) (setvar 'cecolor cecol) (vl-cmdf "_.ZOOM" "_E") (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...") (princ) ) Regards, M.R. Edited October 15, 2017 by marko_ribar code changed to fix bug caused by not exact matching start/end points of curve Quote
Grrr Posted October 13, 2017 Posted October 13, 2017 And second example of author @fuccaro... Now Grrr will also have to revise it - if he likes it... I will try when I get some free time, BTW you did a really good job with the DCL (and I just enjoy rewriting and understanding from the code as more I can). One thing is when I set the "R1" to value of 101 I got a very big or maybe endless loop, while its calculating the points (when I break the program it stops at the RotatePoint function). So maybe add some counter to interrupt when it comsumes more than 10 seconds? Quote
marko_ribar Posted October 14, 2017 Posted October 14, 2017 I will try when I get some free time, BTW you did a really good job with the DCL (and I just enjoy rewriting and understanding from the code as more I can). One thing is when I set the "R1" to value of 101 I got a very big or maybe endless loop, while its calculating the points (when I break the program it stops at the RotatePoint function). So maybe add some counter to interrupt when it comsumes more than 10 seconds? Hi Grrr, I've changed (c:DrawIt) a little : (defun solve ( p1 p2 l1 l2 p ) (while (or (not (equal (distance p1 p) l1 5e-10)) (not (equal (distance p2 p) l2 5e-10))) (setq p (polar p1 (angle p1 p) l1)) (setq p (polar p2 (angle p2 p) l2)) ) p ) And this to suit to changed (solve) : (if (<= (+ L1 L2) (+ (distance P1 P2) R1 R2)) (progn (prompt "\nInvalid L1, L2 specifications, sum of L1 and L2 should be greater than sum of distance between helper circles and their radiuses... Quitting, next time specify grater values for L1 and L2 lengths...") (exit) ) ) I'll try to investigate for (c:DrawMe), but I won't promise anything... Please if you have a time, better to solve the problem, then to revise already working routine with DCL only written differently... Thanks, M.R. Quote
marko_ribar Posted October 14, 2017 Posted October 14, 2017 (edited) Hi Grrr, I've fixed bug, but now I warn you that start/end curve vertex don't match exactly, so there may be some deviations on this exact portion of curve, but now should work fine if any user input... [EDIT : Almost any user input, but not... For R1=103 it won't work until you don't specify steps=100...] [EDIT2 : Now another bug - incomplete curve - R1=118, but this now can't be avoided if next calculated vertex is crossing start one... Only thing that might be done is to perhaps add one more variable for input and that is starting ang1 variable that is hard coded to PI/2; so if that is to be changed to some different angle, perhaps the same curve would be generated but with some rotation in comparison to original that's incomplete...] [EDIT3 : I've added ang1 variable into DCL, but still there are problems with R1=118... Now either loops endlessly if steps=300 and ang1=0.0, or if some different ang1 (for ex. 45.0 , 135.0) if works, but curving continued forming 2 or more passes that are stopped somewhere on crossing - also incomplete... So tried quick fix with ang1 still is problematic... Nevertheless it's better with ang1 in DCL than without it...] M.R. Edited October 14, 2017 by marko_ribar Quote
fuccaro Posted October 14, 2017 Author Posted October 14, 2017 Thanks for the titanic work! I don't have AutoCAD right now to test it, but I am pretty sure that the spline thing works right only in WCS. Have a nice day! Quote
marko_ribar Posted October 15, 2017 Posted October 15, 2017 Thanks for the titanic work!I don't have AutoCAD right now to test it, but I am pretty sure that the spline thing works right only in WCS. Have a nice day! I don't see why it wouldn't work in any UCS... I've updated codes to be applicable to any UCS in 3D... For me splines are fine - they are created ordinary like in WCS, only SPLINE command is used in some 3D UCS and result should be curve in UCS plane... 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.