Leaderboard

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

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

if you want a radio button pick have a look at my Multi radio buttons.lsp it can hold about 20 values vertically. once you pick I use Ldata to save the value in a dwg, in the multi R you can set the button to the current value. In a pop menu would be just a load a lisp as normal all the values being in it that lisp.

Hi @CivilTechSource, Here is the an example how you can do it on different approach. In AutoCAD exist "blackboard", where you can store the desired value where you can than use that value in the other open drawings (more about blackboard: About Sharing Data Between Namespaces (AutoLISP)). In this example, I have a "text size values.txt" file with different heights. It can be update with other height values. 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0 9.5 10.0 So, after run this function, you will first choose the file with values (in this case "text size values.txt"), than pick the desired value and add it to blackboard. (prompt "\nCall function: (getValueFromListBlackboard)") (princ) ;; Add any value from list to the "blackboard" (defun getValueFromListBlackboard ( / *dcl_id* *file_name* *op* *lst* *textSize* *path* *file* *line* *rval*) (setq *path* (getfiled "Open the txt file with list of values"" "txt" 0) *file* (open *path* "r") ) (if *file* (progn (while (setq *line* (read-line *file*)) (setq *lst* (append *lst* (list *line*))) ) (close *file*) ) ) (setq *file_name* (vl-filename-mktemp "textHeight.dcl") *op* (open *file_name* "w") ) (write-line "textHeight :dialog { label = \"Select Text Heights\"; :list_box { key = \"tx\"; multiple_select = true; height = 20; width = 30; } :row { :button { label = \"Pick text height\"; key = \"bth\"; fixed_width = true; } :button { label = \"Cancel\"; key = \"cancel\"; mnemonic = \"C\"; alignment = centered; fixed_width = true; is_cancel=true; } } }" *op*) (close *op*) (setq *dcl_id* (load_dialog *file_name*)) (if (not (new_dialog "textHeight" *dcl_id*)) (exit) ) (action_tile "cancel" "(done_dialog 0)") (start_list "tx") (mapcar 'add_list *lst*) (end_list) (defun return_value () (setq *rval* (nth (atoi (get_tile "tx")) *lst*)) ) (action_tile "bth" "(return_value) (done_dialog 1)") (start_dialog) (unload_dialog *dcl_id*) (vl-file-delete *file_name*) (vl-bb-set '*textSize* *rval*) (vl-bb-ref '*textSize*) ) After you pick the desire height, you can change it in all open drawings for any text. In this case, I made a little lisp for that and I need it to call every time in different drawing (except if you don't want to make it in support file search path or to be autoloaded every time when AutoCAD is started). (defun c:CTH ( / data) (setq data (entget (car (entsel "\nSelect the text:")))) (entmod (subst (cons 40 (atof (vl-bb-ref '*textSize*))) (assoc 40 data) data)) ) An example video of how it works you can see below. ChangeTextWithValueFromBlackboard.mp4 Maybe in this you can get some idea how to make it work in your case. Also, you can add "getValueFromListBlackboard" to CUI and make it easier to call. Best regards.

If you would run through -OVERKILL you can see current settings and the options in the command line, just add what you need to the line in the LISP, just getting the selection and ENTER twice is going to default to last used settings. Command: -OVERKILL Select objects: all 1935 found 426 were not in current space. Select objects: Current settings: Tolerance=1.000000, Ignore=All, Optimize polylines=Yes, Combine partial overlap=Yes, Combine end-to-end=Yes Enter an option to change [Done/Ignore/tOlerance/optimize Plines/combine parTial overlap/combine Endtoend/Associativity] <done>: *Cancel* The Uppercase letters are the shortcut, i.e. for Tolerance use O (value), optimize Plines use P, etc. You might find something on this thread... I need overkill and ncopy !please help me! - AutoLISP, Visual LISP & DCL - AutoCAD Forums