+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 11
  1. #1
    Senior Member 3dwannab's Avatar
    Computer Details
    3dwannab's Computer Details
    Operating System:
    Windows 10 Pro
    Computer:
    Self-Built
    CPU:
    TR 1950X
    Discipline
    Architectural
    3dwannab's Discipline Details
    Occupation
    Arch Technician and Arch Viz
    Discipline
    Architectural
    Details
    TBC
    Using
    AutoCAD 2019
    Join Date
    Jun 2012
    Location
    Ireland
    Posts
    192

    Default How to pause for user input in while and run more than 1 command call

    Registered forum members do not see this ad.

    TWO THINGS HERE

    1. How can I get the pause to be only asked once in the while loop.
    2. Unknown command "MW". Press F1 for help. comes up for the last 2 commands.


    CODE FOR CREATING MULTIPLE WIPEOUTS:
    Code:
    (defun c:mw ( /
    	sset
    	countn
    	n
    	*error*
    	cmde
    	os
    	smode
    	)
    
    (defun *error* (errmsg)
    	(and acDoc (vla-EndUndoMark acDoc))
    	(and errmsg
    
    		(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
    		(princ (strcat "\n<< Error: " errmsg " >>"))
    		)
    	(setvar 'cmdecho cmde)
    	(setvar 'osmode os)
    	(setvar 'selectsimilarmode smode)
    	)
    
    (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
    (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
    
    (setq cmde (getvar 'cmdecho))
    (setq os (getvar 'osmode))
    (setq smode (getvar 'selectsimilarmode))
    (setvar 'cmdecho 0)
    (setvar 'osmode 0)
    
    ; MULTIPLE WIPEOUT
    (princ "\nSelect items: ")
    (setq sset (ssget '((0 . "LWPOLYLINE"))))
    (if sset
    	(progn (setq n (1- (sslength sset)))
    		(setq countn -1)
    		(while (< countn n)
    			(setq countn (1+ countn))
    
    
    			; HELP HERE
    			; TWO THINGS HERE.
    			; 1. How can I get the pause to be only asked once in the while loop.
    			; 2. Unknown command "MW".  Press F1 for help. comes up for the last 2 commands.
    
    			(progn
    				(command "._wipeout" "_polyline" (ssname sset countn) pause)
    				(command "_.change" (ssname sset countn) "" "properties" "color" "T" "255,255,255" "")
    				(command "DRAWORDER" (ssname sset countn) "" "back" "")
    				)
    
    			)
    		)
    	(princ "\Sorry, no closed lwpolylines selected. ")
    	)
    
    (setq sset nil)
    
    (*error* nil)
    
    (vl-load-com)
    )

  2. #2
    Super Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    900

    Default

    Not an answer to your question, but have you ever thought of just using a truecolor white hatch rather than a wipeout? I've had oddities in the past with printing wipeouts. Also .. have you seen THIS?

  3. #3
    Senior Member 3dwannab's Avatar
    Computer Details
    3dwannab's Computer Details
    Operating System:
    Windows 10 Pro
    Computer:
    Self-Built
    CPU:
    TR 1950X
    Discipline
    Architectural
    3dwannab's Discipline Details
    Occupation
    Arch Technician and Arch Viz
    Discipline
    Architectural
    Details
    TBC
    Using
    AutoCAD 2019
    Join Date
    Jun 2012
    Location
    Ireland
    Posts
    192

    Default

    Quote Originally Posted by ronjonp View Post
    Not an answer to your question, but have you ever thought of just using a truecolor white hatch rather than a wipeout? I've had oddities in the past with printing wipeouts. Also .. have you seen THIS?
    I haven't had too much trouble with them with DWG to PDF.pc3

    Thanks, I'll take a look at that. I'm learning LISP so this was just a little excerise that I got stuck on.

  4. #4
    Super Member
    Discipline
    Multi-disciplinary
    Using
    AutoCAD 2015
    Join Date
    Nov 2013
    Posts
    1,478

    Default

    I had problem with printing wipeouts too, required me to install AutoCAD service pack 1 or 2 (don't remember) and everything was fine again.
    Anyway.. quick fix:
    Code:
    (defun C:test ( / *error* SS oCol acDoc b c i e o )
      
      (defun *error* (m)
        (and acDoc (vla-EndUndoMark acDoc))
        (and c (setvar 'cmdecho c))
        (and oCol (vl-catch-all-apply 'vlax-release-object (list oCol)))
        (and m (princ m)) (princ)
      ); defun *error*
      
      (and
        (setq SS 
          (ssget "_:L"
            '(
              (-4 . "<AND")
              (0 . "*POLYLINE")
              (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 80) (-4 . "AND>") (-4 . "NOT>")
              (-4 . "AND>")
            )
          )
        )
        (setq oCol (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))))
        (progn
          (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
          (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
          (vla-put-ColorMethod oCol acColorMethodByRGB) (apply 'vla-SetRGB (cons oCol '(255 255 255)))
          (setq b (strcat "_" (substr (progn (initget "Yes No") (cond ( (getkword "\nErase source plines? [Yes/No] <No>: ") ) ( "No" ) )) 1 1)))
        )
        (setq c (getvar 'cmdecho)) (setvar 'cmdecho 0)
        (repeat (setq i (sslength SS))
          (setq e (ssname SS (setq i (1- i))))
          (command "_.WIPEOUT" "_P" e b)
          (cond 
            ( (eq "AcDbWipeout" (vla-get-ObjectName (setq o (vlax-ename->vla-object (setq e (entlast))))))
              (vla-put-TrueColor o oCol)
              (command "_DRAWORDER" (ssadd e) "" "_B")
            )
          )
        )
      )
      (*error* nil) (princ)
    ); defun C:test
    EDIT: Included Undomarks

  5. #5
    Super Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    900

    Default

    Grrr beat me to it, but here are some comments on your code.
    Code:
    (defun c:mw (/ *error* acdoc cmde countn e n os smode sset s)
      (defun *error* (errmsg)
        (and acdoc (vla-endundomark acdoc))
        (and errmsg
    	 (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
    	 (princ (strcat "\n<< Error: " errmsg " >>"))
        )
        (setvar 'cmdecho cmde)
        (setvar 'osmode os)
        (setvar 'selectsimilarmode smode)
      )
      (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
      (or (vla-endundomark acdoc) (vla-startundomark acdoc))
      (setq cmde (getvar 'cmdecho))
      (setq os (getvar 'osmode))
      (setq smode (getvar 'selectsimilarmode))
      (setvar 'cmdecho 0)
      (setvar 'osmode 0)			; MULTIPLE WIPEOUT
      (princ "\nSelect items: ")
      ;; Moved selection into if statement .. look into filtering for closed polylines ;)
      (if (setq sset (ssget '((0 . "LWPOLYLINE"))))
        (progn ;; Create empty selection set to add wipeouts to
    	   (setq s (ssadd))
    	   (setq n (1- (sslength sset)))
    	   (setq countn -1)
    	   (while (< countn n)
    	     (setq countn (1+ countn))	; HELP HERE
    					; TWO THINGS HERE.
    					; 1. How can I get the pause to be only asked once in the while loop.
    					; 2. Unknown command "MW".  Press F1 for help. comes up for the last 2 commands.
    	     (progn ;; Use "" rather than pause
    		    (command "._wipeout" "_polyline" (ssname sset countn) "")
    		    ;; Check that the last item added is a wipeout
    		    (if	(= "WIPEOUT" (cdr (assoc 0 (entget (setq e (entlast))))))
    		      ;; Put wipeout in a selection set to send to back (assuming this is what you intended?)
    		      (progn (ssadd e s)
    			     ;; Removed command call and use entmod to make wipeout RGB white
    			     ;; (command "_.change" (entlast) "" "properties" "color" "T" "255,255,255" "")
    			     (entmod (append (entget e) '((62 . 7) (420 . 16777215))))
    			     ;; Put on a wipeout layer .. ENTMOD is your friend :)
    			     (entmod (append (entget e) '((8 . "Wipeout"))))
    		      )
    		    )
    	     )
    	   )
    	   ;; Take this out of the loop and send the whole selection set back
    	   (command "DRAWORDER" s "" "back")
        )
        (princ "\Sorry, no closed lwpolylines selected. ")
      )
      (setq sset nil)
      (*error* nil)
      (vl-load-com)
    )

  6. #6
    Senior Member 3dwannab's Avatar
    Computer Details
    3dwannab's Computer Details
    Operating System:
    Windows 10 Pro
    Computer:
    Self-Built
    CPU:
    TR 1950X
    Discipline
    Architectural
    3dwannab's Discipline Details
    Occupation
    Arch Technician and Arch Viz
    Discipline
    Architectural
    Details
    TBC
    Using
    AutoCAD 2019
    Join Date
    Jun 2012
    Location
    Ireland
    Posts
    192

    Default

    @Grrr, that's amazing thanks so much.

    I'll try get my head around that.

    @ronjonp, The reason for the pause was to ask the user whether or not to delete the original polys. But Grrr has that as a setq in that. I never even thought of that.

    So this is an edited version of your code for a Y/N prompt to delete the org. polylines.

    Code:
    (defun c:mw (/ *error* acdoc cmde countn e n os smode sset s b)
    	(defun *error* (errmsg)
    		(and acdoc (vla-endundomark acdoc))
    		(and errmsg
    			(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
    			(princ (strcat "\n<< Error: " errmsg " >>"))
    			)
    		(setvar 'cmdecho cmde)
    		(setvar 'osmode os)
    		(setvar 'selectsimilarmode smode)
    		)
    	(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
    	(or (vla-endundomark acdoc) (vla-startundomark acdoc))
    	(setq cmde (getvar 'cmdecho))
    	(setq os (getvar 'osmode))
    	(setq smode (getvar 'selectsimilarmode))
    	(setvar 'cmdecho 0)
      (setvar 'osmode 0)			; MULTIPLE WIPEOUT
      (princ "\nSelect items: ")
      ;; Moved selection into if statement .. look into filtering for closed polylines ;)
      (if (setq sset (ssget '((0 . "LWPOLYLINE"))))
        (progn ;; Create empty selection set to add wipeouts to
        	(setq b (strcat "_" (substr (progn (initget "Yes No") (cond ( (getkword "\nErase source plines? [Yes/No] <No>: ") ) ( "No" ) )) 1 1)))
        	(setq s (ssadd))
        	(setq n (1- (sslength sset)))
        	(setq countn -1)
        	(while (< countn n)
    	     (setq countn (1+ countn))	; HELP HERE
    					; TWO THINGS HERE.
    					; 1. How can I get the pause to be only asked once in the while loop.
    					; 2. Unknown command "MW".  Press F1 for help. comes up for the last 2 commands.
    	     (progn ;; Use "" rather than pause
    	     	(command "._wipeout" "_polyline" (ssname sset countn) b)
    		    ;; Check that the last item added is a wipeout
    		    (if	(= "WIPEOUT" (cdr (assoc 0 (entget (setq e (entlast))))))
    		      ;; Put wipeout in a selection set to send to back (assuming this is what you intended?)
    		      (progn (ssadd e s)
    			     ;; Removed command call and use entmod to make wipeout RGB white
    			     ;; (command "_.change" (entlast) "" "properties" "color" "T" "255,255,255" "")
    			     (entmod (append (entget e) '((62 . 7) (420 . 16777215))))
    			     )
    		      )
    		    )
    	     )
    	   ;; Take this out of the loop and send the whole selection set back
    	   (command "DRAWORDER" s "" "back")
    	   )
        (princ "\Sorry, no closed lwpolylines selected. ")
        )
      (setq sset nil)
      (*error* nil)
      (vl-load-com)
      )
    Cheers guys.

  7. #7
    Super Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    900

    Default

    Here's a modified version of Lee's code to convert a selection set of closed polylines
    Code:
    ;; Polygonal Wipeout  -  Lee Mac
    ;; RJP added multiple polyline selection & some layering
    (defun c:pw (/ a b c l m p s)
      (initget "Yes No")
      (setq	b (cond	((getkword "\nErase source plines? [Yes/No] <Yes>: "))
    		("Yes")
    	  )
      )
      (if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
        (foreach a (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
          (cond
    	((= 0 (apply '+ (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 42 (car x))) (entget a)))))
    	 (setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget a))))
    	 (setq l (cons (last l) l)
    	       p (apply 'mapcar (cons 'min l))
    	       m (apply 'max (mapcar '- (apply 'mapcar (cons 'max l)) p))
    	       c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
    	 )
    	 (entmake
    	   (append
    	     (list '(000 . "WIPEOUT")
    		   '(100 . "AcDbEntity")
    		   '(100 . "AcDbWipeout")
    		   '(008 . "Wipeout")
    		   (cons 10 (trans p 1 0))
    		   (cons 11 (trans (list m 0.0) 1 0))
    		   (cons 12 (trans (list 0.0 m) 1 0))
    		   '(280 . 1)
    		   '(071 . 2)
    	     )
    	     (mapcar
    	       (function
    		 (lambda (x) (cons 14 (mapcar '(lambda (a b c) (/ (- a b) c)) x c (list m (- m)))))
    	       )
    	       l
    	     )
    	   )
    	 )
    	 (and (= b "Yes") (entdel a))
    	)
    	((print "The polyline selected has arc segments and was skipped..."))
          )
        )
      )
      (princ)
    )

  8. #8
    Super Member
    Discipline
    Multi-disciplinary
    Using
    AutoCAD 2015
    Join Date
    Nov 2013
    Posts
    1,478

    Default

    Probably the most efficent version for this routine - vanilla and works on other closed objects like circles/ellipses :

    Code:
    ;;; Original Source:
    ;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
    ;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs)
    ;;; Works whatever the current ucs and object OCS
    ;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/wipeout-with-arcs/m-p/786490#M12148
    
    ;;; Modification for multiple selection of closed objects (except SPLINE), that sets color of 255,255,255 to the wipeouts and sends their draworder to bottom
    ;;; Assembled by Grrr
    ;;; Credits - Gile, Lee Mac
    ;;; http://www.cadtutor.net/forum/showthread.php?104705-How-to-pause-for-user-input-in-while-and-run-more-than-1-command-call&p=705082#post705082
    (defun C:Wipeouts ( / ent2ptlst MakeWipeout *error* acDoc )
      
      ;;; ENT2PTLST - Gile 
      ;;; Returns the vertices list of the polygon figuring the curve object
      ;;; Coordinates defined in OCS
      (defun ent2ptlst (e / o d n lst plst prec)
        (if (= (type e) 'ENAME) (setq o (vlax-ename->vla-object e)) )
        (cond
          ( (member (cdr (assoc 0 (entget e))) '("CIRCLE" "ELLIPSE"))
            (setq d (/ (vlax-curve-getDistAtParam o (vlax-curve-getEndParam o)) 50))
            (setq n	0)
            (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist o (* d (setq n (1+ n)))) 0 (vlax-get o 'Normal)) lst)))
          )
          ( (setq plst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42))) (entget e)))
            (while plst
              (setq lst (cons (append (cdr (assoc 10 plst)) (list (cdr (assoc 38 (entget e))))) lst))
              (if (/= 0 (cdadr plst))
                (progn
                  (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr plst)))))))
                  (setq d 
                    (/ 
                      (- 
                        (if (cdaddr plst) (vlax-curve-getDistAtPoint o (trans (cdaddr plst) e 0)) (vlax-curve-getDistAtParam o (vlax-curve-getEndParam o)) )
                        (vlax-curve-getDistAtPoint o (trans (cdar plst) e 0))
                      )
                      prec
                    )
                  )
                  (setq n 0)
                  (repeat (1- prec)
                    (setq lst (cons (trans (vlax-curve-getPointAtDist o (+ (vlax-curve-getDistAtPoint o (trans (cdar plst) e 0)) (* d (setq n (1+ n))))) 0 e) lst))
                  )
                )
              )
              (setq plst (cddr plst))
            )
          )
        )
        lst
      ); defun ent2ptlst
      
      ;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object - Gile
      (defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)
        (if (not (member "acismui.arx" (arx))) (arxload "acismui.arx") )
        (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst)) (apply 'min (mapcar 'cadr pt_lst)) (caddar pt_lst) ) )
        (setq max_dist (float (apply 'max (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10))))
        (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
        (setq dxf14 (mapcar '(lambda (p) (mapcar '/ (mapcar '- p cen) (list max_dist (- max_dist) 1.0))) pt_lst) )
        (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
        (entmakex
          (append 
            (list 
              '(0 . "WIPEOUT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbWipeout")
              '(90 . 0)
              (cons 10 (trans dxf10 nor 0))
              (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
              (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
              '(13 1.0 1.0 0.0)
              '(70 . 7)
              '(280 . 1)
              '(71 . 2)
              (cons 91 (length dxf14))
            )
            (mapcar '(lambda (p) (cons 14 p)) dxf14)
          )
        )
      ); defun MakeWipeout
      
      
      (defun *error* (m)
        (and acDoc (vla-EndUndoMark acDoc))
        (and m (princ m)) (princ)
      ); defun *error*
      
      (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
      
      (
        (lambda ( / SS b wSS i e L n w )
          (and
            (setq SS
              (ssget "_:L"
                '(   (0 . "CIRCLE,ELLIPSE,*POLYLINE") ; doesn't quite work with "SPLINE"
                  (-4 . "<NOT")
                  (-4 . "<AND")
                  (0 . "POLYLINE") (-4 . "&") (70 . 80)
                  (-4 . "AND>")
                  (-4 . "NOT>")
                )
              )
            )
            
            (progn
              (setq b (= "Yes" (progn (initget "Yes No") (cond ( (getkword "\nErase source objects? [Yes/No] <No>: ") ) ( "No" ) ))))
              t 
            )
            (progn
              (setq wSS (ssadd))
              (repeat (setq i (sslength SS))
                (and 
                  (setq e (ssname SS (setq i (1- i))))
                  (vlax-curve-isClosed e)
                  (setq L (ent2ptlst e))
                  (setq n (cdr (assoc 210 (entget e))))
                  (progn (and b (entdel e)) t)
                  (setq w (MakeWipeout L n))
                  (entmod (append (entget w) '((62 . 7) (420 . 16777215))))
                  (setq wSS (ssadd w wSS))
                ); and
              ); repeat
              (LM:movetobottom wSS)
              (sssetfirst nil wSS) ; for the demo
            ); progn
          ); and
        ); lambda
      )
      (*error* nil) (princ)
    ); defun
    
    
    ;; -----------------------------------------------------------
    ;; DrawOrderV1-2.lsp - Lee Mac : 
    
    ;; Move to Top  -  Lee Mac
    ;; Moves a set of objects to the top of the draw order.
    ;; obs - [lst/sel] Selection set or list of objects with same owner
    ;; Returns: T if successful, else nil
    
    (defun LM:movetotop ( obs / tab )
      (if (and (or (= 'list (type obs)) (setq obs (LM:ss->vla obs)))
        (setq tab (LM:sortentstable (LM:getowner (car obs))))
      )
      (not (vla-movetotop tab (LM:safearrayvariant vlax-vbobject obs)))
      )
    )
    
    ;; Move to Bottom  -  Lee Mac
    ;; Moves a set of objects to the bottom of the draw order.
    ;; obs - [lst/sel] Selection set or list of objects with same owner
    ;; Returns: T if successful, else nil
    
    (defun LM:movetobottom ( obs / tab )
      (if (and (or (= 'list (type obs)) (setq obs (LM:ss->vla obs)))
        (setq tab (LM:sortentstable (LM:getowner (car obs))))
      )
      (not (vla-movetobottom tab (LM:safearrayvariant vlax-vbobject obs)))
      )
    )
    
    ;; Move Above  -  Lee Mac
    ;; Moves a set of objects above a supplied object in the draw order.
    ;; obs - [lst/sel] Selection set or list of objects with same owner
    ;; obj - [vla] Object above which to move supplied objects
    ;; Returns: T if successful, else nil
    
    (defun LM:moveabove ( obs obj / tab )
      (if (and (or (= 'list (type obs)) (setq obs (LM:ss->vla obs)))
        (setq tab (LM:sortentstable (LM:getowner (car obs))))
      )
      (not (vla-moveabove tab (LM:safearrayvariant vlax-vbobject obs) obj))
      )
    )
    
    ;; Move Below  -  Lee Mac
    ;; Moves a set of objects below a supplied object in the draw order.
    ;; obs - [lst/sel] Selection set or list of objects with same owner
    ;; obj - [vla] Object below which to move supplied objects
    ;; Returns: T if successful, else nil
    
    (defun LM:movebelow ( obs obj / tab )
      (if (and (or (= 'list (type obs)) (setq obs (LM:ss->vla obs)))
        (setq tab (LM:sortentstable (LM:getowner (car obs))))
      )
      (not (vla-movebelow tab (LM:safearrayvariant vlax-vbobject obs) obj))
      )
    )
    
    ;; Swap Order  -  Lee Mac
    ;; Swaps the draw order of two objects (may require regen).
    ;; ob1,ob2 - [vla] Objects to swap
    ;; Returns: T if successful, else nil
    
    (defun LM:swaporder ( ob1 ob2 / tab )
      (if (setq tab (LM:sortentstable (LM:getowner ob1)))
        (not (vla-swaporder tab ob1 ob2))
      )
    )
    
    ;; Get Owner -  Lee Mac
    ;; A wrapper for the objectidtoobject method & ownerid property to enable
    ;; compatibility with 32-bit & 64-bit systems
    
    (defun LM:getowner ( obj )
      (eval
        (list 'defun 'LM:getowner '( obj )
          (if (vlax-method-applicable-p obj 'ownerid32)
            (list 'vla-objectidtoobject32 (LM:acdoc) '(vla-get-ownerid32 obj))
            (list 'vla-objectidtoobject   (LM:acdoc) '(vla-get-ownerid   obj))
          )
        )
      )
      (LM:getowner obj)
    )
    
    ;; Catch Apply  -  Lee Mac
    ;; Applies a function to a list of parameters and catches any exceptions.
    
    (defun LM:catchapply ( fnc prm / rtn )
      (if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fnc prm))))
        rtn
      )
    )
    
    ;; Sortents Table  -  Lee Mac
    ;; Retrieves the Sortents Table object.
    ;; obj - [vla] Block Container Object
    
    (defun LM:sortentstable ( obj / dic )
      (cond
        (   (LM:catchapply 'vla-item (list (setq dic (vla-getextensiondictionary obj)) "acad_sortents")))
        (   (LM:catchapply 'vla-addobject  (list dic "acad_sortents" "AcDbSortentsTable")))
      )
    )
    
    ;; Selection Set to VLA Objects  -  Lee Mac
    ;; Converts a Selection Set to a list of VLA Objects
    ;; sel - [sel] Selection set (pickset)
    
    (defun LM:ss->vla ( sel / idx lst )
      (if (= 'pickset (type sel))
        (repeat (setq idx (sslength sel))
          (setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
        )
      )
    )
    
    ;; Safearray Variant  -  Lee Mac
    ;; Returns a populated safearray variant of a specified data type
    ;; typ - [int] Variant type enum (e.g. vlax-vbdouble)
    ;; lst - [lst] List of static type data
    
    (defun LM:safearrayvariant ( typ lst )
      (vlax-make-variant
        (vlax-safearray-fill
          (vlax-make-safearray typ (cons 0 (1- (length lst))))
          lst
        )
      )
    )
    
    ;; Active Document  -  Lee Mac
    ;; Returns the VLA Active Document Object
    
    (defun LM:acdoc nil
      (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
      (LM:acdoc)
    )
    
    (vl-load-com) (princ)


    Thanks to Gile and Lee Mac!

    Although it errors out on closed splines (maybe I should have used LM:EntityToPointList).

  9. #9
    Senior Member 3dwannab's Avatar
    Computer Details
    3dwannab's Computer Details
    Operating System:
    Windows 10 Pro
    Computer:
    Self-Built
    CPU:
    TR 1950X
    Discipline
    Architectural
    3dwannab's Discipline Details
    Occupation
    Arch Technician and Arch Viz
    Discipline
    Architectural
    Details
    TBC
    Using
    AutoCAD 2019
    Join Date
    Jun 2012
    Location
    Ireland
    Posts
    192

    Default

    Quote Originally Posted by Grrr View Post
    Although it errors out on closed splines (maybe I should have used LM:EntityToPointList).
    I'll be sure to give that a go. !

    BTW, This might be a bit off topic but it relates to closed/open polylines.

    Sometimes/Most of the time 🤦 I get polylines that are closed but with 2 or more verts on top of each other. Is there any routine you guys know to combat this?

  10. #10
    Super Member
    Discipline
    Multi-disciplinary
    Using
    AutoCAD 2015
    Join Date
    Nov 2013
    Posts
    1,478

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by 3dwannab View Post
    Sometimes/Most of the time I get polylines that are closed but with 2 or more verts on top of each other. Is there any routine you guys know to combat this?
    Look for gile's simplifypoly routine (somewhere on theswamp).

Similar Threads

  1. Conditional Lisp call to insert data based on user input
    By ishka in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 18th Mar 2015, 01:24 pm
  2. pause for user input
    By JPlanera in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 29th Jun 2012, 08:39 pm
  3. Getting user input within a command
    By JLG in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 17th Dec 2009, 04:13 pm
  4. Trouble getting user input within a command
    By Archiman86 in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 24th Nov 2009, 08:10 pm
  5. command PAUSE for infinite user input until enter or escape
    By Etch-a-sketch in forum AutoLISP, Visual LISP & DCL
    Replies: 3
    Last Post: 4th Aug 2007, 09:31 am

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts