(defun c:DrawIt ( / *error* 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 ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (and m (equal "quit / exit abort" m) ) (princ) ) (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) : \";" 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" "(progn (done_dialog 1) (setq rtn 1))") (action_tile "cancel" "(progn (done_dialog 0) (setq rtn 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) )