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?
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?
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
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
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.
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
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
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
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?
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
Can't find what you're looking for? Ask the community or share your knowledge.