All Activity

You haven't defined "arrowAng" variable and you are using it in (polar) function...

(defun C:SECTIONLINE ( / pt1 pt2 dirpt baseAngle dirAngle angle arrowLen arrowAng secLetter txtpt angleDeg p1 p2 ) (setq arrowLen 10.0) (setq arrowAng (/ pi 6.0)) (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not (and pt1 (listp pt1))) (progn (princ "\nCanceled or invalid first point.") (quit)) ) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not (and pt2 (listp pt2))) (progn (princ "\nCanceled or invalid second point.") (quit)) ) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not (and dirpt (listp dirpt))) (progn (princ "\nCanceled or invalid direction point.") (quit)) ) (setq baseAngle (angle pt1 pt2)) (setq dirAngle (angle pt1 dirpt)) (setq angle (if (< (abs (- baseAngle dirAngle)) (/ pi 2.0)) baseAngle (+ baseAngle pi))) (command "._LINE" "_non" pt1 "_non" pt2 "") (setq p1 (polar pt1 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt1 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt1 "_non" p1 "") (command "._LINE" "_non" pt1 "_non" p2 "") (setq p1 (polar pt2 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt2 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt2 "_non" p1 "") (command "._LINE" "_non" pt2 "_non" p2 "") (setq secLetter (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLetter "") (setq secLetter "A")) (if (and (listp pt1) (listp pt2)) (progn (setq txtpt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)) (setq angleDeg (* 180.0 (/ angle pi))) (command "._TEXT" "_non" txtpt 2.5 angleDeg (strcat secLetter "-" secLetter)) ) (princ "\nText not placed due to invalid points.") ) (princ "\nSection line created successfully.") (princ) ) I have this error (I use ZWCAD) Command: SECTIONLINE Select first point of section line: Select second point of section line: Pick a point to define section direction: Error: undefined function - nil Thanks

I am searching for a lisp code to draw a section line like the test.dwg. 1) Select 2 points for the length of the section 2) Pick a point for the direction of the section 3) Draw section line with the arrows and ask for the section letter for exampl A,B Thanks TEST.dwg

Then something wasn't created or modified. aka trying to exploding a invalid or corrupted region, or one that is on a locked layer. maybe run audit and purge before and then check if entity is on a locked layers. -Edit Writing lisp isn't the hard part. figuring out all the different things that could go wrong and how to handle that is the hard part. had a user that would always select things with the crossing selection option(bottom right to top left) and complain about how my lisp was picking up things "outside" what they where selecting.

I found it making a google research is at: https://sites.google.com/site/cadkits/home/chz20 And I don't know if this is of some help

Hi, I need some help in changing the line/edge colour of a 200mm. wall in revit. I want the line to appear red in contrast to other wall line colout to emphasize its size. I have been able to change the hatching to red but I am currently unable to change the link thickness. it seemed much easier in other newer version but 2019 it is almost impossible from my point of view. Thanks in advance for your help.

There is a CHZ20.vlx around somewhere, I do not recall everything it does or how fast it would be. What exactly is the time on a basic drawing? As mentioned, cannot really tell any specific issues without the full LISP. I have noticed FLATTEN actually can take a long time on a drawing with lots of objects, even if it is completely z=0 already. FLATTEN and FLATSHOT are mostly useless, IMHO. I would start with just a simple z=0 LISP, then run different LISPs to specifically target other objects like Regions and Blocks. I am not sure if the arc issue have ever been solved, you may have to look around and see. Can you post a sample drawing?

I managed to fix this problem using AI. I don't know how to write Lisp myself. Wpipe test.lsp

That's strange, in my testing it works as I expected. Are you able to post a sample drawing with an arc that rotates? Going to look at the other object types sometime today for you. There is a list at the top of 'Flatten Lines' that work at the moment for info.

my code was like this but sometimes lastent didnt work so ı changed.

and tred this code but rotated arces move y axis so drawing broken. anda also need this objtype;

thanks @Steven P. ı added and its work but ı dont sure more faster than previous

Hi Bigal, Could you help me with this error?, thanks in advance Command: CONC1 (600 600 50 12 12 12 12 4 4 2 2 10) Pick lower left pt ; error: AutoCAD rejected function: invalid table function argument(s): "Layers" "BEAM"

Hi, Here is a code that projected simples entities : POLYLINE,LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,POINT. on the SCG at a Z-coordinate to zero if as the entities of start are in a UCS parallel or not. For example, a circle in a UCS non-parallel will become an ellipse. I do this because this is much faster than FLATTEN (which is more efficient: it can handle more entities, but slow) If it can help... (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (vl-load-com) (defun c:my_project ( / jspl nbr n AcDoc Space UCS save_ucs WCS ent_name indx l_blg l_pt ename id_obj pl_typ index nw_pl) (setq jspl (ssget '((-4 . "<OR") (-4 . "<AND") (0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>") (0 . "LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,POINT") (-4 . "OR>")) ) nbr -1 n 0 ) (cond (jspl (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) UCS (vla-get-UserCoordinateSystems AcDoc) save_ucs (vla-add UCS (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (getvar "UCSXDIR")) (vlax-3d-point (getvar "UCSYDIR")) "CURRENT_UCS" ) ) (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG"))) (vla-StartUndoMark AcDoc) (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS")) (vla-put-activeUCS AcDoc WCS) (repeat (sslength jspl) (setq ent_name (ssname jspl (setq nbr (1+ nbr))) indx -1 l_blg nil l_pt nil ename (vlax-ename->vla-object ent_name) id_obj (vla-get-ObjectName ename) ) (cond ((member id_obj '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")) (setq pl_typ (if (vlax-property-available-p ename 'Type) (vlax-get ename 'Type))) (if (member id_obj '("AcDbPolyline" "AcDb2dPolyline")) (if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (progn (repeat (fix (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq indx (1+ indx))) l_pt) index (float indx)) (if (or (eq pl_typ 1) (if (< pl_typ 3) (not (zerop (vla-GetBulge ename indx))))) (while (eq indx (fix (+ 0.01 index))) (setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq index (+ 0.01 index))) l_pt)) ) ) ) (setq l_pt (cons (vlax-curve-getEndPoint ename) l_pt)) ) (setq l_pt (mapcar '(lambda (x) (trans (list (car x) (cadr x) (- ;+ (if (eq id_obj "AcDbPolyline") (caddr x) 0.0) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) ent_name 0 ) ) (l-coor2l-pt (vlax-get ename 'Coordinates) (eq id_obj "AcDb2dPolyline")) ) ) ) (setq l_pt (l-coor2l-pt (vlax-get ename 'Coordinates) T)) ) (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) (setq nw_pl (vlax-invoke Space 'AddPolyline (apply 'append l_pt))) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) (if (vlax-property-available-p ename 'Type) (progn (setq pl_typ (if (eq (vla-get-ObjectName ename) "AcDb3dPolyline") (if (zerop (vlax-get ename 'Type)) (vlax-get ename 'Type) (1+ (vlax-get ename 'Type))) (vlax-get ename 'Type) ) ) (if (and (vlax-property-available-p ename 'Normal) (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (eq pl_typ 1)) (vla-put-Type nw_pl 0) (vla-put-Type nw_pl pl_typ) ) ) (if (and (vlax-property-available-p ename 'Normal) (equal (vlax-get ename 'Normal) '(0 0 1) 1E-13)) (progn (repeat (length l_pt) (setq l_blg (cons (vla-GetBulge ename (setq indx (1+ indx))) l_blg))) (foreach el l_blg (vla-SetBulge nw_pl indx el) (setq indx (1- indx))) ) ) ) (vla-put-Closed nw_pl (vlax-get ename 'Closed)) ) ((member id_obj '("AcDbEllipse" "AcDbCircle" "AcDbArc")) (if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (progn (setq index (vlax-curve-getStartParam ename) l_pt (list (vlax-curve-GetPointAtParam ename index)) ) (while (< (setq index (+ 0.01 index)) (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt)) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) ) (cond ((eq id_obj "AcDbEllipse") (setq l_pt (vlax-get ename 'Center) nw_pl (vlax-invoke Space 'AddEllipse (list (car l_pt) (cadr l_pt) 0.0) (list (car (vlax-get ename 'MajorAxis)) (cadr (vlax-get ename 'MajorAxis)) 0.0) (* (caddr (vlax-get ename 'Normal)) (vlax-get ename 'RadiusRatio)) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) (vla-put-StartAngle nw_pl (vlax-get ename 'StartAngle)) (vla-put-StartParameter nw_pl (vlax-get ename 'StartParameter)) (vla-put-EndParameter nw_pl (vlax-get ename 'EndParameter)) ) ((or (eq id_obj "AcDbArc") (eq id_obj "AcDbCircle")) (setq l_pt (vlax-get ename 'Center) nw_pl (if (eq id_obj "AcDbArc") (vlax-invoke Space 'AddArc (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius) (vlax-get ename 'StartAngle) (vlax-get ename 'EndAngle)) (vlax-invoke Space 'AddCircle (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius)) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ) ) ) ((eq id_obj "AcDbSpline") (if (or (zerop (vlax-get ename 'IsPlanar)) (and (not (zerop (vlax-get ename 'IsPlanar))) (not (equal (cdr (assoc 210 (entget ent_name))) '(0.0 0.0 1.0) 1E-13)) ) ) (progn (setq index (vlax-curve-getStartParam ename) l_pt (list (vlax-curve-GetPointAtParam ename index)) ) (while (< (setq index (+ 10.0 index)) (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt)) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) ) (progn (setq l_pt (l-coor2l-pt (if (zerop (vlax-get ename 'NumberOfFitPoints)) (cdddr (reverse (cdddr (reverse (vlax-get ename 'ControlPoints))))) (vlax-get ename 'FitPoints)) T) nw_pl (vlax-invoke Space 'AddSpline (apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt))) (list (car (vlax-curve-getFirstDeriv ename 0)) (cadr (vlax-curve-getFirstDeriv ename 0)) 0.0) (list (car (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) (cadr (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) 0.0) ) l_pt (l-coor2l-pt (vlax-get ename 'ControlPoints) T) ) (vla-put-ControlPoints nw_pl (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* (length l_pt) 3))) ) (apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt))) ) ) ) ) ) ) ((eq id_obj "AcDbLine") (setq nw_pl (vlax-invoke Space 'AddLine (list (car (vlax-get ename 'StartPoint)) (cadr (vlax-get ename 'StartPoint)) 0.0) (list (car (vlax-get ename 'EndPoint)) (cadr (vlax-get ename 'EndPoint)) 0.0) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ((eq id_obj "AcDbPoint") (setq nw_pl (vlax-invoke Space 'AddPoint (list (car (vlax-get ename 'Coordinates)) (cadr (vlax-get ename 'Coordinates)) 0.0) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ) (vla-put-TrueColor nw_pl (vla-get-TrueColor ename)) (vla-put-LineType nw_pl (vla-get-LineType ename)) (vla-put-LinetypeScale nw_pl (vla-get-LinetypeScale ename)) (vla-put-Lineweight nw_pl (vla-get-Lineweight ename)) (vla-put-Material nw_pl (vla-get-Material ename)) (vla-put-Layer nw_pl (vla-get-Layer ename)) (vla-delete ename) ) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (vla-EndUndoMark AcDoc) (princ (strcat "\n" (itoa (sslength jspl)) " entity(s) submissive to the command. ENDED !" ) ) ) (T (princ "\nNo compliant entities selected..!")) ) (prin1) )

Thanks MHUPP - that was a thought I'd add for the OP tomorrow, can copy and paste from here rather than try to remember where I last used last ent.

Change elevation only works if all points are on the same Z elevation. this might be why also flatten isn't working for you. Two things you can do to speed up. Combine all the commands into one call like you did below Command has some type of "lag" but for example lets just call it 100ms this would remove 500ms for each loop. Not to mention all the command line spam. (setvar cmdecho 0) when you sent LastEnt anything created or modified is "behind" LastEnt in the drawing and can be added to a selection set with a simple loop. rather then selecting everything in the drawing and checking against the before selection set to find the new items. (setq zList '()) ;(setq before (ssget "_X")) ;not needed anymore (command "regen" "_.copy" obj "" '(0 0 0) '(0 0 0)) (setq LastEnt (entlast)) ;set right before you create/modify objects. you want to either add to a selection (command "_.explode" newent) (while (setq LastEnt (entnext LastEnt)) ;after entities are created this will add them to a selection set. (ssadd LastEnt newents) ) (foreach e newents -edit typo in code

Just to amuse myself, here is a snippet that will flatten simple entities, not sure if that helps you along the way - you can use what code works for 3d polylines, hatches, regions and blocks - might be a bit quicker Command: NewFlatten An edit for later... (defun FlattenLines ( Pt1 Pt2 / MySS MyEnt acount ed) ;;For arcs, attdef, circle, (dimension N/A), Insert, Line, LWPolyline, Mtext, Point, text, ;;Does lines, circles, arcs, ellipses, texts, LWPolylines (if (< (car pt1)(car pt2)) (setq MySS (ssget "_W" pt1 pt2 (list '(-4 . "<OR") '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) '(-4 . "<>") (cons 38 0) '(-4 . "OR>") ))) ; end list, ssget, setq (setq MySS (ssget "_C" pt1 pt2 (list '(-4 . "<OR") '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) '(-4 . "<>") (cons 38 0) '(-4 . "OR>") ))) ; end list, ssget, setq ) ; end f ; (setq MySS (ssget "_X" (list ; '(-4 . "<OR") ; '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) ; '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) ; '(-4 . "<>") (cons 38 0) ; '(-4 . "OR>") ; ))) ; end list, ssget, setq (setq acount 0) (while (< acount (sslength MySS)) (setq MyEnt (ssname MySS acount)) (setq ed (entget MyEnt)) (if (equal (assoc 0 ed) (cons 0 "LWPOLYLINE")) (progn (entmod (setq ed (subst (cons 38 0) (assoc 38 ed) ed) )) ;; Elevation to 0 ) ; end progn (progn (entmod (setq ed (subst (cons 10 (mapcar '* '(1 1 0) (cdr (assoc 10 ed)))) (assoc 10 ed) ed)) ) (entmod (setq ed (subst (cons 11 (mapcar '* '(1 1 0) (cdr (assoc 11 ed)))) (assoc 11 ed) ed)) ) ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ; end while ) (defun SSMouseOrder ( / MyList MySS pt1 pt2 MyEnt SelSS MySS MyDuir acount) ;; Enttypelist: wildcards are OK but not for single selection. ;; Enttypelist in CAPITALS for single entity selection to work. (princ " (Crossing selection, not single picks please). ") ;;Set up LISP (setq MySS (ssadd)) ;; Blank Selelection Set (if (= EntTypeList nil)(setq EntTypeList (list "LINE" "ARC" "CIRCLE")) ) ;; default entity filter (setq MyList (list (cons -4 "<OR") )) ;; Create filter to use with ssget (foreach n EntTypeList (setq MyList (append MyList (list (cons 0 n)) ) ) ) ; end foreach (setq MyList (append MyList (list (cons -4 "OR>")) ) ) (while (setq pt1 (getpoint "Select Objects:"));; Loop to select entities (setq pta pt1) ; record pt1 selected (if (setq MyEnt (car (nentselp pt1))) ;; If 1st point selected was on an entity: Single entity selected (progn (if (ssdel MyEnt MySS) ;; If entity is in selected selection set, delete it (progn (redraw MyEnt 4) ;; Take away highlight ) (progn ;; Else add single entity to selection set (If (member (cdr (assoc 0 (entget MyEnt))) EntTypeList) ;;Check entity type is desired (progn (setq MySS (ssadd MyEnt MySS)) ;; Add to selection set (princ (strcat " 1 Found, ")) ;; Report selection found (redraw MyEnt 3) ;; highlight entity ) ; end progn ) ; end if member ) ; end progn ) ; end if ssdel ) ; end progn (progn ;; Else if clicked point not an entity (setq pt2 (getcorner pt1 " Specify Opposite Corner")) ;;get 2nd point (if (< (car pt1)(car pt2)) ;; Left to right, right to left to determine window or crossing filter (setq SelSS (ssget "_W" pt1 pt2 MyList) ) ;; Get selected entities (setq SelSS (ssget "_C" pt1 pt2 MyList) ) ) (setq acount 0) (if SelSS ;; If anything was selected (progn (princ (strcat " " (rtos (sslength SelSS) 2 0) " Found, ")) ;; report how many entities selected (while (< acount (sslength SelSS)) ;; add entities to selection set (setq MySS (ssadd (ssname SelSS acount) MySS)) (redraw (ssname SelSS acount) 3) ;; Highlight each entity (setq acount (+ acount 1)) ;; Loop counter ) ; end while ) ; end progn ) ; end if SelSS ) ; end progn ) ; end if MyEnt (setq MyDir 0) ;; Work out mouse click directions. Note single selection direction is LL->UR (if (< (cadr pt1)(cadr pt2)) ;; Horizontal (setq MyDir 0) (setq MyDir 1) ) (if (< (car pt1)(car pt2)) ;; Vertical (setq MyDir (+ MyDir 0)) (setq MyDir (+ MyDir 2)) ) ) ; end while (setq acount 0) ;; clear highlights (while (< acount (sslength MySS)) (redraw (ssname MySS acount) 4) (setq acount (+ acount 1)) ) (if (= (sslength MySS) 0) ;; report the selection set and direction or nil if no selection nil (list MySS MyDir) ;; MyDir: 0 BL->TR (or point selection), 1 TL->BR, 2 BR->TL, 3 TR->BL ) (list pta pt2 MyDir) ; MyDir 0, 1-> L to R, 2, 3 -> R to L ) (defun c:NewFlatten ( / Pts) (princ "Selection: ") (setq Pts (SSMouseOrder)) ;;Mouse order returns Selection set points. Used later. (FlattenLines (car Pts) (cadr Pts) ) ;; flatten simple entities ) ; end defun

Depends what you are using for obj, if it is an entity name this is a bit quicker: (command "_.copy") (command obj) (command "") (command '(0 0 0) '(0 0 0)) (setq newent (entlast)) (command "_.explode" newent) becomes (command "_.Explode" (setq NewEnt (entmakex (entget obj)) ) ) where obj might be from (car (entsel)) or (ssname MySS number) Might want to look at the number of loops in the snippet you posted

I trid Change > elevation > 0 but not working. I can't share the full code, but for REGION entities, I'm currently using a method that copies and explodes them to get the Z values, then moves the original REGION to Z=0. I know it's not efficient, but it works. ((equal entType "REGION") (vl-catch-all-apply (function (lambda () (setq zList '()) (setq before (ssget "_X")) (command "regen") (command "_.copy") (command obj) (command "") (command '(0 0 0) '(0 0 0)) (setq newent (entlast)) (command "_.explode" newent) (setq after (ssget "_X")) (setq newents '()) (setq j 0) (while (< j (sslength after)) (setq ent (ssname after j)) (if (not (ssmemb ent before)) (setq newents (cons ent newents)) ) (setq j (1+ j)) ) (foreach e newents (setq entdata (entget e)) (cond ((= (cdr (assoc 0 entdata)) "LINE") (setq z1 (nth 2 (cdr (assoc 10 entdata)))) (setq z2 (nth 2 (cdr (assoc 11 entdata)))) (setq zList (cons z1 zList)) (setq zList (cons z2 zList)) ) ((member (cdr (assoc 0 entdata)) '("ARC" "CIRCLE" "ELLIPSE") ) (setq z1 (nth 2 (cdr (assoc 10 entdata)))) (setq zList (cons z1 zList)) ) ) ) (setq ztotal 0) (if (< 0 (length zList)) (progn (foreach z zList (setq ztotal (+ ztotal z))) (setq zmid (/ ztotal (length zList))) (command "_.MOVE" obj "" '(0 0 0) (list 0.0 0.0 (* zmid -1)) ) ) ) (foreach e newents (entdel e)) ) ) ) ) And also is there a way to use ssget to select only entities that have non-zero Z values?

That would get most of the simpler entities such as lines, text, circles and so on. LWPolylines you can add another "or": '(-4 . "<>") (cons 38 0.0) and so on building up the selection set filter that way: (ssget (list '(-4 . "<OR") '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) '(-4 . "<>") (cons 38 0) '(-4 . "OR>") )) For 3d polylines, for example, so long as the first point (first dxf code 10 in the entity description) isn't at zero elevation it should also grab them too. However if this only removes lines, LWPolylines, circles, arcs, texts, ellipses... it should reduce the amount of processing. Depends how you are doing it but the blocks might be your slow point.

Can't really tell you how to optimize code you didn't post, but when people first get into lisp the rely heavily on command because its follows what you would type into the command line. It become apparent in a loop processing 1000's of entity's that its quite inefficient. rather then using entmod or some other way to update model. If flatten doesn' work also try the command Change > elevation > 0

yes flatten is not working sometimes block, pline, dimension. So ı need this lisp. this lips so limited. for exaple there are multiple 10 dxf data in POLYLINE. I need something more comprehensive

I guess the flatten command has some limitations for you (I've never been 100% with trusting flatten)

Here is a quick example, (ssget (list '(-4 . "<OR") '(-4 . "*,*,<>") (list 10 0.0 0.0 0.0) '(-4 . "*,*,<>") (list 11 0.0 0.0 0.0) '(-4 . "OR>") )) Should select the more simple entities not at 0 elevation - not sure it will work for 3d polylines for example, but should be OK for lines, circles, arcs and so on and apply similar to others?