Jump to content

LISP routine to develop square to round transition?

lamensterms

By lamensterms
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

lamensterms Mentor

lamensterms

Posted
Posted

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.

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

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]vl-load-com[/color])
 ([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] rad ([color=blue]/[/color] dia 2.0))
 ([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-)
   (vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list rad rad 0.0))
   (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]and[/color] ([color=blue]>[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]<[/color] rad ([color=blue]/[/color] wid 2.0)))
   ([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]and[/color] ([color=blue]<[/color] rad ([color=blue]/[/color] len 2.0)) ([color=blue]>[/color] rad ([color=blue]/[/color] wid 2.0)))
   ([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]setq[/color] ss ([color=blue]ssadd[/color]))
 ([color=blue]ssadd[/color] sol ss)
 ([color=blue]ssadd[/color] ([color=blue]entlast[/color]) ss)
 ([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]setq[/color] ss ([color=blue]ssadd[/color]))
 ([color=blue]ssadd[/color] sol ss)
 ([color=blue]ssadd[/color] ([color=blue]entlast[/color]) ss)
 ([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
mdbdesign Experienced

mdbdesign

Posted
Posted (edited)

Try this:

http://www.litio.si

 

It is not free but great.

Edited by mdbdesign
Looks like prewious link was outdated, thisone work.
MMS Contributor

MMS

Posted
Posted

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)
   )
)
;convert degree to radian
(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
(setq AD H1
     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)

lamensterms Mentor

lamensterms

Posted
  • Author
Posted

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.

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

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 )
 (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) 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 rad (/ dia 2.0))
 (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-)
   (vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (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" '(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 ""))
   )
   ((and (> rad (/ len 2.0)) (< rad (/ wid 2.0)))
   (vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (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" '(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) "")
 (setq ss (ssadd))
 (ssadd sol ss)
 (ssadd (entlast) ss)
 (vl-cmdf "_.union" ss "")
 (setq sol (entlast))
 (vl-cmdf "_.mirror" sol "" '(1.0 0.0 0.0) '(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 "_.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
marko_ribar Veteran

marko_ribar

Posted
Posted

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

 

Regards,

M.R.

lamensterms Mentor

lamensterms

Posted
  • Author
Posted

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.

marko_ribar Veteran

marko_ribar

Posted
Posted

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.

lamensterms Mentor

lamensterms

Posted
  • Author
Posted

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.

  • 5 months later...
lamensterms Mentor

lamensterms

Posted
  • Author
Posted

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.

 

Just wondering if someone could please help me refine this transition routine (in post #7)?

 

Thanks again.

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

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.                       ;;
;;; All copyrights reserved.                                  ;;
;;;-----------------------------------------------------------;;
(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 app (vlax-get-acad-object))
 (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
   (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
 )
)

;;;-----------------------------------------------------------;;
;;; 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 )
 (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))
 (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-)
   (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 ""))
   )
 )
 (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)
 (setq ss (ssadd))
 (ssadd sol ss)
 (ssadd (entlast) ss)
 (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)
 (setq ss (ssadd))
 (ssadd sol ss)
 (ssadd (entlast) ss)
 (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
added P.S.
lamensterms Mentor

lamensterms

Posted
  • Author
Posted

Hi Marko,

 

Thanks again for the reply.

 

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.

marko_ribar Veteran

marko_ribar

Posted
Posted

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.

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

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.

Edited by marko_ribar
lamensterms Mentor

lamensterms

Posted
  • Author
Posted

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.

  • 1 year later...
ajtrennepohl Newbie

ajtrennepohl

Posted
Posted

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...