DECOMPOSITION DES REGIONS

zara · le 5 juillet 2017

Bonjour,

Je suis sur ZWCAD les lisp fonctionnent plutôt bien mise à part une qui me serai très utile:

Region2Polyline by Gile.

Elle se lance bien me filtre bien les regions mais rien de plus les régions restent des regions...

Pensez vous qu'il est possible de selectionner les regions et de les décomposer par la suite en modifiant le code.

Je suis vraiment pas au point pour déchiffrer et modifier un tel code... :blink:

Merci par avance pour la réponse

Zara

(defun c:Region2Polyline nil
 (if (setq ss (ssget '((0 . "REGION"))))
   (:Region2Polyline ss))
 (princ)
 )

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline (ss / *error* arcbugle acdoc space
		 n reg norm expl olst blst dlst plst tlst blg pline)
 
 ;-----
 (defun *error* (msg)
   (if	(/= msg "Function cancelled")
     (princ (strcat "\nError: " msg)))
   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
   (princ))
 
 ;-----
 (defun arcbulge (arc)
   (/ (sin (/ (vla-get-TotalAngle arc) 4))
      (cos (/ (vla-get-TotalAngle arc) 4))))
 
 ;-----
 ;-----
 
 (setq	acdoc	(vla-get-ActiveDocument (vlax-get-acad-object))
space	(if (= 1 (getvar "CVPORT"))
	  (vla-get-PaperSpace acdoc)
	  (vla-get-ModelSpace acdoc)))
 (if ss
   (repeat (setq i (sslength ss))
     (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
    norm (vlax-get reg 'Normal)
    expl (vlax-invoke reg 'Explode))
     (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
			     (= (vla-get-ObjectName x) "AcDbArc")))
	    expl)
(progn
  (vla-delete reg)
  (setq olst (mapcar '(lambda	(x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
		     expl))
  (while olst
    (setq blst nil)
    (if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
      (setq blst (list (cons 0 (arcbulge (caar olst))))))
    (setq plst (cdar olst)
	  dlst (list (caar olst))
	  olst (cdr olst))
    (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
						     (equal (last plst) (caddr x) 1e-9)))
			olst))
      (if (equal (last plst) (caddar tlst) 1e-9)
	(setq blg -1)
	(setq blg 1))
      (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
	(setq blst (cons (cons (1- (length plst))
			       (* blg (arcbulge (caar tlst)))
			       )
			 blst)))
      (setq plst (append plst
			 (if	(minusp blg)
			   (list (cadar tlst))
			   (list (caddar tlst))))
	    dlst (cons (caar tlst) dlst)
	    olst (vl-remove (car tlst) olst)))
    (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
										     (setq x (trans x 0 Norm))
										     (list (car x) (cadr x)))
										  (reverse (cdr (reverse plst)))))))
    (vla-put-Closed pline :vlax-true)
    (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
    (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
    (vla-put-Normal pline (vlax-3d-point Norm))
    (mapcar 'vla-delete dlst)))
(mapcar 'vla-delete expl)))
   )
 )

lecrabe · le 5 juillet 2017

Hello

La routine R2PL (Region To PLine) de Gilles a ete ecrite en 2007

et elle utilise des fonctions VL qui sont sans doute absentes de ZWCAD !?

SEUL Gilles pourrait la modifier (ou un autre Grand Maitre du Lisp/VLisp) ...

Pour Info, cette routine est encore operationnelles AUJOURD'HUI sur un AutoCAD 2018

MAIS BIEN SUR elle ne traite que la partie SEGMENT des Regions !

Bye, lecrabe

(gile) · le 5 juillet 2017

Salut,

Petite précision : la routine ne fonctionne (sur AutoCAD) qu'avec des régions uniquement composées de lignes et arcs (ou polylignes) puisque les polylignes ne peuvent être composées que d'arcs et de segments droits.

En ce qui concerne son fonctionnement sur ZWCAD je peux pas en dire plus, (les versions d'évaluation que j'avais installé pour faire des tests ont expiré), mais il me semble bien que la plupart des fonctions Visual LISP (COM/ActiveX) étaient supportées.

Peut-être voir directement avec le support ZWCAD qui avait affiché une volonté de résoudre rapidement les problèmes de compatibilité des routines LISP.

ZWCAD-France · le 7 juillet 2017

Bonjour,

oops je n'avais pas vu ce post depuis avant-hier, désolé du retard, Zara.

Du coup, oui, bien sûr ZWCAD a bien les VLA mais le code a été complété par Arphone (notre grand Maitre Lisp chinois à nous).

Donc voici le code qui marche sans soucis sur la 2017 : il filtre, décompose les régions que l'on retrouve sous forme de polylignes ( je ne l'ai pas testé sur AutoCad).

(defun c:Region2Polyline nil
 (if (setq ss (ssget '((0 . "REGION"))))
   (:Region2Polyline ss))
 (princ)
 )

;; Gilles Chanteau- 01/01/07
(defun :Region2Polyline (ss / *error* arcbugle acdoc space
                        n reg norm expl olst blst dlst plst tlst blg pline)
 
 ;-----
 (defun *error* (msg)
   (if (/= msg "Function cancelled")
     (princ (strcat "\nError: " msg)))
   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
   (princ))
 
 ;-----
 (defun arcbulge (arc)
   (/ (sin (/ (vla-get-TotalAngle arc) 4))
      (cos (/ (vla-get-TotalAngle arc) 4))))

 ;-----
 (defun explodeRegion(reg / ret)
   (setq en (entlast))
   (command "_explode" (vlax-vla-object->ename reg) "")
   (setq ret nil)
   (while (setq en (entnext en))
     (setq ret (cons (vlax-ename->vla-object en) ret))
   )
   ret
 )  
 ;-----
 ;-----
 
 (setq acdoc   (vla-get-ActiveDocument (vlax-get-acad-object))
       space   (if (= 1 (getvar "CVPORT"))
                 (vla-get-PaperSpace acdoc)
                 (vla-get-ModelSpace acdoc)))
 (if ss
   (repeat (setq i (sslength ss))
     (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))
           norm (vlax-get reg 'Normal)
           expl (explodeRegion reg);|(vlax-invoke reg 'Explode)|;)
     (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine")
                                    (= (vla-get-ObjectName x) "AcDbArc")))
                   expl)
       (progn
         ;(vla-delete reg)
         (setq olst (mapcar '(lambda   (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)))
                            expl))
         (while olst
           (setq blst nil)
           (if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
             (setq blst (list (cons 0 (arcbulge (caar olst))))))
           (setq plst (cdar olst)
                 dlst (list (caar olst))
                 olst (cdr olst))
           (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
                                                            (equal (last plst) (caddr x) 1e-9)))
                               olst))
             (if (equal (last plst) (caddar tlst) 1e-9)
               (setq blg -1)
               (setq blg 1))
             (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
               (setq blst (cons (cons (1- (length plst))
                                      (* blg (arcbulge (caar tlst)))
                                      )
                                blst)))
             (setq plst (append plst
                                (if    (minusp blg)
                                  (list (cadar tlst))
                                  (list (caddar tlst))))
                   dlst (cons (caar tlst) dlst)
                   olst (vl-remove (car tlst) olst)))
           (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x)
                                                                                            (setq x (trans x 0 Norm))
                                                                                            (list (car x) (cadr x)))
                                                                                         (reverse (cdr (reverse plst)))))))
           (vla-put-Closed pline :vlax-true)
           (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
           (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
           (vla-put-Normal pline (vlax-3d-point Norm))
           (mapcar 'vla-delete dlst)))
       (mapcar 'vla-delete expl)))
   )
 )

Sinon, Gile, comme ZWCAD fonctionne toujours après la période d'essai (limité à l'enregistrement de 1000 objets) on peut continuer à tester des Lisps ou autre sans problème.

Cela étant, nous sommes très heureux de fournir des licences gratuites NFR aux développeurs qui le souhaitent. Ces licences sont full, mais sont limitées à 1 an de validité.

Dernier point, la 2018 de ZWCAD est prévue de sortir mi Aout ( ... oui je sais).

Nous prévoyons donc une grande tournée des plages avec avion et banderoles :(rires forts):

http://www.cielmapub.fr/resources/images/logo.png

Au plaisir

Patrick Miault

zara · le 7 juillet 2017

Bonjour,

Merci beaucoup pour cette réponse cela fonctionne parfaitement. :D

J'en profite d'avoir Patrick de ZWCAD sous la main pour lui demander si il serai possible pour l'achat de deux licenses de réaliser une demande spécifique.

Je souhaiterai utiliser de manière intensive le convertisseur de calque dans Norme CAO.

Hélas la fenêtre ne peux s’agrandir comme sur autocad...

Pensez vous que cela serai possible?

Merci encore pour le lisp.

Bien cordialement

Zara

ZWCAD-France · le 7 juillet 2017

La question a été posée à ZWSOFT et nous en saurons plus Lundi ( sur la 2018).

Par contre c'est agaçant, car cette case de dialogue était étirable dans la 2015 ....

Bon week-end

Patrick

lecrabe · le 8 juillet 2017

Hello Gilles

Comme d'habitude, tu as parfaitement raison !

Ta routine est capable de "regenerer" des Polylignes 2D avec Segments ET ARCS !!

Encore MERCI pour ton Partage ...

Bon We, Bye, lecrabe

Connexion

DECOMPOSITION DES REGIONS

Messages recommandés

zara

lecrabe

(gile)

ZWCAD-France

zara

ZWCAD-France

lecrabe

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante