Grvecs on polyline

August 7, 2016

Hi guys,

The last few days I was attempting to do some stuff on closed polyline's vertices.

Still unsuccessful.. so can you have a look at what might being wrong? :

(setq bply-verts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) bply-elist)))
(grvecs (list -3 bply-verts)) ; <- I've seen Tharwat doing something like this, instead of whats been written in HELP

Command: test
Pick a point inside a closed boundary: Automation Error. Object was erased

I'm attempting the same thing with this subfunction called "MkWipeout", written by CAB:

;;  Requires a point list and layer name
(defun MkWipeout (lst lay / c m p)
(setq lst (cons (last lst) lst)
	p (apply 'mapcar (cons 'min lst))
	m (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
	c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
)
(entmakex
	(append
		(list
			'(000 . "WIPEOUT")
			'(100 . "AcDbEntity")
			'(100 . "AcDbWipeout")
			(cons 8 lay)
			(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)))))) lst)))
)

(MkWipeout bply-verts (getvar 'clayer))

But I get the same error.

Any ideas?

August 7, 2016

The error message seems pretty obvious to me. But your code is a mystery... Post more than just 1 or 2 lines of your code please.

August 7, 2016

The error message seems pretty obvious to me. But your code is a mystery... Post more than just 1 or 2 lines of your code please.

Heres the whole code:

(defun C:test ( / *error* oldcmd oldclp pt pty pty-obj bply bply-obj bply-elist bply-verts )

(vl-load-com)
(redraw)
(grtext)

(setvar 'errno 0)
(setq oldcmd (getvar 'cmdecho))
(setq oldclp (getvar 'clipromptlines))
(setvar 'cmdecho 0)
(setvar 'clipromptlines 1)

(defun *error* ( msg )
	(if oldcmd (setvar 'cmdecho oldcmd))
	(if oldclp (setvar 'CLIPROMPTLINES oldclp))
	(if pty (entdel pty))
	(if pty-obj (vla-delete pty-obj))
	(if bply (entdel bply))
	(if bply-obj (vla-delete bply-obj))
	(redraw)
	(grtext)
	(if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	)
	(princ)
)

;(while T
	(while ; get the vertices list, from  a bpoly or "entsel-ed" closed poly
		(not
			(and 
				(setq pt (getpoint "\nPick a point inside a closed boundary: "))
				; emake point, to check the "_.-boundary" evaluation:
				(entmakex (list (cons 0 "POINT") (cons 10 pt)))
				(setq pty (entlast)) ; the "entlast" would be point
				(setq pty-obj (vlax-ename->vla-object pty))
				(vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" pt "") ; if successful
				(setq bply (entlast)) ; the last created entity
				(setq bply-obj (vlax-ename->vla-object bply))
				(if
					(and
						(= (cdr (assoc 0 (entget bply))) "LWPOLYLINE") ; is poly
						(= (cdr (assoc 70 (entget bply))) 1) ; is closed
						(vlax-curve-isClosed bply-obj)
					)
					(setq bply-elist (entget bply))
				)
				
				
			)
		)
		(if (or (= (getvar 'errno) 7) (not bply-elist)) (princ "\nYou missed, try again!"))
	); while
	(redraw)
	(grtext)
	(setq bply-verts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) bply-elist))) ; <- the actual goal
	
	; highlight the enclosed area:
	(grvecs bply-verts); will this work?
	; display the area value as "grtext" :
	(grtext -1 (strcat "Enclosed area: " (rtos (vla-get-Area bply-obj) 2 0) " m2"))
	; heres the part where the wipeout must be created from bpoly's vertices:
	(MkWipeout bply-verts (getvar 'clayer))
	(if pty (entdel pty))
	; (if pty-obj (vla-delete pty-obj))
	(if bply (entdel bply))
	; (if bply-obj (vla-delete bply-obj))
; while T

(if oldcmd (setvar 'cmdecho oldcmd))
(if oldclp (setvar 'CLIPROMPTLINES oldclp))
(princ)
); defun


;;  Requires a point list and layer name
(defun MkWipeout (lst lay / c m p)
(setq lst (cons (last lst) lst)
	p (apply 'mapcar (cons 'min lst))
	m (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
	c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
)
(entmakex
	(append
		(list
			'(000 . "WIPEOUT")
			'(100 . "AcDbEntity")
			'(100 . "AcDbWipeout")
			(cons 8 lay)
			(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)))))) lst)))
)

I'm guessing that I would have the same result, even if I entsel a closed polyline (instead of creating bpoly).

August 7, 2016

The following fragment worked, using grdraw, but I was looking for a simplier and shorter way:

				(setq cnt 0)
			(foreach x bply-verts
				(if (nth (+ cnt 1) bply-verts)
					(grdraw (nth cnt bply-verts) (nth (setq cnt (+ cnt 1)) bply-verts) 2 10)
					(grdraw (car bply-verts) (last bply-verts) 2 10)
				)
			)

I'm still thinking whats wrong, since I can't use that "MkWipeout" subfunction - even when I provide a correct pointlist.

August 8, 2016

4 things:

1.

I can't reproduce your error message ('Automation Error. Object was erased').

2.

I have to change the command call (Note: I use BricsCAD instead of AutoCAD):

(vl-cmdf "_.-boundary" "_advanced" "_island" "_no" "" pt "")

For readability I prefer not to abbreviate command options.

3.

The function grvecs requires a list in different format.

In your initial post you have:

(grvecs (list -3 (list ptA ptB ptC ptD)))

This must be:

(grvecs (list -3 ptA ptB ptB ptC ptC ptD ptD ptA))

One way to achieve this:

(grvecs
 (cons
   -3
   (apply
     'append
     (mapcar 'list bply-verts (cons (last bply-verts) bply-verts))
   )
 )
)

4.

To get the wipeouts produced by MkWipeout to display properly I have to add (70 . 7) to the entmakex list:

(defun MkWipeout (lst lay / c m p)
 (setq
   lst (cons (last lst) lst)
   p (apply 'mapcar (cons 'min lst))
   m (apply 'max (mapcar '- (apply 'mapcar (cons 'max lst)) p))
   c (mapcar '+ p (list (/ m 2.0) (/ m 2.0)))
 )
 (entmakex
   (append
     (list
       '(000 . "WIPEOUT")
       '(100 . "AcDbEntity")
       '(100 . "AcDbWipeout")
       (cons 8 lay)
       (cons 10 (trans p 1 0))
       (cons 11 (trans (list m 0.0) 1 0))
       (cons 12 (trans (list 0.0 m) 1 0))
       '(070 . 7) ; Added.
       '(280 . 1)
       '(071 . 2)
     )
     (mapcar
       (function
         (lambda (x)
           (cons
             14 
             (mapcar '(lambda (a b c) (/ (- a b) c)) x c (list m (- m)))
           )
         )
       )
       lst
     )
   )
 )
)

August 8, 2016

Here is an alternative, using grdraw:

(defun c:test ( / *error* enl enx lst ply pnt )

   (defun *error* ( msg )
       (if (and (= 'ename (type ply)) (entget ply)) (entdel ply))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (redraw) (grtext) (princ)
   )

   (while (setq pnt (getpoint "\nPick a point within a closed boundary <exit>: "))
       (redraw)
       (setq enl (entlast))
       (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" pnt "")
       (if (and (not (eq enl (setq ply (entlast))))
                (setq enx (entget ply))
                (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                (= 1 (logand 1 (cdr (assoc 70 enx))))
           )
           (progn
               (mapcar
                  '(lambda ( a b ) (grdraw a b 3 1))
                   (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx)))
                   (cons (last lst) lst)
               )
               (LM:polywipeout lst)
               (grtext -1 (strcat "Enclosed area: " (rtos (vlax-curve-getarea ply) 2 0) " m2"))
               (entdel ply)
           )
           (princ "\nNo valid boundary found.")
       )
   )
   (redraw) (grtext) (princ)
)

;; Polygonal Wipeout  -  Lee Mac
;; Constructs a polygonal wipeout with vertices positioned at the supplied coordinates.
;; l - [lst] List of wipeout vertices (UCS)

(defun LM:polywipeout ( l / c m p )
   (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)))
   )
   (entmakex
       (append
           (list
              '(000 . "WIPEOUT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbWipeout")
               (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)
              '(070 . 7)
              '(071 . 2)
           )
           (mapcar
               (function
                   (lambda ( x )
                       (cons 14 (mapcar '(lambda ( a b c ) (/ (- a b) c)) x c (list m (- m))))
                   )
               )
               l
           )
       )
   )
)

(vl-load-com) (princ)

PS: FWIW, the wipeout code is actually mine from this thread.

August 8, 2016

3.

The function grvecs requires a list in different format.

In your initial post you have:

(grvecs (list -3 (list ptA ptB ptC ptD)))

This must be:

(grvecs (list -3 ptA ptB ptB ptC ptC ptD ptD ptA))

One way to achieve this:
(grvecs
 (cons
   -3
   (apply
     'append
     (mapcar 'list bply-verts (cons (last bply-verts) bply-verts))
   )
 )
)

Thanks alot for your revision and help, Roy!

The automation error disappeared when using correctly grvecs or grdraw from the solutions above.

I'm not that good with list manipulation, obviously and I'm happy that theres one more experienced LISPer in this forum who replies.

Here is an alternative, using grdraw:

(defun c:test ( / *error* enl enx lst ply pnt )

   (defun *error* ( msg )
       (if (and (= 'ename (type ply)) (entget ply)) (entdel ply))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (redraw) (grtext) (princ)
   )

   (while (setq pnt (getpoint "\nPick a point within a closed boundary <exit>: "))
       (redraw)
       (setq enl (entlast))
       (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" pnt "")
       (if (and (not (eq enl (setq ply (entlast))))
                (setq enx (entget ply))
                (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                (= 1 (logand 1 (cdr (assoc 70 enx))))
           )
           (progn
               (mapcar
                  '(lambda ( a b ) (grdraw a b 3 1))
                   (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx)))
                   (cons (last lst) lst)
               )
               (LM:polywipeout lst)
               (grtext -1 (strcat "Enclosed area: " (rtos (vlax-curve-getarea ply) 2 0) " m2"))
               (entdel ply)
           )
           (princ "\nNo valid boundary found.")
       )
   )
   (redraw) (grtext) (princ)
)

;; Polygonal Wipeout  -  Lee Mac
;; Constructs a polygonal wipeout with vertices positioned at the supplied coordinates.
;; l - [lst] List of wipeout vertices (UCS)

(defun LM:polywipeout ( l / c m p )
   (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)))
   )
   (entmakex
       (append
           (list
              '(000 . "WIPEOUT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbWipeout")
               (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)
              '(070 . 7)
              '(071 . 2)
           )
           (mapcar
               (function
                   (lambda ( x )
                       (cons 14 (mapcar '(lambda ( a b c ) (/ (- a b) c)) x c (list m (- m))))
                   )
               )
               l
           )
       )
   )
)

(vl-load-com) (princ)

PS: FWIW, the wipeout code is actually mine from this thread.

Sorry for the created confusion, Lee.. I was refering to CAB's subfunction - created from your original wipeout code (I took it from the same thread) but now I'll use your LM:polywipeout instead.

Aaand thanks for the alternative code!

My initial idea was to create a wipeout from a closed polyline, but then I've decided to put some practice with using grvecs and grtext.

Now the funny thing is that all of the posted solutions work, but won't entmakex the actual wipeout (atleast when I try on my computer). Can anyone confirm this?

Sign In

Grvecs on polyline

Recommended Posts

Grrr

Roy_043

Grrr

Grrr

Roy_043

Lee Mac

Grrr

Join the conversation

Tutorials

Forums

Activity