Create a region with polyline

[robierzo]

Hello. Why doesn't this code work to create a region from a polyline? Thanks

(setq poly_p (entsel "\nSelecciona una parcela exterior: "))
(setq nombre_ent (car poly_p))
(setq obj_n (vlax-ename->vla-object nombre_ent))
(vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj_n))

 

Create a region.dwg

[mhupp]

Works for me. tho I have other lisp that have this already add (vl-load-com)

vl-load-com is need with commands that start with vla, vlax, vlr or it will error out.

 

(defun C:foo ()
  (vl-load-com)
  (setq poly_p (entsel "\nSelecciona una parcela exterior: "))
  (setq nombre_ent (car poly_p))
  (setq obj_n (vlax-ename->vla-object nombre_ent))
  (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj_n))
  (princ)
)

 

Edited July 29, 2021 by mhupp
princ

[robierzo]

Forgiveness mhupp. I uploaded the wrong file. The file is this. Thanks.

Create a region rev01.dwg

[mhupp]

Still works. maybe what your selecting isn't a poly or closed all the way. I know if you try to region a open poly in BricsCAD it just deletes it

 

Edited July 29, 2021 by mhupp

[robierzo]

Thanks a lot, mhupp. I do not know what's going on. It doesn't work for me. If I use the code with other polylines, it works. But with this polyline it doesn't work for me. Perhaps it is because this polyline has repeated vertices.
Thank you anyway.

[confutatis]

The mhupp command works fine, in fact the polyline in question has repeated vertices. I have created a program to remove duplicate vertices from polylines, but it is much easier to use the BOUNDARY command in this case.

[mhupp]

5 hours ago, robierzo said:

Thanks a lot, mhupp. I do not know what's going on. It doesn't work for me. If I use the code with other polylines, it works. But with this polyline it doesn't work for me. Perhaps it is because this polyline has repeated vertices.
Thank you anyway.

 

Maybe use overkill on that polyline then see if that helps.

[ronjonp]

If you use the region command it gives you a clue as to why it won't work:

Quote

    Vertex with degree greater than two    : 1 loop.

 

[robierzo]

Thanks ronjonp. You are right. I think I should remove the repeated vertices.

Does anyone have an app to remove repeated points from a lwpolyline?

THANKS!!!!

Edited July 31, 2021 by robierzo

[confutatis]

2 hours ago, robierzo said:

Thanks ronjonp. You are right. I think I should remove the repeated vertices.

Does anyone have an app to remove repeated points from a lwpolyline?

THANKS!!!!

 

I had written this a while back, I should pick it up for a moment. It used several custom functions, it will be to make it "lighter".

[confutatis]

This is the program I use to eliminate duplicate vertices in polylines. You must also take into account the various bulges, because when vertices are eliminated, they move up in position depending on the vertices eliminated. No, I don't have time to work on this programme. It's a bit long, it can certainly be shortened, I'll leave it to the experts to improve it. However, it should already work like this, in programmes the conditional is a must!

 

NOTICE:
Some support functions may be missing. Please advise...

 

(defun C:ELVERPOL (/ gru indice	ent listacoo lbulge ldist nuovalistacoo	nuovalbulge nuovaldist index
		     nuovalistacoo1)
 (vl-load-com)
 (if (not (setq gru (ssget '((0 . "POLYLINE,LWPOLYLINE")))))
  (vl-exit-with-error "")
 ) 
 (repeat (setq indice (sslength gru))
  (setq	ent (ssname gru (setq indice (1- indice)))
        listacoo (listacoord ent)
       	lbulge (listabulge ent)
	ldist  (listadist ent)
  )
  (cond
   ((equal (car listacoo) (last listacoo) 0.0001)
    (setq listacoo (reverse (cdr (reverse listacoo))))
    (vla-put-Closed (vlax-ename->vla-object ent) :vlax-true)
    (setq lbulge (reverse (cdr (reverse lbulge))))
   )
  )
  (setq	nuovalistacoo nil nuovalbulge nil nuovaldist nil index 0)
  (foreach elem	ldist
   (if (not (zerop elem))
    (progn
     (setq nuovalbulge	 (cons (nth index lbulge) nuovalbulge)
	   nuovalistacoo (cons (nth index listacoo) nuovalistacoo)
     )
    )
   )
   (setq index (1+ index))
  )
  (if (= (vla-get-Closed (vlax-ename->vla-object ent)) :vlax-true)
   (progn
    (setq nuovalbulge (reverse nuovalbulge))
    (setq nuovalistacoo (reverse nuovalistacoo))
   )
   (progn
    (setq nuovalbulge (reverse (cons (last lbulge) nuovalbulge)))
    (setq nuovalistacoo (reverse (cons (last listacoo) nuovalistacoo)))
   )
  )
  (vla-put-Coordinates (vlax-ename->vla-object ent) (lista2variant nuovalistacoo))
  (setq index 0)
  (foreach elem	nuovalbulge
   (vla-SetBulge (vlax-ename->vla-object ent) index elem)
   (setq index (1+ index))
  )
  (setq nuovalistacoo1 (remove-double-point nuovalistacoo 0.001))
  (vla-put-Coordinates (vlax-ename->vla-object ent) (lista2variant nuovalistacoo1))
 )
 (princ)
)

;;; support functions

(defun variant2lista2d (listavariant)
 (lista2d (vlax-safearray->list (variant-value listavariant))
 )
)

(defun lista2d (lst)
 (if lst
  (cons	(list (car lst) (cadr lst))
	(lista2d (cddr lst))
  )
 )
)

(defun variant2lista3d (listavariant)
 (lista3d (vlax-safearray->list (variant-value listavariant))
 )
)

(defun lista3d (lst)
 (if lst
  (cons	(list (car lst) (cadr lst) (caddr lst))
	(lista3d (cdddr lst))
  )
 )
)

(defun lista2variant (listanormale / array)
 (setq listanormale (apply 'append listanormale))
 (setq array (vlax-make-safearray
	      vlax-vbDouble
	      (cons 0 (- (length listanormale) 1))
	     )
 )
 (vlax-make-variant (vlax-safearray-fill array listanormale))
)

(defun listabulge (polilinea / indicebulge lbulge)
 (setq indicebulge 0)
 (repeat (length (listacoord polilinea))
  (setq	lbulge (cons (vla-getbulge
		      (vlax-ename->vla-object polilinea)
		      indicebulge
		     )
		     lbulge
	       )
  )
  (setq indicebulge (1+ indicebulge))
 )
 (setq lbulge (reverse lbulge))
)

(defun listadist (polilinea / lcw listadist lungtot)
 (setq lprog (listaprog polilinea))
 (setq index 0)
 (setq ldist '())
 (while	(< (1+ index) (length lprog))
  (setq ldist (cons (- (nth (1+ index) lprog) (nth index lprog)) ldist))
  (setq index (1+ index))
 )
 (setq ldist (reverse ldist))
)

(defun listaprog (polilinea / lcw lprog lungtot)
 (setq lcw     (mapcar '(lambda (elem) (variant2punto elem))
		       (mapcar
			'(lambda (elem)
			  (vla-TranslateCoordinates
			   utility
			   (vlax-3d-point elem)
			   acOCS
			   acworld
			   :vlax-false
			   (vla-get-Normal (vlax-ename->vla-object polilinea))
			  )
			 )
			(listacoord polilinea)
		       )
	       )
       lprog   (mapcar '(lambda	(elem)
			 (vlax-curve-getdistatpoint (vevo polilinea) elem)
			)
		       lcw
	       )
       lungtot (vla-get-Length (vevo polilinea))
 )
 (cond
  ((and	(not (equal (car (listacoord polilinea))
		    (last (listacoord polilinea))
		    0.0001
	     )
	)
	(= (vla-get-Closed (vevo polilinea)) :vlax-true)
   )
   (setq lprog (consr lungtot lprog))
  )
  ((equal (car (listacoord polilinea))
	  (last (listacoord polilinea))
	  0.0001
   )
   (setq lprog (consr lungtot (erlast lprog)))
  )
 )
 lprog
)

(defun vl-remove-n (numero listan / contatore)
 (setq contatore -1)
 (vl-remove-if
  '(lambda (elemento)
    (= numero (setq contatore (1+ contatore)))
   )
  listan
 )
)

(defun remove-double-point (lst1 fuzz / lst2 lst3 index elem)
 (setq lst2 lst1
       lst3 nil
 )
 (while	lst2
  (setq lst3 (cons (car lst2) lst3))
  (setq elem (car lst2))
  (setq lst2 (cdr lst2))
  (setq index 0)
  (if lst2
   (repeat (length lst2)
    (if	(equal elem (nth index lst2) fuzz)
     (progn
      (setq lst2 (vl-remove-n index lst2))
      (setq index (1- index))
     )
    )
    (setq index (1+ index))
   )
  )
 )
 (reverse lst3)
)

(defun listacoord (ent / coord)
 (vl-load-com)
 (cond
  ((or (equal (vla-get-ObjectName (vlax-ename->vla-object ent)) "AcDb3dPolyline")
       (equal (vla-get-ObjectName (vlax-ename->vla-object ent)) "AcDb2dPolyline")
   )    
   (setq coord (variant2lista3d (vla-get-coordinates (vlax-ename->vla-object ent))))
  )
  ((equal (vla-get-ObjectName (vlax-ename->vla-object ent)) "AcDbPolyline")
   (setq coord (variant2lista2d (vla-get-coordinates (vlax-ename->vla-object ent))))
   ;;;(setq coord (mapcar '(lambda (elem)(list (car elem)(cadr elem)(vla-get-Elevation (vlax-ename->vla-object ent)))) coord))
  )
  ((equal (vla-get-ObjectName (vlax-ename->vla-object ent)) "AcDbFace")
   (setq coord (variant2lista3d (vla-get-coordinates (vlax-ename->vla-object ent))))
   (setq coord (reverse (cdr (reverse coord)))) 
  )
  ((equal (vla-get-ObjectName (vlax-ename->vla-object ent)) "AcDbLine")
   (setq coord (list (variant2punto (vla-get-StartPoint (vlax-ename->vla-object ent)))
		     (variant2punto (vla-get-EndPoint (vlax-ename->vla-object ent)))
	       )	   
   )
  )
  ((equal (cdr(assoc 0 (entget ent))) "WIPEOUT")
   (setq coord (cdr (mapcar 'cdr (member (assoc 14 (entget ent))(entget ent)))))
  )
 )
 coord
)

 

Edited August 2, 2021 by confutatis

[robierzo]

Hello Confutatis. After selecting the polyline it gives me an error: "tipo de argumento erróneo: FILE nil"

Actually, in my case they are just lwpolylines. I don't handle polylines.
Thanks.

 

Edited August 1, 2021 by robierzo

[confutatis]

 

Send me a piece of drawing that I check, however, I have reinserted the program in the previous post.

Edited August 2, 2021 by confutatis

[robierzo]

polyline with multiple repeating vertices

polyline with multiple repeating vertices.dwg

[confutatis]

Ah, always the same... but the command works, try to see!

Edited August 2, 2021 by confutatis

[ronjonp]

10 hours ago, robierzo said:

polyline with multiple repeating vertices

polyline with multiple repeating vertices.dwg 72.25 kB · 1 download

You can try this to remove duplicate vertices. Probably won't work on polylines that have bulges and did not fix the error in your sample drawing when creating the region.

(defun c:foo (/ a f o p r s)
  ;; RJP » 2021-08-02
  ;; Remove duplicate polyline vertexes
  (cond	((setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq p (vlax-get (setq o (vlax-ename->vla-object e)) 'coordinates)
		 r nil
		 f nil
	   )
	   (while (cadr p)
	     (setq r (cons (setq a (mapcar '+ p '(0 0))) r)
		   p (cddr p)
	     )
	     (while (equal a (mapcar '+ p '(0 0)) 1e-8)
	       (setq f (setq p (cddr p)))
	       (print "Duplicate Vertex Removed")
	     )
	   )
	   (and f (vlax-put o 'coordinates (apply 'append (reverse r))))
	 )
	)
  )
  (princ)
)

 

[robierzo]

Hi ronjonp. Vertex number 24 and vertex number 26 are repeated, but it does not eliminate them.
Thank you for your trouble.

The confutatis routine doesn't work for me. I do not know why. 

[confutatis]

The routine has to work, I worked on the drawing you gave me, I edited my previous post, the one with the program, I don't know if you did copy-paste the new one. I'll take another look now, but it looks to me like all the custom functions are loaded.

Edited August 3, 2021 by confutatis

[ronjonp]

9 hours ago, robierzo said:

Hi ronjonp. Vertex number 24 and vertex number 26 are repeated, but it does not eliminate them.
Thank you for your trouble.

The confutatis routine doesn't work for me. I do not know why. 

Use overkill .. those polylines are a mess.

[robierzo]

Hello. In the end I have succeeded. This is what I was looking for. I have included a margin of tolerance so that it eliminates the points that do not fulfill a minimum distance. I have used ronjonp's statement "(vlax-put obj 'coordinates (apply 'append nuevalista_pt))", and I have solved it. Thank you very much to all.

 

(defun c:elptlw ()
  (setq margen_error 0.005)
  (setq nuevalista_pt nil)
  (setq ent (car(entsel"\nSelecciona lwpolyline: ")))
  (setq obj (vlax-ename->vla-object ent))
  (setq lista_ent (entget ent))
  ;lista_puntos lwpolyline
  (foreach elemento_n lista_ent
    (cond ((=(car elemento_n) 10)
       (if (null (member t (mapcar '(lambda (pt) (< (distance (cdr elemento_n) pt) margen_error)) nuevalista_pt )))
             (setq nuevalista_pt (cons (cdr elemento_n) nuevalista_pt)) 
           )
      )
    )
  );fin Foreach
  (setq nuevalista_pt (reverse nuevalista_pt))
  (vlax-put obj 'coordinates (apply 'append nuevalista_pt))  
)