topic Re: Sheet Metal Flat Patterns in Visual LISP, AutoLISP and General Customization Forum

Sheet Metal Flat Patterns

anderson51 — Fri, 26 Jun 2020 14:42:51 GMT

Is there a LISP routine or any customization to figure out flat patterns for sheet metal?

Thanks,

Anderson

Re: Sheet Metal Flat Patterns

devitg — Fri, 26 Jun 2020 14:53:12 GMT

@anderson51 , hi . Yes, it are .

Fusion 360 , INVENTOR, SOLID WORK have it incorporated.

Besides it, search for flat pattern lisp.

I found

https://www.cadalyst.com/cad/creating-flat-pattern-drawings-sheet-metal-parts-alibre-design-tips-11244

Hope it help

Re: Sheet Metal Flat Patterns

john.uhden — Sat, 27 Jun 2020 17:23:26 GMT

I really don't know what sheet metal flat patterns are, but I am envisioning that they are like the panels we design for vinyl swimming pool liners that are cut by machine from 6' bolts of vinyl material (usually 20 or 27 ga.). The panel polylines are nested and sent to an Eastman cutting machine (just like North Sails uses) and then the panels are RF heat sealed together to form the finished product.

For a local manufacturer I have written custom AutoLisp programs for various shapes like rectangle, lazy_L, true_L, grecian, oval, and even freeform. Each reduces the drafting time for one liner from about 45 minutes to 1 minute including data entry, though each of the draftsmen has been trained to do the work without programming assistance, which is often needed for some uniquely shaped pools.

I have never been aware of other software that could provide the required results.

I wonder what @Anonymous uses for the patterns for his Lund aluminum boats.

Re: Sheet Metal Flat Patterns

Sea-Haven — Sun, 28 Jun 2020 00:50:01 GMT

I think this is posted elsewhere also, found a good site that writes the draw a flat shape for ducts code etc based on your input tested and it worked. Simple shapes. Cone, elbow etc. It was yesterday.

Found

(defun c:sqxxx() (princ "# <br>Please visit www.ktsaleej.blogspot.com<br> #") (setq loc(getpoint "\n Pick base point: ")) (setq x1(+ (car loc) 0)) (setq x2(+ (car loc) 304.43164423731843)) (setq x3(+ (car loc) 608.8632884746369)) (setq x4(+ (car loc) 454.3294589125463)) (setq x5(+ (car loc) 304.43164423731843)) (setq x6(+ (car loc) 154.5338295620906)) (setq y1(+ (cadr loc) 478.14150156713515)) (setq y2(+ (cadr loc) 526.1154921602865)) (setq y3(+ (cadr loc) 478.14150156713515)) (setq y4(+ (cadr loc) 0)) (setq y5(+ (cadr loc) 23.621711104242024)) (setq y6(+ (cadr loc) 0)) (setq p1(list x1 y1)) (setq p2(list x2 y2)) (setq p3(list x3 y3)) (setq p4(list x4 y4)) (setq p5(list x5 y5)) (setq p6(list x6 y6)) (command"ZOOM" loc p3 "arc" p1 p2 p3 "arc" p6 p5 p4 "line"p1 p6 "" "line" p3 p4 """text" "j" "bl" p6 "255.5203393643026" 0 "C-1" "") ) (c:sqxxx)

Re: Sheet Metal Flat Patterns

john.uhden — Sun, 28 Jun 2020 01:06:56 GMT

Umm,the only input seems to be "Pick base point: "
Ah, but all those flat patterns are the same, I guess.😂

Re: Sheet Metal Flat Patterns

Sea-Haven — Sun, 28 Jun 2020 01:09:33 GMT

Go to the website it writes lsp code that you copy and paste. Subtle problem the <br> this was for 100 200 500 cone.

Re: Sheet Metal Flat Patterns

john.uhden — Sun, 28 Jun 2020 01:20:56 GMT

No wonder. We don't have any cone shaped pools (at least that I know of).

Betreff: Sheet Metal Flat Patterns

schulz8NPAP — Sun, 28 Jun 2020 10:42:09 GMT

Have a look at ww.ant-ares.de

Regards

Jochen

Betreff: Sheet Metal Flat Patterns

john.uhden — Sun, 28 Jun 2020 14:54:56 GMT

" *ww.ant-ares.de <>*’s server IP address could not be
found. "

Betreff: Sheet Metal Flat Patterns

devitg — Sun, 28 Jun 2020 15:01:58 GMT

Hi @john.uhden try http://www.ant-ares.de/ it works

Betreff: Sheet Metal Flat Patterns

john.uhden — Sun, 28 Jun 2020 15:49:56 GMT

Yep. That's the same way I do varying curved slopes for a freeform (a la
kidney) swimming pool liner... triangulation, except that shapes that are
close to being arcs or lines are weeded and replaced with arcs or lines
(actually all one polyline). The beauty of vinyl is that it stretches, so
that being within a quarter inch is acceptable. We actually mathematically
shrink the panels so the liner fits tight to the bottom and walls when
filled with water (no wrinkles). And I think that arcs are cut faster than
a gazillion chords on the Eastman cutting machines.

Re: Sheet Metal Flat Patterns

vladimir_michl — Mon, 29 Jun 2020 15:02:34 GMT

If you want true material-based unfolding (incl. K-Factor, radius-restrictions, etc.), use Fusion 360 or Inventor. For purely geometrical (idealized) flat patterns of ruled surfaces, you can use the LISP utility UnfoldRS - see https://www.cadforum.cz/cadforum_en/unfoldrs-unfold-3d-surfaces-to-2d-in-autocad-tip12237

Vladimir Michl, www.cadstudio.cz - www.cadforum.cz

Re: Sheet Metal Flat Patterns

ademercan1 — Sun, 25 Jun 2023 15:53:58 GMT

(view in My Videos)

Re: Sheet Metal Flat Patterns

marko_ribar — Tue, 27 Jun 2023 02:01:04 GMT

I have in my hands something similar to @vladimir_michl , but it's different, but free...

If someone can find any benefit it'll be great...

So long from me, till now...

(defun c:unfoldrs ( / *error* tttt wcs initvalueslst ucsf ti rs 3dfs 3dfx dxf10 dxf11 dxf12 dxf13 2dxfs sort )

  (vl-load-com)

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (while (not (setq rs (car (entsel "\nPick rulesurface..."))))
    (prompt "\nMissed... Try again...")
  )
  (setq ti (car (_vl-times)))
  (setq 3dfs (mapcar 'vlax-vla-object->ename (safearray-value (variant-value (vla-explode (vlax-ename->vla-object rs))))))
  (foreach 3df 3dfs
    (setq dxf10 (cdr (assoc 10 (setq 3dfx (entget 3df)))))
    (setq dxf11 (cdr (assoc 11 3dfx)))
    (setq dxf12 (cdr (assoc 12 3dfx)))
    (setq dxf13 (cdr (assoc 13 3dfx)))
    (setq 2dxfs (list (car (setq sort (vl-sort (list dxf10 dxf11 dxf12 dxf13) '(lambda ( a b ) (< (caddr a) (caddr b)))))) (cadr sort)))
    (exe (list "_.UCS" "_ZA" "_non" (car 2dxfs) "_non" (cadr 2dxfs)))
    (exe (list "_.ROTATE" 3df "" "_non" (list 0.0 0.0) "_R" "_non" (list 0.0 0.0) "_non" (mapcar '+ '(0.0 0.0) (trans (caddr sort) 0 1)) "_non" (list 1e+10 0.0)))
    (exe (list "_.UCS" "_P"))
  )
  (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
  (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  (*error* nil)
)

Re: Sheet Metal Flat Patterns

marko_ribar — Fri, 30 Jun 2023 05:14:07 GMT

Here is my new revision... Something still is not like Vladimir's version, but I think that it should fit someone's needs...

(defun c:unfoldrs ( / *error* tttt unit acos angle3d drawlw cixci wcs initvalueslst ucsf ti rs 3dfs 3dfx dxf10 dxf11 dxf11n dxf12 dxf13 dxf13n dxf a a1 p0 p1 p11 p12 pa pb sa sb p2 p2l p3 lst s )

  (vl-load-com)

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (defun unit ( v / d )
    (if (not (equal (setq d (distance (list 0.0 0.0 0.0) v)) 0.0 1e-8))
      (mapcar
        (function (lambda ( x )
          (/ x d)
        ))
        v
      )
    )
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8) 0.0 )
      ( (equal x -1.0 1e-8) pi )
      ( (and
          (>= x 0.0)
          (equal x 0.0 1e-8)
        )
        (/ pi 2.0)
      )
      ( (and
          (<= x 0.0)
          (equal x -0.0 1e-8)
        )
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (sqrt (- 1.0 (* x x))) x)
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar (function -) p1 por)))
    (setq vec2 (unit (mapcar (function -) p2 por)))
    (setq dd (distance vec1 vec2))
    (setq ang (acos (- 1.0 (/ (expt dd 2) 2.0))))
    (if (minusp ang) (+ ang pi) ang)
  )

  (defun drawlw ( lst closed )
    (entmake
      (append
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 (length lst))
          (if closed
            (cons 70 (1+ (* 128 (getvar 'plinegen))))
            (cons 70 (* 128 (getvar 'plinegen)))
          )
          (cons 38 0.0)
        )
        (mapcar '(lambda ( p ) (cons 10 p)) lst)
        (list (list 210 0.0 0.0 1.0))
      )
    )
  )

  (defun cixci ( c1 r1 c2 r2 / d n z x )
    (setq d (distance c1 c2))
    (if (and (< d (+ r1 r2)) (< (abs (- r1 r2)) d))
      (if (/= d 0.0)
        (progn
          (setq n (mapcar (function -) c2 c1)
               c1 (trans c1 0 n)
               z (/ (- (+ (* r1 r1) (* d d)) (* r2 r2)) (+ d d))
               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)
          )
        )
      )
      (if (= d (+ r1 r2))
        (list (setq p (polar c1 (angle c1 c2) r1)) p)
      )
    )
  )

  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (while (not (setq rs (car (entsel "\nPick rulesurface..."))))
    (prompt "\nMissed... Try again...")
  )
  (setq ti (car (_vl-times)))
  (setq 3dfs (mapcar 'vlax-vla-object->ename (safearray-value (variant-value (vla-explode (vlax-ename->vla-object rs))))))
  (foreach 3df 3dfs
    (setq dxf10 (cdr (assoc 10 (setq 3dfx (entget 3df)))))
    (setq dxf11 (cdr (assoc 11 3dfx)))
    (setq dxf12 (cdr (assoc 12 3dfx)))
    (setq dxf13 (cdr (assoc 13 3dfx)))
    (if (and (not dxf11n) (not dxf13n))
      (progn
        (setq dxf11n (cdr (assoc 11 (setq dxf (entget (nth 1 3dfs))))))
        (setq dxf13n (cdr (assoc 13 dxf)))
      )
    )
    (setq a1 (rem (angle3d dxf13 dxf10 dxf11) pi))
    (if (not a)
      (setq a (angle dxf10 dxf13))
      (setq a (angle (cadr lst) (caddr lst)))
    )
    (if (not p0)
      (setq p0 (mapcar '+ (list 0.0 0.0) dxf10))
      (setq p0 (cadr lst))
    )
    (if (not p1)
      (progn
        (setq p11 (polar p0 (+ a a1) (distance dxf10 dxf11)))
        (setq p12 (polar p0 (- a a1) (distance dxf10 dxf11)))
        (setq pa (car (vl-sort (list p11 p12) '(lambda ( a b ) (< (distance a dxf11n) (distance b dxf11n))))))
        (setq pb (car (vl-sort (list p11 p12) '(lambda ( a b ) (< (distance a dxf13n) (distance b dxf13n))))))
        (if (equal pa p11 1e-6)
          (setq sa (function +))
          (setq sa (function -))
        )
        (if (equal pb p11 1e-6)
          (setq sb (function +))
          (setq sb (function -))
        )
        (if (not (equal sa sb))
          (if (> (abs (- (distance p11 dxf11n) (distance p12 dxf11n))) (abs (- (distance p11 dxf13n) (distance p12 dxf13n))))
            (setq s sa)
            (setq s sb)
          )
          (setq s sa)
        )
      )
    )
    (setq p1 (polar p0 (s a a1) (distance dxf10 dxf11)))
    (setq p3 (polar p0 a (distance dxf10 dxf13)))
    (setq p2l (cixci p1 (distance dxf11 dxf12) p3 (distance dxf12 dxf13)))
    (setq p2 (car p2l))
    (if (or (inters p0 p1 p2 p3) (inters p1 p2 p3 p0))
      (setq p2 (car (vl-remove p2 p2l)))
    )
    (drawlw (setq lst (list p0 p1 p2 p3)) t)
    (entdel 3df)
  )
  (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
  (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  (*error* nil)
)

HTH.

M.R.

Re: Sheet Metal Flat Patterns

marko_ribar — Thu, 29 Jun 2023 04:30:51 GMT

@vladimir_michl

Can you please provide us your DWG for comparison, or check my latest code for comparation and reply with some info on what is different and what are lacks of my code if there are some...

Thanks, M.R.

Re: Sheet Metal Flat Patterns

vladimir_michl — Thu, 29 Jun 2023 05:20:51 GMT

Fortunately I still have the sample DWG used in the video and for the development of UnfoldRS - here it is:

https://www.cadforum.cz/catalog_en/block.asp?blk=22638

Calculation of the resulting faces is different in UnfoldRS but the overall result should be similar.

Vladimir Michl, www.arkance-systems.cz - www.cadforum.cz

Re: Sheet Metal Flat Patterns

marko_ribar — Thu, 29 Jun 2023 05:40:42 GMT

Many thanks,

Nothing more to say... I'll check DWG...

Re: Sheet Metal Flat Patterns

caominhnguyen85 — Sun, 29 Sep 2024 15:38:12 GMT

Could you upload the lisp? thank you !

Re: Sheet Metal Flat Patterns

caominhnguyen85 — Sun, 29 Sep 2024 15:40:54 GMT

Could you help to upload this autolsip file . Thank you ! I really need it