Here, this simplified version worked on my slowest netbook with 100 segments per vertex and it works on all versions of ACAD... I abandoned align command and used pure entmaking 3DFACES, that are later converted to REGIONS so you can union them in the end if you don't need lines for folding...
- ;; 2-Circle Intersection - Lee Mac;; Returns the point(s) of intersection between two circles;; with centres c1,c2 and radii r1,r2(defun LM:Inters2Circle ( c1 r1 c2 r2 / n d1 x z ) (if (and (< (setq d1 (distance c1 c2)) (+ r1 r2)) (< (abs (- r1 r2)) d1) ) (progn (setq n (mapcar '- c2 c1) c1 (trans c1 0 n) z (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1)) ) (if (equal z r1 1e- (list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0)) (progn (setq x (sqrt (- (* r1 r1) (* z z)))) (list (trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0) (trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0) ) ) ) ) ))(defun mid (p1 p2) (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2))(defun c:rectround ( / AP ARCENT CMDE D DD DIA ENPAR HIG INCRPAR K LEN OSM PT PTE PTLST PTM PTO RAD SEG SOL SS STPAR VSZ WID ) (vl-load-com) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list (ssget "_X"))))) (progn (alert "\nWarning DWG contains entities - there must be no entities - exiting") (exit))) (vl-cmdf "_.ucs" "w") (vl-cmdf "_.plan" "") (vl-cmdf "_.zoom" "c" '(0.0 0.0 0.0) 100.0) (vl-cmdf "_.regen") (vl-cmdf "_.zoom" "v") (setq vsz (getvar 'viewsize)) (vl-cmdf "_.zoom" "p") (vl-cmdf "_.regen") (setq osm (getvar 'osmode)) (setq cmde (getvar 'cmdecho)) (setq ap (getvar 'aperture)) (setvar 'aperture 25) (setvar 'cmdecho 0) (setvar 'osmode 0) (prompt "\nRECTROUND TRANSITION ROUTINE - ENTER TO CONTINUE") (vl-cmdf pause) (while (or (null dia) (> dia vsz)) (setq dia (getdist "\nInput diameter of Round (pick 2 points) : "))) (setq rad (/ dia 2.0)) (while (or (null len) (> len vsz)) (setq len (getdist "\nInput length of rectangle (pick 2 points) : "))) (while (or (null wid) (> wid vsz)) (setq wid (getdist "\nInput width of rectangle (pick 2 points) : "))) (while (or (null hig) (> hig vsz)) (setq hig (getdist "\nInput height of transition (pick 2 points) : "))) (initget 7) (setq seg (getint "\nInput number of segemnts per vertex of rectangle : ")) (vl-cmdf "_.arc" "c" "_non" (list 0.0 0.0 hig) "_non" (list rad 0.0 hig) "_non" (list 0.0 rad hig)) (if (> (getvar 'cmdactive) 0) (vl-cmdf "")) (setq arcent (entlast)) (setq stpar (vlax-curve-getstartparam arcent)) (setq enpar (vlax-curve-getendparam arcent)) (setq incrpar (/ (- enpar stpar) (float seg))) (setq k -1) (repeat (+ seg 1) (setq pt (vlax-curve-getpointatparam arcent (+ stpar (* (float (setq k (1+ k))) incrpar)))) (setq ptlst (cons pt ptlst)) ) (setq ptlst (reverse ptlst)) (cond ((and (equal rad (/ len 2.0) 1e- (equal rad (/ wid 2.0) 1e-) (vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list rad rad 0.0)) (if (> (getvar 'cmdactive) 0) (vl-cmdf "")) ) ((or (and (> rad (/ len 2.0)) (> rad (/ wid 2.0))) (and (equal rad (/ len 2.0) 1e- (> rad (/ wid 2.0))) (and (> rad (/ len 2.0)) (equal rad (/ wid 2.0) 1e-)) (vl-cmdf "_.pline" "_non" '(0.0 0.0 0.0) "_non" (list rad 0.0 0.0) "a" "s" "_non" (list (* (sqrt 0.5) rad) (* (sqrt 0.5) rad) 0.0) "_non" (list 0.0 rad 0.0) "l" "c") ) ((or (and (< rad (/ len 2.0)) (< rad (/ wid 2.0))) (and (equal rad (/ len 2.0) 1e- (< rad (/ wid 2.0))) (and (< rad (/ len 2.0)) (equal rad (/ wid 2.0) 1e-)) (vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list (/ len 2.0) (/ wid 2.0) 0.0)) (if (> (getvar 'cmdactive) 0) (vl-cmdf "")) ) ((and (> rad (/ len 2.0)) (< rad (/ wid 2.0))) (vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list rad (/ wid 2.0) 0.0)) (if (> (getvar 'cmdactive) 0) (vl-cmdf "")) ) ((and (< rad (/ len 2.0)) (> rad (/ wid 2.0))) (vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list (/ len 2.0) rad 0.0)) (if (> (getvar 'cmdactive) 0) (vl-cmdf "")) ) ) (vl-cmdf "_.extrude" (entlast) "" hig) (setq sol (entlast)) (vl-cmdf "_.slice" sol "" "3" "_non" (list (/ len 2.0) 0.0 0.0) "_non" (list (/ len 2.0) (/ wid 2.0) 0.0) "_non" (car ptlst) "_non" '(0.0 0.0 0.0)) (setq k -1) (repeat seg (vl-cmdf "_.slice" sol "" "3" "_non" (nth (setq k (1+ k)) ptlst) "_non" (nth (+ k 1) ptlst) "_non" (list (/ len 2.0) (/ wid 2.0) 0.0) "_non" '(0.0 0.0 0.0)) ) (vl-cmdf "_.slice" sol "" "3" "_non" (list 0.0 (/ wid 2.0) 0.0) "_non" (list (/ len 2.0) (/ wid 2.0) 0.0) "_non" (last ptlst) "_non" '(0.0 0.0 0.0)) (vl-cmdf "_.mirror" sol "" "_non" '(0.0 0.0 0.0) "_non" '(0.0 1.0 0.0) "") (setq ss (ssadd)) (ssadd sol ss) (ssadd (entlast) ss) (vl-cmdf "_.union" ss "") (setq sol (entlast)) (vl-cmdf "_.mirror" sol "" "_non" '(1.0 0.0 0.0) "_non" '(0.0 0.0 0.0) "") (setq ss (ssadd)) (ssadd sol ss) (ssadd (entlast) ss) (vl-cmdf "_.union" ss "") (entdel arcent) (vl-cmdf "_.copybase" '(0.0 0.0 0.0) (entlast) "") (vl-cmdf "_.erase" (entlast) "") (vl-cmdf "_.vpoint" "-1.0,-1.0,1.0") (setq pt (list 0.0 (+ (/ wid 2.0) (distance (list 0.0 (/ wid 2.0) 0.0) (list 0.0 rad hig))) 0.0)) (entmake (list '(0 . "3DFACE") (cons 10 (list 0.0 (/ wid 2.0) 0.0)) (cons 11 (list (/ len 2.0) (/ wid 2.0) 0.0)) (cons 12 pt) (cons 13 pt))) (setq k -1) (setq ptlst (reverse ptlst)) (setq d (distance (nth 0 ptlst) (nth 1 ptlst))) (repeat seg (setq dd (distance (list (/ len 2.0) (/ wid 2.0) 0.0) (nth (+ (setq k (1+ k)) 1) ptlst))) (setq pto pt) (setq pt (car (LM:Inters2Circle (list (/ len 2.0) (/ wid 2.0) 0.0) dd pto d))) (setq pt (list (car pt) (cadr pt) 0.0)) (entmake (list '(0 . "3DFACE") (cons 10 (list (/ len 2.0) (/ wid 2.0) 0.0)) (cons 11 pto) (cons 12 pt) (cons 13 pt))) ) (setq ptm (mid (list (/ len 2.0) (/ wid 2.0) 0.0) pt)) (setq pte (cadr (LM:Inters2Circle ptm (distance ptm pt) (list (/ len 2.0) (/ wid 2.0) 0.0) (/ len 2.0)))) (if (eq pte nil) (setq pte (cadr (LM:Inters2Circle pt (distance (list (/ len 2.0) 0.0 0.0) (last ptlst)) (list (/ len 2.0) (/ wid 2.0) 0.0) (/ len 2.0))))) (setq pte (list (car pte) (cadr pte) 0.0)) (entmake (list '(0 . "3DFACE") (cons 10 (list (/ len 2.0) (/ wid 2.0) 0.0)) (cons 11 pt) (cons 12 pte) (cons 13 pte))) (vl-cmdf "_.plan" "") (vl-cmdf "_.regen") (vl-cmdf "_.zoom" "v") (setq ss (ssget "_X" '((0 . "3DFACE")))) (vl-cmdf "_.region" ss "") (setq ss (ssget "_X" '((0 . "REGION")))) (vl-cmdf "_.mirror" ss "" "_end" pte "_end" pt "") (setq ss (ssget "_X" '((0 . "REGION")))) (vl-cmdf "_.mirror" ss "" '(0.0 0.0 0.0) '(0.0 1.0 0.0) "") (vl-cmdf "_.pasteclip" '(0.0 0.0 0.0)) (setvar 'aperture ap) (setvar 'cmdecho cmde) (setvar 'osmode osm) (princ))
M.R. |