Help with flatten in routine lsp

[leonucadomi]

hello friends

 

I would like to use the flatten command within an lsp but it doesn't work.

 

i wrote this

 

(defun c:test (/ )

(command "FLATTEN")

);fin defun

 

 

my purpose is to convert solids to 2d objects automatically without dialog box

 

[tombu]

The FLATTEN command only changes Z property values to 0. You would have better luck with the FLATSHOT command for a solid.

FLATTEN.lsp doesn't autoload or run like that in lisp.

Try:

(defun c:test (/ )
  (load "Flatten.lsp")
  (command "c:flatten")
);fin defun

 

 

[leonucadomi]

1 hour ago, tombu said:

 

 

thanks but don't run it ,  

 

originally used flatshot 

but I would like to use it without a dialog box and I think it is not possible

what I'm looking for is to cut my way

[dan20047]

try version below, also https://www.theswamp.org/index.php?topic=18153.0

 

;;; FLATTEN.LSP version 2k.01f, 14-Jul-2000
;;;
;;; FLATTEN sets the Z-coordinates of these types of objects to 0
;;; in the World Coordinate System:
;;;  "3DFACE" "ARC" "ATTDEF" "CIRCLE" "DIMENSION" 
;;;  "ELLIPSE" "HATCH" "INSERT" "LINE" "LWPOLYLINE"
;;;  "MTEXT" "POINT" "POLYLINE" "SOLID" "TEXT"
;;;
;;;-----------------------------------------------------------------------
;;; copyright 1990-2000 by Mark Middlebrook
;;;   Daedalus Consulting
;;;   e-mail: mark@markcad.com
;;;
;;; Before you e-mail me with support questions, please make sure that
;;; you're using the current version. You can download it from
;;; http://markcad.com.
;;;
;;; This program is free software. You can redistribute it and/or modify 
;;; it under the terms of the GNU General Public License as published by 
;;; the Free Software Foundation: http://www.gnu.org/copyleft/gpl.html. 
;;;
;;; Thanks to Vladimir Livshiz for improvements in polyline handling
;;; and the addition of several other object types.
;;;
;;;-----------------------------------------------------------------------
;;; Revision history
;;;  v. 2k.0   25-May-1999  First release for AutoCAD 2000.
;;;  v. 2k.01  25-Jun-1999  Fixed two globalization bugs ("_World" & "_X")
;;;                         and revised error handler.
;;;  v. 2k.01f 14-Jul-1999  Added GNU GPL and download info to header.
;;;
;;;-----------------------------------------------------------------------
;;;*Why Use FLATTEN?
;;;
;;; FLATTENing is useful in at least two situations:
;;;  1) You receive a DXF file created by another CAD program and discover
;;;     that all the Z coordinates contain small round-off errors. These
;;;     round-off errors can prevent you from object snapping to
;;;     intersections and make your life difficult in other ways as well.
;;;  2) In a supposedly 2D drawing, you accidentally create one object with
;;;     a Z elevation and end up with a drawing containing objects partly
;;;     in and partly outside the Z=0 X-Y plane. As with the round-off
;;;     problem, this situation can make object snaps and other procedures
;;;     difficult.
;;;
;;; Warning: FLATTEN is not for flattening the custom objects created by
;;; applications such as Autodesk's Architectural Desktop. ADT and similar
;;; programs create "application-defined objects" that only the
;;; application really knows what to do with. FLATTEN has no idea how
;;; to handle application-defined objects, so it leaves them alone.
;;;
;;;-----------------------------------------------------------------------
;;;*How to Use FLATTEN
;;;
;;; This version of FLATTEN works with AutoCAD R12 through 2000.
;;;
;;; To run FLATTEN, load it using AutoCAD's APPLOAD command, or type:
;;;   (load "FLATTEN")
;;; at the AutoCAD command prompt. Once you've loaded FLATTEN.LSP, type:
;;;   FLATTEN
;;; to run it. FLATTEN will tell you what it's about to do and ask you
;;; to confirm that you really want to flatten objects in the current
;;; drawing. If you choose to proceed, FLATTEN prompts you to select objects
;;; to be flattened (press ENTER to flatten all objects in the drawing).
;;; After you've selected objects and pressed ENTER, FLATTEN goes to work.
;;; It reports the number of objects it flattens and the number left
;;; unflattenened (because they were objects not recognized by FLATTEN; see 
;;; the list of supported objects above).
;;;
;;; If you don't like the results, just type U to undo FLATTEN's work.
;;;
;;;-----------------------------------------------------------------------
;;;*Known limitations
;;;  1) FLATTEN doesn't support all of AutoCAD's object types. See above
;;;     for a list of the object types that it does work on.
;;;  2) FLATTEN doesn't flatten objects nested inside of blocks.
;;;     (You can explode blocks before flattening. Alternatively, you can
;;;     WBLOCK block definitions to separate DWG files, run FLATTEN in
;;;     each of them, and then use INSERT in the parent drawing to update
;;;     the block definitions. Neither of these methods will flatten
;;;     existing attributes, though.
;;;  3) FLATTEN flattens objects onto the Z=0 X-Y plane in AutoCAD's
;;;     World Coordinate System (WCS). It doesn't currently support
;;;     flattening onto other UCS planes.
;;;
;;;=======================================================================

(defun C:FLATTEN (/       tmpucs  olderr  oldcmd  zeroz   ss1     ss1len
                  i       numchg  numnot  numno0  ssno0   ename   elist
                  etype   yorn    vrt     crz
                 )
  (setq tmpucs "$FLATTEN-TEMP$")        ;temporary UCS

  ;;Error handler
  (setq olderr *error*)
  (defun *error* (msg)
    (if (or
          (= msg "Function cancelled")
          (= msg "quit / exit abort")
        )
      ;;if user cancelled or program aborted, exit quietly
      (princ)
      ;;otherwise report error message
      (princ (strcat "\nError: " msg))
    )
    (setq *error* olderr)
    (if (tblsearch "UCS" tmpucs)
      (command "._UCS" "_Restore" tmpucs "._UCS" "_Delete" tmpucs)
    )
    (command "._UNDO" "_End")
    (setvar "CMDECHO" oldcmd)
    (princ)
  )

  ;;Function to change Z coordinate to 0

  (defun zeroz (key zelist / oplist nplist)
    (setq oplist (assoc key zelist)
          nplist (reverse (append '(0.0) (cdr (reverse oplist))))
          zelist (subst nplist oplist zelist)
    )
    (entmod zelist)
  )
  ;;Setup
  (setq oldcmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._UNDO" "_Group")
  (command "._UCS" "_Delete" tmpucs "._UCS" "_Save" tmpucs "._UCS" "_World")
                                        ;set World UCS

  ;;Get input
  (prompt
    (strcat
      "\nFLATTEN sets the Z coordinates of most objects to zero."
    )
  )

  (initget "Yes No")
  (setq yorn (getkword "\nDo you want to continue <Y>: "))
  (cond ((/= yorn "No")
         (graphscr)
         (prompt "\nChoose objects to FLATTEN ")
         (prompt
           "[press return to select all objects in the drawing]"
         )
         (setq ss1 (ssget))
         (if (null ss1)                 ;if enter...
           (setq ss1 (ssget "_X"))      ;select all entities in database
         )


         ;;*initialize variables
         (setq ss1len (sslength ss1)    ;length of selection set
               i      0                 ;loop counter
               numchg 0                 ;number changed counter
               numnot 0                 ;number not changed counter
               numno0 0                 ;number not changed and Z /= 0 counter
               ssno0  (ssadd)           ;selection set of unchanged entities
         )                              ;setq

         ;;*do the work
         (prompt "\nWorking.")
         (while (< i ss1len)            ;while more members in the SS
           (if (= 0 (rem i 10))
             (prompt ".")
           )
           (setq ename (ssname ss1 i)   ;entity name
                 elist (entget ename)   ;entity data list
                 etype (cdr (assoc 0 elist)) ;entity type
           )

           ;;*Keep track of entities not flattened
           (if (not (member etype
                            '("3DFACE"     "ARC"        "ATTDEF"
                              "CIRCLE"     "DIMENSION"  "ELLIPSE"
                              "HATCH"      "INSERT"     "LINE"
                              "LWPOLYLINE" "MTEXT"      "POINT"
                              "POLYLINE"   "SOLID"      "TEXT"
                             )
                    )
               )
             (progn                     ;leave others alone
               (setq numnot (1+ numnot))
               (if (/= 0.0 (car (reverse (assoc 10 elist))))
                 (progn                 ;add it to special list if Z /= 0
                   (setq numno0 (1+ numno0))
                   (ssadd ename ssno0)
                 )
               )
             )
           )

           ;;Change group 10 Z coordinate to 0 for listed entity types.
           (if (member etype
                       '("3DFACE"    "ARC"       "ATTDEF"    "CIRCLE"
                         "DIMENSION" "ELLIPSE"   "HATCH"     "INSERT"
                         "LINE"      "MTEXT"     "POINT"     "POLYLINE"
                         "SOLID"     "TEXT"
                        )
               )
             (setq elist  (zeroz 10 elist) ;change entities in list above
                   numchg (1+ numchg)
             )
           )

           ;;Change group 11 Z coordinate to 0 for listed entity types.
           (if (member etype
                       '("3DFACE" "ATTDEF" "DIMENSION" "LINE" "TEXT" "SOLID")
               )
             (setq elist (zeroz 11 elist))
           )

           ;;Change groups 12 and 13 Z coordinate to 0 for SOLIDs and 3DFACEs.
           (if (member etype '("3DFACE" "SOLID"))
             (progn
               (setq elist (zeroz 12 elist))
               (setq elist (zeroz 13 elist))
             )
           )

           ;;Change groups 13, 14, 15, and 16
           ;;Z coordinate to 0 for DIMENSIONs.
           (if (member etype '("DIMENSION"))
             (progn
               (setq elist (zeroz 13 elist))
               (setq elist (zeroz 14 elist))
               (setq elist (zeroz 15 elist))
               (setq elist (zeroz 16 elist))
             )
           )

           ;;Change each polyline vertex Z coordinate to 0.
           ;;Code provided by Vladimir Livshiz, 09-Oct-1998
           (if (= etype "POLYLINE")
             (progn
               (setq vrt ename)
               (while (not (equal (cdr (assoc 0 (entget vrt))) "SEQEND"))
                 (setq elist (entget (entnext vrt)))
                 (setq crz (cadddr (assoc 10 elist)))
                 (if (/= crz 0)
                   (progn
                     (zeroz 10 elist)
                     (entupd ename)
                   )
                 )
                 (setq vrt (cdr (assoc -1 elist)))
               )
             )
           )

           ;;Special handling for LWPOLYLINEs
           (if (member etype '("LWPOLYLINE"))
             (progn
               (setq elist  (subst (cons 38 0.0) (assoc 38 elist) elist)
                     numchg (1+ numchg)
               )
               (entmod elist)
             )
           )

           (setq i (1+ i))              ;next entity
         )
         (prompt " Done.")

         ;;Print results
         (prompt (strcat "\n" (itoa numchg) " object(s) flattened."))
         (prompt
           (strcat "\n" (itoa numnot) " object(s) not flattened.")
         )

         ;;If there any entities in ssno0, show them
         (if (/= 0 numno0)
           (progn
             (prompt (strcat "  ["
                             (itoa numno0)
                             " with non-zero base points]"
                     )
             )
             (getstring
               "\nPress enter to see non-zero unchanged objects... "
             )
             (command "._SELECT" ssno0)
             (getstring "\nPress enter to unhighlight them... ")
             (command "")
           )
         )
        )
  )

  (command "._UCS" "_Restore" tmpucs "._UCS" "_Delete" tmpucs)
  (command "._UNDO" "_End")
  (setvar "CMDECHO" oldcmd)
  (setq *error* olderr)
  (princ)
)

(prompt
  "\nFLATTEN version 2k.01f loaded.  Type FLATTEN to run it."
)
(princ)

;;;eof

 

Edited June 29, 2021 by dan20047

[Tharwat]

I have my own Flatten program HERE but its not free.  

 

Edited June 29, 2021 by Tharwat

[w64bit]

Can anyone please add this code to FLATTEN.LSP 2k.01f.

(defun C:MLzero (/ SelectionSet i mlEname ml)
  (setq SelectionSet (ssget "_X" '((0 . "MULTILEADER"))))
  (repeat (setq i (sslength SelectionSet))
    (setq mlEname (ssname SelectionSet (setq i (1- i))))
    (if (/= 0 (last (assoc 10 (setq ml (entget mlEname)))))
      (entmod (mapcar '(lambda (x) (if (member (car x) '(10 12 110))(list (car x) (cadr x) (caddr x) 0.0) x))(entget mlEname '("*"))))
    )
  )
  (princ)
)

I tried but it's not working when run modified FLATTEN inside a block (opened with BEDIT).

Thank you

 

[Jonathan Handojo]

4 hours ago, w64bit said:

Can anyone please add this code to FLATTEN.LSP 2k.01f.

(defun C:MLzero (/ SelectionSet i mlEname ml)
  (setq SelectionSet (ssget "_X" '((0 . "MULTILEADER"))))
  (repeat (setq i (sslength SelectionSet))
    (setq mlEname (ssname SelectionSet (setq i (1- i))))
    (if (/= 0 (last (assoc 10 (setq ml (entget mlEname)))))
      (entmod (mapcar '(lambda (x) (if (member (car x) '(10 12 110))(list (car x) (cadr x) (caddr x) 0.0) x))(entget mlEname '("*"))))
    )
  )
  (princ)
)

I tried but it's not working when run modified FLATTEN inside a block (opened with BEDIT).

Thank you

 

I don't know if this works any better, but at least for my work, it seems to be okay. Reason being is I did some experiments on DXF codes mostly dealt when using AutoCAD, so these are the codes that mostly deal with points.

(defun c:z0 (/ i ss)
    (if (setq ss (ssget "_:L")) 
        (repeat (setq i (sslength ss)) 
            (entmod 
                (mapcar 
                    (function 
                        (lambda (a) 
                            (if 
                                (member (car a) 
                                    '(10 11 12 13 14 15 16 17 18 20 21 22 23 24 
                                    25 26 27 28 31 32 32 33 34 35 36 37
                                    )
                                )
                                (list (car a) (cadr a) (caddr a) 0.0)
                                a
                            )
                        )
                    )
                    (entget (ssname ss (setq i (1- i))))
                )
            )
        )
    )
    (princ)
)

[w64bit]

Thank you, but in my case z0 it does not fix all objects. FLATTEN.lsp is fixing them all, except MULTILEADER.

That's why I tried to "improve" FLATTEN.

Is there any way to add MLzero to FLATTEN and make it to work inside a block also?

 

[w64bit]

More testing z0 resulted that these entities are not "fixed":

POLYLINE

ATTRIBUTE BLOCK

 

Edited February 25, 2022 by w64bit

[w64bit]

ATTRIBUTE BLOCK fixed by adding:

(if (ssget "_X" '((0 . "INSERT") (66 . 1)))(command "ATTSYNC" "N" "*"))

 

 

Edited February 27, 2022 by w64bit

[w64bit]

For LWPOLYLINE it seems to be related with DXF Group Code 38.

FLATTEN.LSP has it in  "Special handling for LWPOLYLINEs".

I added 38 to the groups in your code but not working for LWPOLYLINE.

Edited February 25, 2022 by w64bit

[marko_ribar]

This can be helpful...

I don't have a time to reply exatly...

You should get used to understand something on your own...

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/transform-points-from-lwpolyline-with-entmod/m-p/10334388/highlight/true#M415429

[w64bit]

I think I make it to work.

 

(defun C:ZERO (/       zeroz   ss1     ss1len
               i       numchg  ename   elist
               etype   vrt     crz     ss2
              )

  ;;Function to change Z coordinate to 0
  (defun zeroz (key zelist / oplist nplist)
    (setq oplist (assoc key zelist)
          nplist (reverse (append '(0.0) (cdr (reverse oplist))))
          zelist (subst nplist oplist zelist)
    )
    (entmod zelist)
  )

  (setvar "CMDECHO" 0)
  (command ".UNDO" "Group")             ;start undo group

  ;;Get input
  (setq ss1 (ssget "X"))                ;select all entities in database

         ;;*initialize variables
         (setq ss1len (sslength ss1)    ;length of selection set
               i      0                 ;loop counter
               numchg 0                 ;number changed counter
         )                              ;setq

         ;;*do the work
         (prompt "\nZERO Working.")
         (while (< i ss1len)            ;while more members in the SS
           (if (= 0 (rem i 10))
             (prompt ".")
           )
           (setq ename (ssname ss1 i)   ;entity name
                 elist (entget ename)   ;entity data list
                 etype (cdr (assoc 0 elist)) ;entity type
           )

           ;;change each polyline vertex Z coordinate to 0
           ;;code provided by Vladimir Livshiz, 09-Oct-1998
           (if (= etype "POLYLINE")
             (progn
               (setq vrt ename)
               (while (not (equal (cdr (assoc 0 (entget vrt))) "SEQEND"))
                 (setq elist (entget (entnext vrt)))
                 (setq crz   (cadddr (assoc 10 elist)))
                 (if (/= crz 0)
                   (progn
                     (zeroz 10 elist)
                     (entupd ename)
                   )
                 )
                 (setq vrt (cdr (assoc -1 elist)))
               )
             )
           )

           ;;special handling for LWPOLYLINEs
           (if (= etype "LWPOLYLINE")
             (progn
               (setq elist  (subst (cons 38 0.0) (assoc 38 elist) elist)
                     numchg (1+ numchg)
               )
               (entmod elist)
             )
           )

           (setq i (1+ i))              ;next entity

  )

        ;; ZERO
  (if (setq ss2 (ssget "X"))
      (repeat (setq i (sslength ss2))
          (entmod
              (mapcar
                  (function
                      (lambda (a)
                          (if
                              (member (car a)
                                  '(10 11 12 13 14 15 16 17 18
                                    20 21 22 23 24 25 26 27 28
                                    30 31 32 33 34 35 36 37)
                              )
                              (list (car a) (cadr a) (caddr a) 0.0)
                              a
                          )
                      )
                  )
                  (entget (ssname ss2 (setq i (1- i))))
              )
          )
      )
  )

  (terpri)
  (if (ssget "X" '((0 . "INSERT") (66 . 1)))(command "ATTSYNC" "N" "*"))
  (command "REGEN")

  (command ".UNDO" "End")             ;end undo group

  (terpri)
  (prompt "\nZERO Done.")
  (terpri)

(princ)

)

 

It seems that this is all I can do (I am new to LISP).

Can anyone please help to slim down the code by take a look over the code and replacing ss1 + ss2 with a single ss?

Thank you.

Edited February 27, 2022 by w64bit

[BIGAL]

You dont need ss2 just work on ss1, you need more if's (if  (= etype "LINE") mod dxf 10 & 11  (if  (= etype "ARC") mod dxf 10  (if  (= etype "CIRCLE") mod dxf 10 need to look at all objects.

[w64bit]

Added missing coders.

Removed ss2.

Because I am trying to obtain a slimmer code, I avoided more if's.

Missing code for:

- flattening REGION;

- changing OLE Z coordinate to zero.

 

(defun C:ZERO (/       zeroz   ss1     ss1len
               i       numchg  ename   elist
               etype   vrt     crz
              )

;Function to change Z coordinate to 0
(defun zeroz (key zelist / oplist nplist)
  (setq oplist (assoc key zelist)
        nplist (reverse (append '(0.0) (cdr (reverse oplist))))
        zelist (subst nplist oplist zelist)
  )
  (entmod zelist)
)

;Initialization
(setvar  "CMDECHO" 0)                   ;no prompts and inputs displayed on command line
(command ".UCS" "World")               ;set World UCS
(command ".UNDO" "Group")              ;start undo group

;Get input
(setq ss1 (ssget "X"))                 ;select all entities in database

  ;*initialize variables
  (setq ss1len (sslength ss1)          ;length of selection set
        i      0                       ;loop counter
        numchg 0                       ;number changed counter
  )                                    ;setq

  ;*do the work
  (prompt "\nZERO Working.")
  (while (< i ss1len)                  ;while more members in the SS
    (if (= 0 (rem i 10))
      (prompt ".")
    )
    (setq ename (ssname ss1 i)         ;entity name
          elist (entget ename)         ;entity data list
          etype (cdr (assoc 0 elist))  ;entity type
    )

    ;change each POLYLINE vertex Z coordinate to 0
    ;code provided by Vladimir Livshiz, 1998_10_09
    (if (= etype "POLYLINE")
      (progn
        (setq vrt ename)
        (while (not (equal (cdr (assoc 0 (entget vrt))) "SEQEND"))
          (setq elist (entget (entnext vrt)))
          (setq crz   (cadddr (assoc 10 elist)))
          (if (/= crz 0)
            (progn
              (zeroz 10 elist)
              (entupd ename)
            )
          )
          (setq vrt (cdr (assoc -1 elist)))
        )
      )
    )

    ;special handling for LWPOLYLINE
    ;code provided by Mark Middlebrook
    (if (= etype "LWPOLYLINE")
      (progn
        (setq elist  (subst (cons 38 0.0) (assoc 38 elist) elist)
              numchg (1+ numchg)
        )
        (entmod elist)
      )
    )

  (setq i (1+ i))                      ;next entity

)

  ;ZERO the rest
  ;code provided by Jonathan Handojo, 2022_02_23
  (repeat (setq i (sslength ss1))
    (entmod
      (mapcar
        (function
          (lambda (a)
            (if
              (member (car a)
                  '(10 11 12 13 14 15 16 17 18
                    20 21 22 23 24 25 26 27 28
                    30 31 32 33 34 35 36 37)
              )
              (list (car a) (cadr a) (caddr a) 0.0)
              a
            )
          )
        )
        (entget (ssname ss1 (setq i (1- i))))
      )
    )
  )

(terpri)
(if (ssget "X" '((0 . "INSERT") (66 . 1)))(command "ATTSYNC" "N" "*"))
(command "REGEN")

(command ".UNDO" "End")                ;end undo group

(terpri)
(prompt "\nZERO Done.")
(terpri)

(princ)

)

 

Edited February 27, 2022 by w64bit