Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

superflatten lisp

16 REPLIES 16
Reply
Message 1 of 17
dvir860
8724 Views, 16 Replies

superflatten lisp

I have a lip that flattens the drawing to z=0.
I want the Lisp to be set to run automatically on all drawing (without having to manually select elements) and not to open a SuperFlatten options dialog.
What do I need to change or add to the code to do this?

16 REPLIES 16
Message 2 of 17
pendean
in reply to: dvir860

Google Search offers lots of answers including this one http://www.lee-mac.com/autoloading.html



Message 3 of 17
dvir860
in reply to: pendean

The link you have attached shows how to load lisps and this I know how. I asked about editing the code.

Message 4 of 17
ronjonp
in reply to: dvir860

Download the latest version HERE. Not sure if there is a command line call though.

Message 5 of 17
dvir860
in reply to: dvir860

I didn't found solution to my problem. Is anybody know what I need to change in the code that it will solve my problem?

Message 6 of 17
dlanorh
in reply to: dvir860

It would be pointless altering the superflatten code to do what you want. Try this snippet.

 

(defun rh:saeou (o / lst)
  (setq lst (list (list 0.0 0.0 0.0) (list 0.0 0.0 1.0e99) (list 0.0 0.0 1.0e-99) (list 0.0 0.0 0.0)))
  (while (> (length lst) 1)
    (vlax-invoke o 'move (car lst) (cadr lst))
    (setq lst (cdr lst))
  );end_while
);end_defun

(vl-load-com)

(defun c:flatdwg ( / ss cnt)
  (setq ss (ssget "_X"))
  (cond (ss
          (princ "Flattening Drawing. Please Wait.")
          (repeat (setq cnt (sslength ss))
            (rh:saeou (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
          );end_repeat
        )
        (t (alert "Nothing Found"))
  );end_cond
  (princ)
);end_defun

(c:flatdwg)
(princ)

 

It should run when loaded.

 

See HERE for options on how/where to place it.

I am not one of the robots you're looking for

Message 7 of 17
dvir860
in reply to: dlanorh

Your lisp isn't flat elements that into blocks.

Message 8 of 17
diagodose2009
in reply to: dvir860

You make a demo.Avi  .

Can you test this programe flatthen.lsp with many capture-picture BeforeXX.Jpg and AfterXX.JPg..? I need a demo Video , . You put this Video to youtube.com/your-account

 

Message 9 of 17
dlanorh
in reply to: dvir860


@dvir860 wrote:

Your lisp isn't flat elements that into blocks.


What type of blocks? xrefs? dynamic? static? 

I am not one of the robots you're looking for

Message 10 of 17
dvir860
in reply to: dlanorh

I meant that your lisp is not the same as mine because the lisp does indeed surface elements to Z = 0 but does not surface elements within the blocks so it does not help me what you attached.
I'ne interested in using my lisp but without having to manually select elements and not to open a SuperFlatten options dialog.

Message 11 of 17
dlanorh
in reply to: dvir860

And my question was in what type of blocks do you want the elements flattened, bearing in mind that flattening 3d dynamic blocks will probably break them.

I am not one of the robots you're looking for

Message 12 of 17
john.uhden
in reply to: dvir860

Try this one adapted from an oldie of mine...

(defun c:FlattenAll ( / *error* vars vals @flatten cmd ss i n e0 e ent etyp fixed)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                           *
   ;*         FlattenAll.LSP by John F. Uhden                                   *
   ;*                           2 Village Road                                  *
   ;*                           Sea Girt, NJ  08750                             *
   ;*                                                                           *
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   ;; Changes the Z value or 38 code to 0.0 for all  objects, including
   ;; their subentities such as heavy vertices and attributes.
   ;; Locked layer checking removed.

   ; v1.0 (8-27-99)
   ; v15.00 (04-07-00) for R15

   (gc)
   (vl-load-com)
   (princ "FlattenAll (c)1999-2020, John F. Uhden\n")
   (princ "Adapted from Z0.lsp (c)1999-2000\n")

   (defun *error* (error)
     (mapcar 'setvar vars vals)
     (vla-endundomark *doc*)
     (cond
       ((not error))
       ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
       (1 (princ (strcat "\nERROR: " error)))
     )
     (princ)
   )
   (setq vars '(cmdecho))
   (setq vals (mapcar 'getvar vars))
   (or *acad* (setq *acad* (vlax-get-acad-object)))
   (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
   (vla-endundomark *doc*)
   (vla-startundomark *doc*)
   (mapcar 'setvar vars '(0))
   (command "_.expert" (getvar "expert")) ;; dummy command

   ;;--------------------------------------------------------------------
   ;; Function to dig into each entity or subentity and change either its
   ;; 10, 11, 12, 13, or 38 code to 0.0:
   ;;
   (defun @flatten (ent / new)
      (foreach item ent
         (cond
            ((and (= (car item) 38)(/= (cdr item) 0.0))
               (setq new (cons 38 0.0)
                     ent (subst new item ent)
               )
            )
            ((and (/= etyp "LWPOLYLINE")(vl-position (car item) '(10 11 12 13))
                  (not (atom (cdr item)))
                  (> (length item) 3)
                  (/= (last item) 0.0))
               (setq new (reverse (cons 0.0 (cdr (reverse item))))
                     ent (subst new item ent)
               )
            )
         )
      )
      (setq fixed (or fixed new))
      (if new (entmod ent))
   )

   (setq i 0 N 0)
   (vlax-for block (vlax-get *doc* 'blocks)
     (vlax-for obj block
        (prompt (strcat "\rProcessing # " (rtos (1+ i) 2 0)))
        (setq e0 (vlax-vla-object->ename obj)
                   e  e0
                   ent (entget e)
                   etyp (cdr (assoc 0 ent))
                   fixed nil
                   i (1+ i)
        )
        (if (assoc 66 ent)
           (while (/= (cdr (assoc 0 ent)) "SEQEND")
              (@flatten ent)
              (setq e (entnext e) ent (entget e))
           )
           (@flatten ent)
        )
        (if fixed
           (progn
              (entupd e0)
              (setq n (1+ n))
           )
        )
     )
   )
   (prompt (strcat "\nChanged " (rtos n 2 0) " objects to elevation 0."))
   (*error* nil)
)
(defun c:FA ()(c:FlattenAll))

John F. Uhden

Message 13 of 17
john.uhden
in reply to: john.uhden

I didn't like the name, so it is now SQUASH.

(defun c:SQUASH ( / *error* vars vals @Anonymous ss i n e0 e ent etyp squashed)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                                               *
   ;*         SQUASH.LSP   by John F. Uhden                      *
   ;*                                             2 Village Road                      *
   ;*                                            Sea Girt, NJ  08750              *
   ;*                                                                                               *
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   ;; Changes the Z value or 38 code to 0.0 for all  objects, including
   ;; their subentities such as heavy vertices and attributes.
   ;; Locked layer checking removed.

   ; v1.0 (8-27-99)
   ; v15.00 (04-07-00) for R15
   ; v??.0  (8-31-2020) renamed from FlattenAll.lsp

   (gc)
   (vl-load-com)
   (princ "Squash (c)1999-2020, John F. Uhden\n")
   (princ "Adapted from Z0.lsp (c)1999-2000\n")

   (defun *error* (error)
     (mapcar 'setvar vars vals)
     (vla-endundomark *doc*)
     (cond
       ((not error))
       ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
       (1 (princ (strcat "\nERROR: " error)))
     )
     (princ)
   )
   (setq vars '(cmdecho))
   (setq vals (mapcar 'getvar vars))
   (or *acad* (setq *acad* (vlax-get-acad-object)))
   (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
   (vla-endundomark *doc*)
   (vla-startundomark *doc*)
   (mapcar 'setvar vars '(0))
   (command "_.expert" (getvar "expert")) ;; dummy command

   ;;--------------------------------------------------------------------
   ;; Function to dig into each entity or subentity and change either its
   ;; 10, 11, 12, 13, or 38 code to 0.0:
   ;;
   (defun @Anonymous (ent / new)
      (foreach item ent
         (cond
            ((and (= (car item) 38)(/= (cdr item) 0.0))
               (setq new (cons 38 0.0)
                     ent (subst new item ent)
               )
            )
            ((and (/= etyp "LWPOLYLINE")(vl-position (car item) '(10 11 12 13))
                  (not (atom (cdr item)))
                  (> (length item) 3)
                  (/= (last item) 0.0))
               (setq new (reverse (cons 0.0 (cdr (reverse item))))
                     ent (subst new item ent)
               )
            )
         )
      )
      (setq squashed (or squashed new))
      (if new (entmod ent))
   )

   (setq i 0 N 0)
   (vlax-for block (vlax-get *doc* 'blocks)
     (vlax-for obj block
        (prompt (strcat "\rProcessing # " (rtos (1+ i) 2 0)))
        (setq e0 (vlax-vla-object->ename obj)
                   e  e0
                   ent (entget e)
                   etyp (cdr (assoc 0 ent))
                   squashed nil
                   i (1+ i)
        )
        (if (assoc 66 ent)
           (while (/= (cdr (assoc 0 ent)) "SEQEND")
              (@squash ent)
              (setq e (entnext e) ent (entget e))
           )
           (@squash ent)
        )
        (if squashed
           (progn
              (entupd e0)
              (setq n (1+ n))
           )
        )
     )
   )
   (prompt (strcat "\nSquashed " (rtos n 2 0) " objects to elevation 0."))
   (*error* nil)
)
(defun c:SQ ()(c:Squash))

John F. Uhden

Message 14 of 17

Thank you very much John
Message 15 of 17

hi, in my case i neet to keep the blocks but in some case the block is exploded,  I'll shere the picture and dwg. Can you help me?

Message 16 of 17

@silvestresallesjunior4 ,

Have you tried my SQUASH program?  It can easily be made to run automatically on start-up with every drawing.  No user input is required.

John F. Uhden

Message 17 of 17
bhoomika66Q5H
in reply to: dvir860

TOTALLY WORKED FOR ME

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report