# LISP routine to develop square to round transition?

## Recommended Posts

Hey guys,

We are doing a little chute-work in the office at the moment, and have had the need to develop some bend/folded plate work. The items we seem to be spending the most time on are square-to-round transition segements, where the chute walls are made of 1 plate, folded to the desired shape.

Im sure most of you are familiar with this type of work - but I was just wondering if anyone knew of a good routine which will easily produce the developed/flattened plate of these transition segments.

We have been using this site... http://www.sheetmetalguy.com/transition.htm... which does work quite well - when it works (it seems the site is quite old, and will only run in IE... sometimes).

So i was thinking, it would be great to have a routine which would ask the user to select a 2D square/rectangle and a 2D circle... and the routine would calculate the distance between the 2 shapes (Z value) and then produce a 2D flattened profile of the required shape.

Anyone know of a routine such as this?

I do have a little LISP experience, but I imagine something like this could be quite involved and over my head.

Thanks a lot for any help.

Cheers.

##### Share on other sites

Try this...

```([color=blue]defun[/color] c:rectround ( [color=blue]/[/color] ARCENT DIA ENPAR HIG INCRPAR K LEN OSM PT PTLST RAD RECENT SEG SOL SS STPAR WID )
([color=blue]setq[/color] osm ([color=blue]getvar[/color] 'osmode))
([color=blue]setvar[/color] 'osmode 0)
([color=blue]vl-cmdf[/color] [color=brown]"osnap"[/color] [color=brown]"off"[/color])
([color=blue]setq[/color] dia ([color=blue]getdist[/color] [color=brown]"\nInput diameter of Round (pick 2 points) : "[/color]))
([color=blue]setq[/color] len ([color=blue]getdist[/color] [color=brown]"\nInput length of rectangle (pick 2 points) : "[/color]))
([color=blue]setq[/color] wid ([color=blue]getdist[/color] [color=brown]"\nInput width of rectangle (pick 2 points) : "[/color]))
([color=blue]setq[/color] hig ([color=blue]getdist[/color] [color=brown]"\nInput height of transition (pick 2 points) : "[/color]))
([color=blue]initget[/color] 6)
([color=blue]setq[/color] seg ([color=blue]getint[/color] [color=brown]"\nInput number of segemnts per vertex of rectangle : "[/color]))
([color=blue]vl-cmdf[/color] [color=brown]"_.arc"[/color] [color=brown]"c"[/color] ([color=blue]list[/color] 0.0 0.0 hig) ([color=blue]list[/color] rad 0.0 hig) ([color=blue]list[/color] 0.0 rad hig))
([color=blue]if[/color] ([color=blue]>[/color] ([color=blue]getvar[/color] 'cmdactive) 0) ([color=blue]vl-cmdf[/color] [color=brown]""[/color]))
([color=blue]setq[/color] arcent ([color=blue]entlast[/color]))
([color=blue]setq[/color] stpar ([color=blue]vlax-curve-getparamatpoint[/color] arcent ([color=blue]list[/color] rad 0.0 hig)))
([color=blue]setq[/color] enpar ([color=blue]vlax-curve-getparamatpoint[/color] arcent ([color=blue]list[/color] 0.0 rad hig)))
([color=blue]setq[/color] incrpar ([color=blue]/[/color] ([color=blue]-[/color] enpar stpar) ([color=blue]float[/color] seg)))
([color=blue]setq[/color] k -1)
([color=blue]repeat[/color] ([color=blue]+[/color] seg 1)
([color=blue]setq[/color] pt ([color=blue]vlax-curve-getpointatparam[/color] arcent ([color=blue]+[/color] stpar ([color=blue]*[/color] ([color=blue]float[/color] ([color=blue]setq[/color] k ([color=blue]1+[/color] k))) incrpar))))
([color=blue]setq[/color] ptlst ([color=blue]cons[/color] pt ptlst))
)
([color=blue]setq[/color] ptlst ([color=blue]reverse[/color] ptlst))
([color=blue]cond[/color]
((and (equal rad (/ len 2.0) 1e- (equal rad (/ wid 2.0) 1e-)
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
(([color=blue]or[/color] ([color=blue]and[/color] ([color=blue]>[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]>[/color] rad ([color=blue]/[/color] wid 2.0))) ([color=blue]and[/color] ([color=blue]equal[/color] rad ([color=blue]/[/color] len 2.0) 1e- ([color=blue]>[/color] rad ([color=blue]/[/color] wid 2.0))) ([color=blue]and[/color] ([color=blue]>[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]equal[/color] rad ([color=blue]/[/color] wid 2.0) 1e-))
([color=blue]vl-cmdf[/color] [color=brown]"_.pline"[/color] '(0.0 0.0 0.0) ([color=blue]list[/color] rad 0.0 0.0) [color=brown]"a"[/color] [color=brown]"s"[/color] ([color=blue]list[/color] ([color=blue]*[/color] ([color=blue]sqrt[/color] 0.5) rad) ([color=blue]*[/color] ([color=blue]sqrt[/color] 0.5) rad) 0.0) ([color=blue]list[/color] 0.0 rad 0.0) [color=brown]"l"[/color] [color=brown]"c"[/color])
)
(([color=blue]or[/color] ([color=blue]and[/color] ([color=blue]<[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]<[/color] rad ([color=blue]/[/color] wid 2.0))) ([color=blue]and[/color] ([color=blue]equal[/color] rad ([color=blue]/[/color] len 2.0) 1e- ([color=blue]<[/color] rad ([color=blue]/[/color] wid 2.0))) ([color=blue]and[/color] ([color=blue]<[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]equal[/color] rad ([color=blue]/[/color] wid 2.0) 1e-))
([color=blue]vl-cmdf[/color] [color=brown]"_.rectangle"[/color] '(0.0 0.0 0.0) ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) ([color=blue]/[/color] wid 2.0) 0.0))
([color=blue]if[/color] ([color=blue]>[/color] ([color=blue]getvar[/color] 'cmdactive) 0) ([color=blue]vl-cmdf[/color] [color=brown]""[/color]))
)
([color=blue]vl-cmdf[/color] [color=brown]"_.rectangle"[/color] '(0.0 0.0 0.0) ([color=blue]list[/color] rad ([color=blue]/[/color] wid 2.0) 0.0))
([color=blue]if[/color] ([color=blue]>[/color] ([color=blue]getvar[/color] 'cmdactive) 0) ([color=blue]vl-cmdf[/color] [color=brown]""[/color]))
)
([color=blue]vl-cmdf[/color] [color=brown]"_.rectangle"[/color] '(0.0 0.0 0.0) ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) rad 0.0))
([color=blue]if[/color] ([color=blue]>[/color] ([color=blue]getvar[/color] 'cmdactive) 0) ([color=blue]vl-cmdf[/color] [color=brown]""[/color]))
)
)
([color=blue]vl-cmdf[/color] [color=brown]"_.extrude"[/color] ([color=blue]entlast[/color]) [color=brown]""[/color] hig)
([color=blue]setq[/color] sol ([color=blue]entlast[/color]))
([color=blue]vl-cmdf[/color] [color=brown]"_.slice"[/color] sol [color=brown]""[/color] [color=brown]"3"[/color] ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) 0.0 0.0) ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) ([color=blue]/[/color] wid 2.0) 0.0) ([color=blue]car[/color] ptlst) '(0.0 0.0 0.0))
([color=blue]setq[/color] k -1)
([color=blue]repeat[/color] seg
([color=blue]vl-cmdf[/color] [color=brown]"_.slice"[/color] sol [color=brown]""[/color] [color=brown]"3"[/color] ([color=blue]nth[/color] ([color=blue]setq[/color] k ([color=blue]1+[/color] k)) ptlst) ([color=blue]nth[/color] ([color=blue]+[/color] k 1) ptlst) ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) ([color=blue]/[/color] wid 2.0) 0.0) '(0.0 0.0 0.0))
)
([color=blue]vl-cmdf[/color] [color=brown]"_.slice"[/color] sol [color=brown]""[/color] [color=brown]"3"[/color] ([color=blue]list[/color] 0.0 ([color=blue]/[/color] wid 2.0) 0.0) ([color=blue]list[/color] ([color=blue]/[/color] len 2.0) ([color=blue]/[/color] wid 2.0) 0.0) ([color=blue]last[/color] ptlst) '(0.0 0.0 0.0))
([color=blue]vl-cmdf[/color] [color=brown]"_.mirror"[/color] sol [color=brown]""[/color] '(0.0 0.0 0.0) '(0.0 1.0 0.0) [color=brown]""[/color])
([color=blue]vl-cmdf[/color] [color=brown]"_.union"[/color] ss [color=brown]""[/color])
([color=blue]setq[/color] sol ([color=blue]entlast[/color]))
([color=blue]vl-cmdf[/color] [color=brown]"_.mirror"[/color] sol [color=brown]""[/color] '(1.0 0.0 0.0) '(0.0 0.0 0.0) [color=brown]""[/color])
([color=blue]vl-cmdf[/color] [color=brown]"_.union"[/color] ss [color=brown]""[/color])
([color=blue]entdel[/color] arcent)
([color=blue]setvar[/color] 'osmode osm)
([color=blue]princ[/color])
)
```

M.R.

Edited by marko_ribar
code changed
##### Share on other sites

Try this:

It is not free but great.

Edited by mdbdesign
Looks like prewious link was outdated, thisone work.
##### Share on other sites

Here's the code just for 4 segment. This code isn't finished and still in developing . Hope you can modify this code.

```;; Program Bentangan Ducting Transisi Kotak ke Lingkaran
;; DR2C Beta Version 0.0
;; Program ini hanya bekerja untuk 4 segment
;; Dibuat 		: Afrizanirman
;; Email 		: udaaf@yahoo.co.id
;; Tgl Pembuatan	: 15/3/2012

;; Tangent  -  Lee Mac
;; Args: x - real

(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)

;; ArcSine  -  Lee Mac
;; Args: -1 <= x <= 1

(defun asin ( x )
(cond
(   (equal (abs x) 1.0 1e-10)
(* x pi 0.5)
)
(   (< -1.0 x 1.0)
(atan x (sqrt (- 1.0 (* x x))))
)
)
)

;; ArcCosine  -  Lee Mac
;; Args: -1 <= x <= 1

(defun acos ( x )
(cond
(   (equal x  1.0 1e-10)
0.0
)
(   (equal x -1.0 1e-10)
pi
)
(   (< -1.0 x 1.0)
(atan (sqrt (- 1.0 (* x x))) x)
)
)
)

;; Hyperbolic Sine  -  Lee Mac
;; Args: x - real

(defun sinh ( x )
(/ (- (exp x) (exp (- x))) 2.0)
)

;; Hyperbolic Cosine  -  Lee Mac
;; Args: x - real

(defun cosh ( x )
(/ (+ (exp x) (exp (- x))) 2.0)
)

;; Hyperbolic Tangent  -  Lee Mac
;; Args: x - real

(defun tanh ( x )
(/ (sinh x) (cosh x))
)

;; Area Hyperbolic Sine  -  Lee Mac
;; Args: x - real

(defun asinh ( x )
(log (+ x (sqrt (1+ (* x x)))))
)

;; Area Hyperbolic Cosine  -  Lee Mac
;; Args: 1 <= x

(defun acosh ( x )
(if (<= 1.0 x)
(log (+ x (sqrt (1- (* x x)))))
)
)

;; Area Hyperbolic Tangent  -  Lee Mac
;; Args: -1 < x < 1

(defun atanh ( x )
(if (< (abs x) 1.0)
(/ (log (/ (1+ x) (- 1.0 x))) 2.0)
)
)
(defun DTR (x)
(* PI (/ x 180.0))
);defun

;Global Variable untuk mengkonversi radian ke dalam degree
(defun RTD (x)
(* x (/ 180.0 PI))
);defun
(defun c:DR2C ()
(setq oldOsmode (getvar "OSMODE"))

;Setting nilai default H1 = 200 mm
(setq oldH1 200)
(if (= (setq H1 (getreal (strcat "Masukan Nilai Awal H1" "<"(rtos oldH1)">"))) nil)
(setq H1 oldH1)
(setq H1 H1)
);end if

;Setting nilai default H2 = 150 mm
(setq oldH2 150)
(if (= (setq H2 (getreal (strcat "Masukan Nilai Awal H2" "<"(rtos oldH2)">"))) nil)
(setq H2 oldH2)
(setq H2 H2)
);end if

;Setting nilai default V1 = 150 mm
(setq oldV1 150)
(if (= (setq V1 (getreal (strcat "Masukan Nilai Awal V1" "<"(rtos oldV1)">"))) nil)
(setq V1 oldV1)
(setq V1 V1)
);end if

;Mencari nilai PQ
(setq PV V1
VQ (/ (- H1 H2) 2)
PQ (sqrt (+(expt PV 2) (expt VQ 2)))
); end setq

;Mencari nilai DQ
(setq PD (/ H1 2)
DQ (sqrt (+(expt PQ 2) (expt PD 2)))
)

;Mencari nilai Db
(setq P0 (/ H1 2)
PD (/ H1 2)
b0 (/ H2 2)
Db (- (sqrt (+ (expt P0 2) (expt PD 2))) b0)
);setq

;Mencari nilai ne
(setq de Db
dn V1
ne (sqrt (+ (expt de 2) (expt dn 2)))
);setq

;Mencari panjang busur bc
(setq C (/ 90.0 4)
r (/ H2 2)
bc (* 2 r (sin (/ (DTR c) 2)))
);setq

;Mencari panjang rusuk Dc dengan mencari panjang ec, eb terlebih dahulu
(setq xc (* r (sin(DTR C)))
bx (sqrt (- (expt bc 2) (expt xc 2)))
Dx (+ Db bx)
Dc (sqrt (+ (expt xc 2) (expt Dx 2)))
);setq

;Mencari nilai nf
(setq df Dc
nf (sqrt (+ (expt df 2) (expt dn 2)))
);setq

;Mencari panjang nilai Betha1
(setq UQ bc
DU nf
CosB (/ (-(+ (expt DU 2) (expt DQ 2)) (expt UQ 2)) (* 2 DU DQ))
Betha1 (acos CosB)
);setq
;Mencari panjang nilai Betha2
(setq WU bc
DW ne
CosB2 (/ (-(+ (expt DW 2) (expt DU 2)) (expt WU 2)) (* 2 DW DU))
Betha2 (acos CosB2)
);setq

;Membuat Point Bentangan
PT0 (getpoint "\nTentukan Titik Peletakan:")
PT2 (polar PT0 (DTR 0.0) (/ AD 2))
PT3 (polar PT0 (DTR 90.0) PQ)
PT1 (polar PT0 (DTR 180.0) (/ AD 2))
);setq
(setq alpha (asin (/ PQ DQ)))
(setq PT4 (polar PT1 (+ alpha betha1) DU))
(setq PT5 (polar PT1 (+ alpha betha1 betha2) DW))
(setq PT6 (polar PT1 (+ alpha betha1 betha2 betha2) DU))
(setq PT7 (polar PT1 (+ alpha betha1 betha2 betha2 Betha1) DQ))
;Membuat Object Segitiga dan rusuk
(setvar "OSMODE" 0)
(command "LINE" PT1 PT2 PT3 "C")
(command "LINE" PT1 PT4 "")
(command "LINE" PT1 PT5 "")
(command "LINE" PT1 PT6 "")
(command "LINE" PT1 PT7 "")
(setvar "OSMODE" oldOsmode)
(princ)
);defun
(Princ)

```

##### Share on other sites

thanks for the replies guys...

marko_ribar - i am looking for a routine which will draw the flattened plate, not the 3D shape. Thanks anyway.

mdbdesign - that application does work quite well - though i'm afraid it doesnt really suit me as it requires an internal radius at each corner of the rectangular end of the chute. Ill play around with it, maybe i can get it to behave as i need.

MMS - thanks for the routine mate, it looks like it could be promising, ill take a look at some of the math, and see if i can develop it further.

thanks again guys.

##### Share on other sites

Try this :

```;; 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 P1 P1O P2 P2O P3 PT PTE PTLST PTM PTO PTOO PTTT RAD RECENT REG SEG SOL SS STPAR WID )
(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) 1.0)
(vl-cmdf "_.zoom" "v")
(setq osm (getvar 'osmode))
(setq cmde (getvar 'cmdecho))
(setq ap (getvar 'aperture))
(setvar 'aperture 25)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vl-cmdf "osnap" "off")
;  (vl-cmdf "_.align")
(arxload "geom3d.arx") ; initialize (align) subfunction
(prompt "\nRECTROUND TRANSITION ROUTINE - ENTER TO CONTINUE")
(vl-cmdf pause)
(setq dia (getdist "\nInput diameter of Round (pick 2 points) : "))
(setq len (getdist "\nInput length of rectangle (pick 2 points) : "))
(setq wid (getdist "\nInput width of rectangle (pick 2 points) : "))
(setq hig (getdist "\nInput height of transition (pick 2 points) : "))
(initget 6)
(setq seg (getint "\nInput number of segemnts per vertex of rectangle : "))
(vl-cmdf "_.arc" "c" (list 0.0 0.0 hig) (list rad 0.0 hig) (list 0.0 rad hig))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
(setq arcent (entlast))
(setq stpar (vlax-curve-getparamatpoint arcent (list rad 0.0 hig)))
(setq enpar (vlax-curve-getparamatpoint arcent (list 0.0 rad hig)))
(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-)
(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" '(0.0 0.0 0.0) (list rad 0.0 0.0) "a" "s" (list (* (sqrt 0.5) rad) (* (sqrt 0.5) rad) 0.0) (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" '(0.0 0.0 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list rad (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (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" (list (/ len 2.0) 0.0 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (car ptlst) '(0.0 0.0 0.0))
(setq k -1)
(repeat seg
(vl-cmdf "_.slice" sol "" "3" (nth (setq k (1+ k)) ptlst) (nth (+ k 1) ptlst) (list (/ len 2.0) (/ wid 2.0) 0.0) '(0.0 0.0 0.0))
)
(vl-cmdf "_.slice" sol "" "3" (list 0.0 (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (last ptlst) '(0.0 0.0 0.0))
(vl-cmdf "_.mirror" sol "" '(0.0 0.0 0.0) '(0.0 1.0 0.0) "")
(vl-cmdf "_.union" ss "")
(setq sol (entlast))
(vl-cmdf "_.mirror" sol "" '(1.0 0.0 0.0) '(0.0 0.0 0.0) "")
(vl-cmdf "_.union" ss "")
(entdel arcent)
(vl-cmdf "_.copybase" '(0.0 0.0 0.0) (entlast) "")
(vl-cmdf "_.slice" (entlast) "" "ZX" '(0.0 0.0 0.0) '(1.0 1.0 0.0))
(vl-cmdf "_.slice" (entlast) "" "YZ" '(0.0 0.0 0.0) '(1.0 1.0 0.0))
(vl-cmdf "_.explode" (entlast) "")
(setq ss (ssget "_C" '(1.0 -1.0 0.0) '(-1.0 1.0 0.0)))
(vl-cmdf "_.erase" ss "")
(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))
(setq ss (ssget "_C" (list -0.1 (- (/ wid 2.0) 0.1) 0.0) (list 0.1 (+ (/ wid 2.0) 0.1) 0.0)))
(vl-cmdf "_.ucs" "e" (list 0.0 (/ wid 2.0) 0.0))
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (list 0.0 (/ wid 2.0) 0.0) (list 0.0 (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list 0.0 rad hig) 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))
(setq ss (ssget (mid (setq ptoo (osnap (nth k ptlst) "_non")) (setq pttt (osnap (nth (+ k 1) ptlst) "_non")))))
(align ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) ptoo pto pttt pt)
(vl-cmdf "_.ucs" "e" pt)
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (setq p1 (osnap (setq p1o (cdr (assoc 10 (entget (ssname ss 0))))) "_end")) (list (car p1) (cadr p1) 0.0) (setq p2 (osnap (setq p2o (cdr (assoc 10 (cdr (member (list 10 (car p1o) (cadr p1o)) (entget (ssname ss 0))))))) "_end")) (list (car p2) (cadr p2) 0.0) (setq p3 (osnap (cdr (assoc 10 (cdr (member (list 10 (car p2o) (cadr p2o)) (entget (ssname ss 0)))))) "_end")) (list (car p3) (cadr p3) 0.0))
)
(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))
(setq ss (ssget "_C" (list (- (/ len 2.0) 0.1) -0.1 0.0) (list (+ (/ len 2.0) 0.1) 0.1 0.0)))
(align ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list rad 0.0 hig) pt (list (/ len 2.0) 0.0 0.0) pte)
(vl-cmdf "_.ucs" "e" pte)
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (setq p1 (osnap (setq p1o (cdr (assoc 10 (entget (ssname ss 0))))) "_end")) (list (car p1) (cadr p1) 0.0) (setq p2 (osnap (setq p2o (cdr (assoc 10 (cdr (member (list 10 (car p1o) (cadr p1o)) (entget (ssname ss 0))))))) "_end")) (list (car p2) (cadr p2) 0.0) (setq p3 (osnap (cdr (assoc 10 (cdr (member (list 10 (car p2o) (cadr p2o)) (entget (ssname ss 0)))))) "_end")) (list (car p3) (cadr p3) 0.0))
(if (and (equal p1 pt 1e-6) (equal p2 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p3))
(if (and (equal p2 pt 1e-6) (equal p1 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p3))
(if (and (equal p3 pt 1e-6) (equal p1 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p2))
(if (and (equal p1 pt 1e-6) (equal p3 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p2))
(if (and (equal p3 pt 1e-6) (equal p2 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p1))
(if (and (equal p2 pt 1e-6) (equal p3 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p1))
(vl-cmdf "_.plan" "")
(vl-cmdf "_.regen")
(vl-cmdf "_.zoom" "v")
(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(vl-cmdf "_.region" ss "")
(setq ss (ssget "_X" '((0 . "REGION"))))
(vl-cmdf "_.mirror" ss "" "_non" pte "_non" 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)
)
```

Regards,

M.R.

Edited by marko_ribar
code revised finally
##### Share on other sites

Code revised finally - you may check code in post #7...

Regards,

M.R.

##### Share on other sites

wow, thats fantastic... thanks so much Marko.

I had to remove this line...

`  (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)))`

as i couldnt get the routine to run (as much as i tried to empty the DWG - the routine would still think there were entities in the DWG.

Is there a particular reason that the DWG must be empty? I can only input values manually when there is not shape in the DWG to pick points off - i might try write in a line or two which will allow the routine to run while the is an object on the screen - but then erase it as the routine progresses.

thanks again for all your help.

##### Share on other sites

The reason I wanted DWG to be empty are these lines at end of routine...

```(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(setq ss (ssget "_X" '((0 . "REGION"))))
```

As you can see (ssget "_X") checks for entities in all database, so if you have entities that haven't been created by routine, routine may include them too and mess DWG with align and mirror commands that it applies to them...

M.R.

##### Share on other sites

Awesome, thanks so much for all your help Marko. Ive manage to get it to work quite well - most of the time. Though i do get quite a good list of errors, it does produce the profiles.

I have found that I can have objects in the DWG that will not interrupt the routine, so long as they are only LINEs. This is handy if I choose to pick points for the measurement rather than entering the values manually.

I also found that it is handy to run the routine with 2 viewports in model space... the primary viewport is the one i activate the routine in (which switches to PLAN view automatically), the second viewport i leave in isometric view... which allows me to chose points on the shape, i then switch back to the primary viewport to enter the amount of curve facets/segments and run the rest of the routine.

```Command: rectround
RECTROUND TRANSITION ROUTINE - ENTER TO CONTINUE
Input diameter of Round (pick 2 points) : _endp of  Specify second point: _endp
of
Input length of rectangle (pick 2 points) : _endp of  Specify second point:
_endp of
Input width of rectangle (pick 2 points) : _endp of  Specify second point:
_endp of
Input height of transition (pick 2 points) : _endp of  Specify second point:
_endp of
Input number of segemnts per vertex of rectangle : 10

Unknown command "RECTROUND".  Press F1 for help.

The object is not able to be exploded.
Unknown command "RECTROUND".  Press F1 for help.
Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.

Error: Null argument not allowed.

Unknown command "RECTROUND".  Press F1 for help.
; error: bad argument type: 2D/3D point: nil```

Are the errors that i get, but the profiles are still produced ok.

Thanks again for all your help Marko.

##### Share on other sites
• 5 months later...

Hi again everyone,

I sorry to dredge up the past, but I am just revisiting this routine - and I cannot find a way to get it to work.

I remember there were some tricks to it... but I am having no luck this time around.

Thanks again.

##### Share on other sites

Here, I've added some limitations into input values (you must be reasonable or it will fail); also added substitution for align command - took Highfyingbird's function from www.theswamp.org... If it fails now than I can't help you - it's due to computer (it works on my comp.). Also notice that if you're using A2008 or less, you'll need to change all lines with (vl-cmdf "_.explode" ss) to be (vl-cmdf "_.explode" ss "") - if you're using A2009 or higher, you shouldn't change anything in code I'll just post...

```;;;-----------------------------------------------------------;;
;;; To simulate the command: "align"                          ;;
;;;                                                           ;;
;;; Use in some cases: command can't be applied or you don't  ;;
;;; want to use them; or improve the efficiency,etc.and here  ;;
;;; are some useful functions,e.g. "Mat:Get3PMatrix";Or even  ;;
;;; you can customize "align" command.                        ;;
;;; Author: Highflybird, Date:2012-8-6.                       ;;
;;;-----------------------------------------------------------;;
(defun Align3d (sel sP1 dP1 sP2 dP2 sP3 dP3 /
mat0 mat1 mat2 mat i ent obj app doc) (vl-load-com)

(foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)
(set x (trans (eval x) 1 0))
)

;;Get the transformation matrix
(setq mat1 (Mat:Get3PMatrix sP1 sP2 sP3))
(setq mat2 (Mat:Get3PMatrix dP1 dP2 dP3))
(setq mat (Mat:mxm (cadr mat2) (car mat1)))

;;Apply the transformation.
(setq doc (vla-get-ActiveDocument app))
(vla-StartUndoMark doc)
(setq i 0)
(if sel
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq obj (vlax-ename->vla-object ent))
(vla-transformby obj (vlax-tmatrix mat))
(setq i (1+ i))
)
)
(vla-EndUndoMark doc)
(vlax-release-object doc)
(vlax-release-object app)
(princ)
)

;;;-----------------------------------------------------------;;
;;; Vector Norm - Lee Mac                                     ;;
;;; Args: v - vector in R^n                                   ;;
;;;-----------------------------------------------------------;;
(defun Mat:norm ( v )
(sqrt (apply '+ (mapcar '* v v)))
)

;;;-----------------------------------------------------------;;
;;; Vector x Scalar - Lee Mac                                 ;;
;;; Args: v - vector in R^n, s - real scalar                  ;;
;;;-----------------------------------------------------------;;
(defun Mat:vxs ( v s )
(mapcar (function (lambda ( n ) (* n s))) v)
)

;;;-----------------------------------------------------------;;
;;; Unit Vector - Lee Mac                                     ;;
;;; Args: v - vector in R^n                                   ;;
;;;-----------------------------------------------------------;;
(defun Mat:unit ( v )
( (lambda ( n )
(if (equal 0.0 n 1e-14)
nil
(Mat:vxs v (/ 1.0 n))
)
)
(Mat:norm v)
)
)

;;;-----------------------------------------------------------;;
;;; Mat:v*v Returns the dot product of 2 vectors              ;;
;;;-----------------------------------------------------------;;
(defun Mat:v*v (v1 v2)
(apply '+ (mapcar '* v1 v2))
)

;;;-----------------------------------------------------------;;
;;; Vector Cross Product - Lee Mac                            ;;
;;; Args: u,v - vectors in R^3                                ;;
;;;-----------------------------------------------------------;;
(defun Mat:v^v ( u v )
(list
)
)

;;;-----------------------------------------------------------;;
;;; Mat:trp Transpose a matrix -Doug Wilson-                  ;;
;;;-----------------------------------------------------------;;
(defun Mat:trp (m)
(apply 'mapcar (cons 'list m))
)

;;;-----------------------------------------------------------;;
;;; Matrix x Vector - Vladimir Nesterovsky                    ;;
;;; Args: m - nxn matrix, v - vector in R^n                   ;;
;;;-----------------------------------------------------------;;
(defun Mat:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)

;;;-----------------------------------------------------------;;
;;; Mat:mxm Multiply two matrices -Vladimir Nesterovsky-      ;;
;;;-----------------------------------------------------------;;
(defun Mat:mxm (m q)
(mapcar (function (lambda (r) (Mat:mxv (Mat:trp q) r))) m)
)

;;;-----------------------------------------------------------;;
;;; Mat:Rotate90 Rotate a point 90 degree by a basepoint      ;;
;;;-----------------------------------------------------------;;
(defun Mat:Rotate90 (Pt BasePt / a)
(setq a (+ (/ pi 2) (angle BasePt Pt)))
(polar BasePt a (distance pt basePt))
)

;;;-----------------------------------------------------------;;
;;; Mat:Get3PMatrix  -Highflybird-                            ;;
;;;-----------------------------------------------------------;;
(defun Mat:Get3PMatrix (p1 p2 p3 / v1 v2 v3 mat org)
(defun AppendMatrix (mat org)
(append
(mapcar 'append mat (mapcar 'list org))
'((0. 0. 0. 1.))
)
)

(setq v1 (Mat:unit (mapcar '- p2 p1)))
(setq v2 (Mat:unit (mapcar '- p3 p1)))
(setq v3 (Mat:unit (Mat:v^v v1 v2)))
(setq v2 (Mat:unit (Mat:v^v v3 v1)))
(setq mat (list v1 v2 v3))
(setq org (mapcar '- (Mat:mxv mat p1)))
(list
(AppendMatrix mat org)           ;this->wcs transformation matrix
(AppendMatrix (Mat:trp mat) p1)    ;wcs->this transformation matrix
)
)

;; 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 OSN P1 P1O P2 P2O P3 PT PTE PTLST PTM PTO PTOO PTTT RAD RECENT REG SEG SOL SS STPAR VSZ WID )
(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) : ")))
(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))
(gc)
(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))
(gc)
(cond
((and (equal rad (/ len 2.0) 1e- (equal rad (/ wid 2.0) 1e-)
(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 ""))
)
(vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list rad (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
(vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list (/ len 2.0) rad 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
)
(gc)
(vl-cmdf "_.extrude" (entlast) "" hig)
(gc)
(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))
(gc)
(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))
(gc)
)
(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))
(gc)
(vl-cmdf "_.mirror" sol "" "_non" '(0.0 0.0 0.0) "_non" '(0.0 1.0 0.0) "")
(gc)
(vl-cmdf "_.union" ss "")
(gc)
(setq sol (entlast))
(vl-cmdf "_.mirror" sol "" "_non" '(1.0 0.0 0.0) "_non" '(0.0 0.0 0.0) "")
(gc)
(vl-cmdf "_.union" ss "")
(gc)
(entdel arcent)
(vl-cmdf "_.copybase" '(0.0 0.0 0.0) (entlast) "")
(gc)
(vl-cmdf "_.slice" (entlast) "" "ZX" "_non" '(0.0 0.0 0.0) "_non" '(1.0 1.0 0.0))
(gc)
(vl-cmdf "_.slice" (entlast) "" "YZ" "_non" '(0.0 0.0 0.0) "_non" '(1.0 1.0 0.0))
(gc)
(vl-cmdf "_.explode" (entlast))
(gc)
(setq ss (ssget "_C" '(1.0 -1.0 0.0) '(-1.0 1.0 0.0)))
(vl-cmdf "_.erase" ss "")
(gc)
(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))
(setq ss (ssget "_C" (list -0.1 (- (/ wid 2.0) 0.1) 0.0) (list 0.1 (+ (/ wid 2.0) 0.1) 0.0)))
(align3d ss (list 0.0 (/ wid 2.0) 0.0) (list 0.0 (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list 0.0 rad hig) pt)
(vl-cmdf "_.explode" ss)
(gc)
(vl-cmdf "_.pedit" "m" "p" "" "j" "" "")
(gc)
(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))
(setq ss (ssget (setq osn (osnap (mid (setq ptoo (nth k ptlst)) (setq pttt (nth (+ k 1) ptlst))) "_nea"))))
(if (not ss) (setq ss (ssget (osnap osn "_nea"))))
(align3d ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) ptoo pto pttt pt)
(gc)
(vl-cmdf "_.explode" ss)
(gc)
(vl-cmdf "_.pedit" "m" "p" "" "j" "" "")
(gc)
)
(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))
(setq ss (ssget "_C" (list (- (/ len 2.0) 0.1) -0.1 0.0) (list (+ (/ len 2.0) 0.1) 0.1 0.0)))
(align3d ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list rad 0.0 hig) pt (list (/ len 2.0) 0.0 0.0) pte)
(gc)
(vl-cmdf "_.explode" ss)
(gc)
(vl-cmdf "_.pedit" "m" "p" "" "j" "" "")
(gc)
(vl-cmdf "_.plan" "")
(vl-cmdf "_.regen")
(vl-cmdf "_.zoom" "v")
(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(vl-cmdf "_.region" ss "")
(gc)
(setq ss (ssget "_X" '((0 . "REGION"))))
(vl-cmdf "_.mirror" ss "" "_end" pte "_end" pt "")
(gc)
(setq ss (ssget "_X" '((0 . "REGION"))))
(vl-cmdf "_.mirror" ss "" '(0.0 0.0 0.0) '(0.0 1.0 0.0) "")
(gc)
(vl-cmdf "_.pasteclip" '(0.0 0.0 0.0))
(gc)
(setvar 'aperture ap)
(setvar 'cmdecho cmde)
(setvar 'osmode osm)
(princ)
)
```

M.R.

P.S. On my comp. it works even if I enter over 20 segments per vertex, but I strongly suggest you that if you don't have to, you use as less as possible segments...

Edited by marko_ribar
##### Share on other sites

Hi Marko,

It must be some issue with my computer because I still cant got it to work.

Your original routine from post #7 works – only when I type in the values (rather than picking points).

I cannot get your new routine to work at all.

Thanks again for your help – hopefully someone else might be able to assist me.

Cheers.

##### Share on other sites

I cannot get your new routine to work at all.

This topic is beginning to get old... So I decided to put it again to be actual... I did what I could, did you find some solution to your task lamensterms? By my opinion I think that this routine is definitely dependable of the type and capacity of the computer you have... And sometime it perform the task OK as desired, but sometime it don't do what should - if input is too high (segments per vertex) it can't execute slice command well and result is strange and by the way routine doesn't complete to its end... Seeing that no one haven't replied any further I wonder if you were able to use routine at all... Maybe now someone has something to offer that can help...

Sincerely, M.R.

##### Share on other sites

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 )
(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) : ")))
(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-)
(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 ""))
)
(vl-cmdf "_.rectangle" "_non" '(0.0 0.0 0.0) "_non" (list rad (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
(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) "")
(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) "")
(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.

Edited by marko_ribar
##### Share on other sites

Hi Marko,

Thanks again for the effort - we've been really busy at work lately so I havent had a chance to check the routine out.

I will let you know.

##### Share on other sites
• 1 year later...

I'm looking for two routines in LISP for AutoCAD to run on two types of transitions:

-square to round planning

-tube planning to cut at an angle

Please make sure you do not have and can send me to test.

Thank you.

## 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.

×   Pasted as rich text.   Restore formatting

Only 75 emoji are allowed.