Aller au contenu

DECOMPOSITION DES REGIONS


zara

Messages recommandés

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)))
   )
 )

Lien vers le commentaire
Partager sur d’autres sites

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

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

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.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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

ZW France est le distributeur de ZWCAD, ZW3D et ARCHLine en France, Belgique francophone, Suisse francophone, et Afrique francophone.

www.zwfrance.fr

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

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

ZW France est le distributeur de ZWCAD, ZW3D et ARCHLine en France, Belgique francophone, Suisse francophone, et Afrique francophone.

www.zwfrance.fr

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité