Aller au contenu

devoir de vacances objet 3d


x_all

Messages recommandés

Bonjour

 

je cherche à faire une somme de longueur de solide3d.

Ces solides sont tous des extrusions.

J'ai chercher à faire un Dump des propriétés ou de chercher les codes DXF d'un cylindre (extrusion d'un cercle) mais pas moyen de trouver une définition du diamètre du cercle avec ces deux méthodes.

D'ou ma question, peut on retrouver la polyligne à l'origine de l'extrusion pour l'utiliser dans un lisp?

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

À ma connaissance, il n'y a rien en AutoLISP / Visual LISP pour récupérer ce type de données géométriques.

C'est pourquoi, j'avais essayé d'exposer à AutoLISP l'API .NET BREP (Boundary REPresentation, ou représentation du contour en français). Voir ce sujet.

 

Cette routine devrait retourner une liste de deux listes "type DXF" pour les bases (cercles ou ellipses) d'un solide 3d figurant un cylindre ou d'un cône troqué.

 

;; getWindingLoops
;; Retourne une liste contenant les données des deux 'boucles d'enroulement' (cercle ou ellipse)
;; d'un cône tronqué ou d'un cylindre (Solide3d)
;;
;; Argument
;; brepList une liste telle que retournée par la fonction gc-brep
(defun getWindingLoops (brepList / shells faces)
 (if (and (= (car brepList) "COMPLEX")                 ; une seule entrée COMPLEX
          (= (length (setq shells (cdr brepList))) 1)  ; une seule enveloppe ("SHELL")
          (= (length (setq faces (cdar shells))) 3)    ; 3 faces
     )
   (mapcar 'cadr (cdar (vl-remove-if-not '(lambda (x) (= (caadr x) "LOOPWINDING")) faces)))
 )
)

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

Encore une fois merci...

 

Je cherchai déja des pistes avec des blocs étirables pour modéliser ces cylindres, mais les mailles pour faire des tubes, ça à l'inconvénient d'être beaucoup plus lourd si on veux un rendu un peu lisse.

 

ça à l'air tout simple comme ça mais je n'ose imaginer la tambouille derrière tes lispextensions. En tout cas, le résultat est miraculeux

 

merci merci merci...

 

 

Lien vers le commentaire
Partager sur d’autres sites

plop...

je ne suis pas arrivé à faire fonctionner getWindingLoops, par contre, je suis arrivé à me dépatouillé avec gc-brep.

Le but du jeu était de faire des métrés d'une solution 3D alternative à révit (oui revit, c'est l'avenir, mais j'ai pas d'entreprises sous la main pour franchir le pas et déja la 3d sour autocad ça leur fait un peu peur mais ce n'est pas le débat svp)

l'exemple qui m'occupe est ici

joch04.free.fr/tmp/combles3d.dwg

j'arrive au bout d'un code qui marche a peu près pour peut qu'on respecte les modalités de création du projet, que je détaillerai si du monde est intéressé.Il me reste un truc à faire, mais je ne sais pas comment m'en sortir. c'est de trier la liste finale pour la rendre présentable..Grace à un bout de code piqué sur un programme de (gile) cette routine exporte un CVC et je fait ce trie sous excel, mais pour l’intérêt pédagogique, j'aurai bien aimer savoir comment ou pourrait faire.

la sortie du programme est une suite de liste à cette forme

:type;dim;dim2;longueur;nombrecyl;0.25;0.25;4.57;1

reduc;0.44;0.60;np;1

cyl;0.60;0.60;4.000;4

0.4x0.5;0.4;0.5;1.500;3

reduc;1.14;0.60;np;2

cyl;0.40;0.40;1.000;3

cd-3d-90;0.450;0.450;0.0;4

cd-3d-45;0.315;0.315;0.0;1

j'aurai aimé regrouper les types par ordre alfa, et en second critère dim par diamètre croissant...

Voici le code(je ne doute pas que les puriste vont le trouvé un peu lourd, mais je fait ce que je peux à mon petit niveau et reste ouvert à la critique)

;;;  MG métré de gaine 3d, exemple ici joch04.free.fr/tmp/combles3d.dwg
;;; version "work in progress" à compléter par des règles de construction du modèle
;;; les variables sont pas super callées et il en reste qui ne servent qu'aux test et débuggage
;;; remercimenemts à cadXp en général; (gile) en particulier et menstion spéciale à LeeMac pour les longueus de blocs dynamiques
;;;http://cadxp.com/topic/46322-devoir-de-vacances-objet-3d/page__pid__270178#entry270178
;;;http://cadxp.com/topic/39982-metres-block-dynamique/
;;;http://cadxp.com/topic/34377-automatisation-de-metres/
;;;
;;;   ...

(defun c:mg (/ ssel ent j lsol ldata toto)

				; initialisation VL
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)		; Activer le début de l'undo


				; sélection des éléments on ne garde que les blocs et les solides
 (while (not ssel)
(setq ssel (ssget '((0 . "3DSOLID,INSERT"))))
 )
 (setq j 0)
 (repeat (sslength ssel)
(setq ent (ssname ssel j))
(if	(=
 	"3DSOLID"
 	(cdr (assoc 0 (entget ent)))
)
 	(progn
(setq lsol (list (traite-solide ent)))
(setq ldata (append lsol ldata))
 	)
 	(progn
(setq lsol (list (traite-bloc ent)))
(setq ldata (append lsol ldata))
 	)
)
				;	(print ldata)

(setq j (+ 1 j))
 )					;f repeat

 (setq ldata (consolidation ldata))

 (ecrit-fichier ldata)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun consolidation (lst / nlst i tour ty d1 d2 l el nel test nb nty nd1 nd2 nl nnb)

 (setq	nlst (list (car lst))
lst  (cdr lst)
 )
 (setq tour 1)
 (foreach el lst
(setq ty   (car el)
 	d1   (cadr el)
 	d2   (caddr el)
 	l	(cadddr el)
 	nb   (last el)
 	test 0
)

(foreach nel nlst
 	(setq nty	(car nel)
	nd1	(cadr nel)
	nd2	(caddr nel)
	nl	(cadddr nel)
	nnb	(last nel)
 	)


 	(cond
;; si même nom même d1 (pour les cylindres) et pas une réduction ni un coude
((and (= nty ty) (= nd1 d1) (/= ty "reduc") (/= "cd" (substr ty 1 2)))
	(setq nl   (rtos (+ (atof nl) (atof l)))
  		nnb  (+ 1 nnb)
  		test 1
	)
	(setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)				; c1


;; si une réduction avec le même d1.	
((and (= nty ty) (= ty "reduc") (= nd1 d1))
	(setq nnb  (+ 1 nnb)
  		test 1
	)
	(setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)				;c2
;; si coude
((and (= nty ty)  (= "cd" (substr ty 1 2)) (= nd1 d1))
	(setq nnb  (+ 1 nnb)
  		test 1
	)
	(setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)

(t)
 	)					; f cond

)
				; f foreach nel
(setq tour (+ 1 tour))
(if	(= 0 test)
 	(setq nlst (append (list el) nlst))
)
 )					;f foreach el

 (print nlst)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun traite-bloc (ent / Vba-ent ty d1 d2 l nb px)
 (setq	d1 "np"
d2 "np"
l  "0.0"
nb 1
 )
 (setq	Vba-ent	(vlax-ename->vla-object ent)
ty	(vla-get-effectivename Vba-ent)
 )
 (cond
;; si coude
((= "cd" (substr ty 1 2))
	(setq d1 (rtos (cdr (assoc 41 (entget ent))))
  	d2 d1
	)
)
;;si bloc dynamique avec un x dnas le nom
((and (= (vla-get-isdynamicblock Vba-ent) :vlax-true)
(/= nil (vl-string-position (ascii "x") ty))
	)
	(setq px (vl-string-position (ascii "x") ty))
	(setq l (rtos (LM:getdynpropvalue Vba-ent "long") 2 2))
	(setq d1 (substr ty 1 px)
  	d2 (substr ty (+ 2 px) (strlen ty))
	)
)
 )
 (list ty d1 d2 l nb)

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun traite-solide (ent / ls-brep c1 c2 ty d1 d2 l nb)
 (setq ls-brep (cddr (car (cdr (gc-brep ent)))))
 (Setq	c1 (car (cdr (car (cdr (car ls-brep)))))
c2 (car (cdr (car (cdr (cadr ls-brep)))))
 )

 (Setq	d1 (rtos (round (* 2 (cdr (assoc 40 c1))) 0.005) 2 2)
d2 (rtos (round (* 2 (cdr (assoc 40 c2))) 0.005) 2 2)
l  (rtos (distance (cdr (assoc 10 c1)) (cdr (assoc 10 c2))) 2 2)
Nb 1
 )

 (if (/= d1 d2)
(setq ty "reduc"
 	l  "np"
)
(setq ty "cyl")
 )

 (list ty d1 d2 l nb)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue (blk prp)
 (setq prp (strcase prp))
 (vl-some '(lambda (x)
 		(if (= prp (strcase (vla-get-propertyname x)))
	(vlax-get x 'value)
 		)
	)
  	(vlax-invoke blk 'getdynamicblockproperties)
 )
)



;;; ROUND (gile)                                            	
;;; Arrondit à la valeur la plus proche en fonction de prec 	
;;; (round pi 0.01) -> 3.14                     				
;;; (round pi 1e-5) -> 3.14159                              	
;;; (round 5456.50 1) -> 5457                   				
;;; (round 5456.50 100.0) -> 5500.0             				

(defun round (num prec)
 (if (zerop (setq prec (abs prec)))
num
(* prec
  	(fix ((if (minusp num)
  		-
  		+
		)
 		(/ num prec)
 		0.5
	)
  	)
)
 )
)



;;routine d'écriture dans un fichier odieusement pompée de metre_2, lisp de (gile)
;; post d'origine  ici  http://cadxp.com/topic/36638-lisp-calculer-le-metre-de-differente-type-de-ligne-selon-son-calque/

(defun ecrit-fichier (lst / sep filename file l)
 (print lst)
 (setq	sep 	(vl-registry-read
      	"HKEY_CURRENT_USER\\Control Panel\\International"
      	"sList"
    	)
filename (strcat (getvar 'dwgprefix)
            (vl-filename-base (getvar 'dwgname))
            "_metre.csv"
    	)
file 	(open filename "w")
 )
 (write-line
(strcat "type" sep "dim" sep "dim2" sep "longueur" sep "nombre")
file
 )
 (foreach l lst
(print l)
(write-line
 	(strcat (car l)
 		sep
 		(cadr l)
 		sep
 		(caddr l)
 		sep
 		(cadddr l)
 		sep
 		(itoa (last l))
 	)
 	file
)
 )
 (close file)
 (startapp "notepad" filename)
)

Lien vers le commentaire
Partager sur d’autres sites

bon, je m'auto répond, en re épluchant un post ou (gile) une fois de plus m'avait débloqué pour trier des blocs en ft de leur position X/Y

http://cadxp.com/top...me-de-trie-x-y/

j'ai fini par comprendre comment l'adapter

Du coup ça donne ça.


;;;  MG métré de gaine 3d, exemple ici joch04.free.fr/tmp/combles3d.dwg                   	
;;; cette routine implique l'installation des  LispExtension de (gile)téléchargeable sur cette page.
;;; http://gilecad.azurewebsites.net/DotNet.aspx       	(accès à gc-Brep )             	
;;; version "work in progress" à compléter par des règles de construction du modèle 3d    	
;;; les variables sont pas super calées et il en reste qui ne servent qu'aux test et débuggage
;;; remerciements à cadXp en général; (gile) en particulier et mention spéciale à Lee Mac pour
;;; les longueurs de blocs dynamiques                                                     	
;;;http://cadxp.com/topic/46322-devoir-de-vacances-objet-3d/page__pid__270178#entry270178 	
;;;http://cadxp.com/topic/32932-acceder-aux-donnees-des-solides-3d-fonction-lisp/         	
;;;http://cadxp.com/topic/39982-metres-block-dynamique/                                   	
;;;http://cadxp.com/topic/34377-automatisation-de-metres/                                 	
;;;http://cadxp.com/topic/41466-algorithme-de-trie-x-y/                                   	
;;;   ...




(defun c:mg (/ ssel ent j lsol ldata toto)

				; initialisation VL
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)		; Activer le début de l'undo


				; sélection des éléments on ne garde que les blocs et les solides
 (while (not ssel)
(setq ssel (ssget '((0 . "3DSOLID,INSERT"))))
 )
 (setq j 0)
 (repeat (sslength ssel)
(setq ent (ssname ssel j))
(if	(=
  "3DSOLID"
  (cdr (assoc 0 (entget ent)))
)
 	(progn
(setq lsol (list (traite-solide ent)))
(setq ldata (append lsol ldata))
 	)
 	(progn
(setq lsol (list (traite-bloc ent)))
(setq ldata (append lsol ldata))
 	)
)
				;	(print ldata)

(setq j (+ 1 j))
 )					;f repeat

 (setq ldata (consolidation ldata))

 (setq ldata (Ordone ldata))

 (ecrit-fichier ldata)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;  Ordone ft qui classe la liste suivant ses 2 1er éléments                    	
;;; si elles ont la meme 1ere colonne on classe suivant la 2eme par ordre croissant  
;;; (transfomée de string en réel)                                               	
;;; si non par la 1ere colonne pas ordre décroissant.                            	

(defun Ordone (lst-b / e1 e2)
 (setq	lst-b
 (vl-sort lst-b
	  '(lambda (e1 e2)
	 	(if (equal (car e1) (car e2))

	   	(> (atof (cadr e1)) (atof (cadr e2)))
	   	(< (car e1) (car e2))
	 	)
	   )
 )
 )

)					;fin Ordone




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun consolidation (lst / nlst i tour ty d1 d2 l el nel test nb nty nd1 nd2 nl nnb)

 (setq	nlst (list (car lst))
lst  (cdr lst)
 )
 (setq tour 1)
 (foreach el lst
(setq ty   (car el)
  d1   (cadr el)
  d2   (caddr el)
  l	(cadddr el)
  nb   (last el)
  test 0
)

(foreach nel nlst
 	(setq nty	(car nel)
	nd1	(cadr nel)
	nd2	(caddr nel)
	nl	(cadddr nel)
	nnb	(last nel)
 	)


 	(cond
;; si même nom même d1 (pour les cylindres) et pas une réduction ni un coude
((and (= nty ty) (= nd1 d1) (/= ty "reduc") (/= "cd" (substr ty 1 2)))
 (setq nl   (rtos (+ (atof nl) (atof l)))
   	nnb  (+ 1 nnb)
   	test 1
 )
 (setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)				; c1


;; si une réduction avec le même d1.   
((and (= nty ty) (= ty "reduc") (= nd1 d1))
 (setq nnb  (+ 1 nnb)
   	test 1
 )
 (setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)				;c2
;; si coude
((and (= nty ty) (= "cd" (substr ty 1 2)) (= nd1 d1))
 (setq nnb  (+ 1 nnb)
   	test 1
 )
 (setq nlst (subst (list nty nd1 nd2 nl nnb) nel nlst))
)

(t)
 	)					; f cond

)
				; f foreach nel
(setq tour (+ 1 tour))
(if	(= 0 test)
 	(setq nlst (append (list el) nlst))
)
 )					;f foreach el

 (print nlst)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun traite-bloc (ent / Vba-ent ty d1 d2 l nb px)
 (setq	d1 "0.00"
d2 "0.00"
l  "0.00"
nb 1
 )
 (setq	Vba-ent	(vlax-ename->vla-object ent)
ty	(vla-get-effectivename Vba-ent)
 )
 (cond
;; si coude
((= "cd" (substr ty 1 2))
	(setq d1 (rtos (cdr (assoc 41 (entget ent))) 2 3)
   d2 d1
	)
)
;;si bloc dynamique avec un x dnas le nom
((and (= (vla-get-isdynamicblock Vba-ent) :vlax-true)
  (/= nil (vl-string-position (ascii "x") ty))
	)
	(setq px (vl-string-position (ascii "x") ty))
	(setq l (rtos (LM:getdynpropvalue Vba-ent "long") 2 3))
	(setq d1 (substr ty 1 px)
   d2 (substr ty (+ 2 px) (strlen ty))
	)
)
 )
 (list ty d1 d2 l nb)

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun traite-solide (ent / ls-brep c1 c2 ty d1 d2 l nb)
 (setq ls-brep (cddr (car (cdr (gc-brep ent)))))
 (Setq	c1 (car (cdr (car (cdr (car ls-brep)))))
c2 (car (cdr (car (cdr (cadr ls-brep)))))
 )

 (Setq	d1 (rtos (round (* 2 (cdr (assoc 40 c1))) 0.005) 2 2)
d2 (rtos (round (* 2 (cdr (assoc 40 c2))) 0.005) 2 2)
l  (rtos (distance (cdr (assoc 10 c1)) (cdr (assoc 10 c2))) 2 2)
Nb 1
 )

 (if (/= d1 d2)
(setq ty "reduc"
  l  "np"
)
(setq ty "cyl")
 )

 (list ty d1 d2 l nb)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue (blk prp)
 (setq prp (strcase prp))
 (vl-some '(lambda (x)
  	(if (= prp (strcase (vla-get-propertyname x)))
	(vlax-get x 'value)
  	)
	)
   (vlax-invoke blk 'getdynamicblockproperties)
 )
)



;;; ROUND (gile)                                           	
;;; Arrondit à la valeur la plus proche en fonction de prec	
;;; (round pi 0.01) -> 3.14                                	
;;; (round pi 1e-5) -> 3.14159                             	
;;; (round 5456.50 1) -> 5457                              	
;;; (round 5456.50 100.0) -> 5500.0                        	

(defun round (num prec)
 (if (zerop (setq prec (abs prec)))
num
(* prec
  	(fix ((if (minusp num)
   	-
   	+
 	)
  	(/ num prec)
  	0.5
	)
  	)
)
 )
)



;;routine d'écriture dans un fichier odieusement pompée de metre_2, lisp de (gile)
;; post d'origine  ici  http://cadxp.com/topic/36638-lisp-calculer-le-metre-de-differente-type-de-ligne-selon-son-calque/

(defun ecrit-fichier (lst / sep filename file l)
 (print lst)
 (setq	sep	 (vl-registry-read
	   "HKEY_CURRENT_USER\\Control Panel\\International"
	   "sList"
	 )
filename (strcat (getvar 'dwgprefix)
		 (vl-filename-base (getvar 'dwgname))
		 "_metre.csv"
	 )
file	 (open filename "w")
 )
 (write-line
(strcat "type" sep "dim" sep "dim2" sep "longueur" sep "nombre")
file
 )
 (foreach l lst
(print l)
(write-line
 	(strcat (car l)
  	sep
  	(cadr l)
  	sep
  	(caddr l)
  	sep
  	(cadddr l)
  	sep
  	(itoa (last l))
 	)
 	file
)
 )
 (close file)
 (startapp "notepad" filename)

)




Lien vers le commentaire
Partager sur d’autres sites

laugh.gif je ne suis pas assez à l'aise en lisp pour faire ça au travail, et puis c'est plus pour le fun car j'adore ça. Même si comme à chaque fois je fini par sortir un truc qui me fait gagner beaucoup de temps je le prend pas pour du boulot. En ces périodes de fêtes et de froid j'ai pas mal de temps à glander, j'aime finalement plus ça que les autres activités d'intérieur diurnes. L'été c'est pas pareil, mais là...
Lien vers le commentaire
Partager sur d’autres sites

plop...

je ne suis pas arrivé à faire fonctionner getWindingLoops

 

Si tu passes une liste retournée par gc-brep à getWindingLoops, la fonction renvoie une liste contenant les données DXF des deux 'boucles d'enroulement' du solide, ou nil si ce n'est ni un cylindre ni un cône tronqué.

 

Utilisée dans ta fonction 'traite-solide', ça permet de contrôler si l'entité représente bien un cylindre ou un cône tronqué.

(defun traite-solide (ent / loops c1 c2 ty d1 d2 l nb)
 (if (setq loops (getWindingLoops (gc-brep ent)))
   (progn
     (setq c1 (car loops)
           c2 (cadr loops)
           d1 (rtos (round (* 2 (cdr (assoc 40 c1))) 0.005) 2 2)
           d2 (rtos (round (* 2 (cdr (assoc 40 c2))) 0.005) 2 2)
           l  (rtos (distance (cdr (assoc 10 c1)) (cdr (assoc 10 c2))) 2 2)
           nb 1
     )

     (if (/= d1 d2)
       (setq ty "reduc"
             l  "np"
       )
       (setq ty "cyl")
     )

     (list ty d1 d2 l nb)
   )
 )
)

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

j'ai remplacer traite-solide par ta version, recopier getWindingLoops à la fin du code, mais ça ne marche pas. (tester avec un cylindre unique)

dans getWindingLoops j'ai rajouté un point d’arrêt pour tester, on passe bien les 3 tests, mais

(mapcar 'cadr (cdar (vl-remove-if-not '(lambda (x) (= (caadr x) "LOOPWINDING")) faces)))

il renvoie nil, en regardant brepList je ne trouve pas de trace de "LOOPWINDING", j'ai essayé de remplacer au doigt levé par "LOOPEXTERIOR",

mais pas mieux....les mapcar j'y comprend rien... tout ce qui est de haut niveau du reste... le remouve if not m'intimide...et le lamba m'inquiète, je ne comprends jamais ce qu'il traite (surtout avec les sous listes)

qui est "x" ?

Lien vers le commentaire
Partager sur d’autres sites

Effectivement, le type LOOPWINDING semble avoir disparu au profit des LOOPEXTERIOR dans les nouvelles versions (je teste habituellement avec A2014 qui se lance plus rapidement).

C'est dommage, la présence de LOOPWINDING suffisait à garantir qu'on était en présence d'un cylindre ou d'un tronc de cône.

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

il est grand le mystère d'autocad...

une autre mystère, si je fait un gc-brep sur un balayage avec 2 cercles de diamètres différents, j'ai 2 cercles de diamètre identiques... va comprendre,

du coup, pour modéliser une réduction, il faut faire un cylindre et le modifier avec la poignée en tête... rien de grave, mais c'est mystérieux...

Lien vers le commentaire
Partager sur d’autres sites

il est grand le mystère d'autocad...

Malheureusement oui...

 

une autre mystère, si je fait un gc-brep sur un balayage avec 2 cercles de diamètres différents

Ne serait-ce pas plutôt un lissage ?

En tout cas, je n'ai pas ce problème avec un lissage (testé sur 2014 et 2019). Avec quelle version travailles-tu ?

 

J'ai essayé de faire une autre routine qui renvoie les données DXF des bases d'un cylindre ou tronc de cône.

 

(defun getBases (brepList / shells faces bases winding)
 (if
   (and
     ;; une seule entrée "COMPLEX"
     (= (car brepList) "COMPLEX")
     ;; une seule entrée "SHELL"
     (= (length (setq shells (cdr brepList))) 1)
     ;; trois entrées "FACE"
     (= (length (setq faces (cdar shells))) 3)
     ;; dont deux faces avec une seule entrée "LOOP"
     (= (length (setq bases (mapcar 'cadadr
			     (vl-remove-if-not
			       '(lambda	(face)
				  (= 2 (length face))
				)
			       faces
			     )
		     )
	 )
 )
 2
     )
     ;; et une face avec deux entrées "LOOP"
     (= (length (setq winding (vl-some	'(lambda (face)
				   (if (= (length face) 3)
				     (mapcar 'cadr (cdr face))
				   )
				 )
				faces
		       )
	 )
 )
 2
     )
     ;; qui sont identiques à celles des deux autres faces
     (member (car bases) winding)
     (member (cadr bases) winding)
     ;; et qui représentent toutes deux des cercles ou des ellipses
     (vl-every '(lambda (loop) (member (cdar loop) '("CIRCLE" "ELLIPSE"))) bases)
   )
   bases
 )
)

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

et bien merci beaucoup

c'est plus propre, mon extraction "à la sauvage" n'avait aucun contrôle d'erreur.

ça marche impec :)

 

ps

pour le post précédent, je suis effectivement sur un lissage.. et j'ai une 2017.. et effectivement, avec getBases le résultat est conforme. Je me suis peut être pris la mémoire dans le tapis de mes nombreux essais car j'ai bien galéré quand même...

 

rien à voir si ce n'est que c'est aussi des devoirs de vacances, quand je clique sur une polyligne l'ors d'une sélection. y a t il un moyen de trouver sa largeur à l'endroit ou je clique (largeur constante entre 2 sommets)?

 

 

 

Lien vers le commentaire
Partager sur d’autres sites

rien à voir si ce n'est que c'est aussi des devoirs de vacances, quand je clique sur une polyligne l'ors d'une sélection. y a t il un moyen de trouver sa largeur à l'endroit ou je clique (largeur constante entre 2 sommets)?

 

Les fonctions vlax-curve-* sont tes amies pour déterminer l'index du segment sélectionné.

 

On peut les utiliser avec un nom d'entité (ENAME) et la fonction getpropertyvalue

(if
 (and
   (setq ent (entsel "\nSélectionnez un segment de polyligne: "))
   (setq pt (cadr ent))		; point cliqué
   (setq pl (car ent))			; entité sélectionnée
   (= (getpropertyvalue pl "LocalizedName") "Polyligne") ; contrôle du type d'entité
   (setq pt (vlax-curve-getClosestPointTo pl (trans pt 1 0))) ; point sur la polyligne le plus proche du point cliqué
   (setq pa (fix (vlax-curve-getParamAtPoint pl pt))) ; index du segment sélectionné
 )
  (getpropertyvalue pl "Vertices" pa "StartWidth") ; largeur de départ du segment
)

 

Ou avec un vla-object et les fonctions vla-*

(if
 (and
   (setq ent (entsel "\nsélectionnez un segment de polyligne: "))
   (setq pt (cadr ent))		; point cliqué
   (setq pl (vlax-ename->vla-object (car ent))) ; entité sélectionnée convertie en vla-object
   (= (vla-get-ObjectName pl) "AcDbPolyline") ; contrôle du type d'entité
   (setq pt (vlax-curve-getClosestPointTo pl (trans pt 1 0))) 	; point sur la polyligne le plus proche du point cliqué
   (setq pa (fix (vlax-curve-getParamAtPoint pl pt))) 	; index du segment sélectionné
 )
  (progn
    (vla-GetWidth pl pa 'startWidth 'endWidth)
    startWidth				; largeur de départ du segment
  )
)

 

Sans les fonctions vlax-curve-*, il faudrait faire un peu de géométrie analytique avec les données DXF.

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

Quels types de SOLID 3D sont supportés...

 

En l'état, la fonction getbases supporte les cylindres et les cônes tronqués qu'ils soient circulaires ou elliptiques, que les bases soient perpendiculaire à l'axe ou non, qu'ils aient été créés avec les primitives (CYLINDRE ou CONE) ou par extrusion* ou lissage.

Autrement dit, les solides avec deux bases circulaires ou elliptiques et une seule face d'enroulement.

 

*l'extrusion d'une ellipse avec un angle ne génère pas un cône elliptique (les bases sont des Splines)

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

plop de bonne année..

alors oui, c'est bien des métré, mais de gaines aéro.

l'exemple qui m'occupe est ici joch04.free.fr/tmp/combles3d.dwg

 

en l'état, ça marche si le modèle 3d est composé d'éléments autorisés, des extrusions de cercle pour les gaines circulaires et, et des blocs dynamiques pour les gaines rectangulaires (nom ft des longueurs largeurs par exemple 0.50x0.5) ça liste également les blocs, si le nom du bloc commence par "cd" c'est un coude de 1.00m mis à l’échelle du diamètre du tube.

 

Il faudra voir comment éliminer les objets 3d indésirables (les extrusions de polylignes plantent) et tester un peu pour débugger... mais bon, il fait moins froid, j'ai du jardinage...

 


;;;  MG (v4)  métré de gaine 3d, exemple ici joch04.free.fr/tmp/combles3d.dwg                   	
;;; cette routine implique l'installation des  LispExtension de (gile)téléchargeable sur cette page.
;;; http://gilecad.azurewebsites.net/DotNet.aspx       	(accès à gc-Brep )                   	
;;; version "work in progress" à compléter par des règles de construction du modèle 3d        
;;; les variables sont pas super calées et il en reste qui ne servent qu'aux test et débuggage
;;; remerciements à cadXp en général; (gile) en particulier et mention spéciale à Lee Mac pour
;;; les longueurs de blocs dynamiques                                                     	
;;;http://cadxp.com/topic/46322-devoir-de-vacances-objet-3d/page__pid__270178#entry270178 	
;;;http://cadxp.com/topic/32932-acceder-aux-donnees-des-solides-3d-fonction-lisp/         	
;;;http://cadxp.com/topic/39982-metres-block-dynamique/                                   	
;;;http://cadxp.com/topic/34377-automatisation-de-metres/                                 	
;;;http://cadxp.com/topic/41466-algorithme-de-trie-x-y/                                   	
;;;   ...




(defun c:mg (/ ssel ent j lsol ldata toto)

				; initialisation VL
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)		; Activer le début de l'undo


				; sélection des éléments on ne garde que les blocs et les solides
 (while (not ssel)
   (setq ssel (ssget '((0 . "3DSOLID,INSERT"))))
 )
 (setq j 0)
 (repeat (sslength ssel)
   (setq ent (ssname ssel j))
   (if	(=
 	"3DSOLID"
 	(cdr (assoc 0 (entget ent)))
)
     (progn
(setq lsol (list (traite-solide ent)))
(setq ldata (append lsol ldata))
     )
     (progn
(setq lsol (list (traite-bloc ent)))
(setq ldata (append lsol ldata))
     )
   )
				;    (print ldata)

   (setq j (+ 1 j))
 )					;f repeat

 (setq ldata (consolidation ldata))

 (setq ldata (Ordone ldata))

 (ecrit-fichier ldata)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;  Ordone ft qui classe la liste suivant ses 2 1er éléments                        
;;; si elles ont la meme 1ere colonne on classe suivant la 2eme par ordre croissant  
;;; (transfomée de string en réel)                                               	
;;; si non par la 1ere colonne pas ordre décroissant.                                

(defun Ordone (lst-b / e1 e2)
 (setq	lst-b
    (vl-sort lst-b
  	'(lambda (e1 e2)
         (if (equal (car e1) (car e2))

           (> (atof (cadr e1)) (atof (cadr e2)))
           (< (car e1) (car e2))
         )
       )
    )
 )

)					;fin Ordone




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun consolidation
  	(lst / nlst i tour ty d1 d2 l el nel sec surf test nb nty nd1 nd2 nl nsec nsurf nnb)

 (setq	nlst (list (car lst))
lst  (cdr lst)
 )
 (setq tour 1)
 (foreach el lst
   (setq ty   (NTH 0 el)
 	d1   (NTH 1 el)
 	d2   (NTH 2 el)
 	l    (NTH 3 el)
 	nb   (NTH 4 el)
 	sec  (NTH 5 el)
 	surf (NTH 6 el)
 	test 0
   )




   (foreach nel nlst
     (setq nty  	(NTH 0 nel)
   	nd1  	(NTH 1 nel)
   	nd2  	(NTH 2 nel)
   	nl  	(NTH 3 nel)
   	nnb  	(NTH 4 nel)
   	nsec  (NTH 5 nel)
   	nsurf (NTH 6 nel)
     )

     (cond
;; si même nom même d1 (pour les cylindres) et pas une réduction ni un coude
((and (= nty ty) (= nd1 d1) (/= ty "reduc") (/= "cd" (substr ty 1 2)))
    (setq nl    (rtos (+ (atof nl) (atof l)))
          nnb   (+ 1 nnb)
          nsurf (rtos (+ (atof nsurf) (atof surf)) 2 2)
          test  1
    )
    (setq nlst (subst (list nty nd1 nd2 nl nnb nsec nsurf) nel nlst))
)				; c1


;; si une réduction avec le même d1.   
((and (= nty ty) (= ty "reduc") (= nd1 d1))
    (setq nnb  (+ 1 nnb)
          test 1
    )
    (setq nlst (subst (list nty nd1 nd2 nl nnb nsec nsurf) nel nlst))
)				;c2
;; si coude
((and (= nty ty) (= "cd" (substr ty 1 2)) (= nd1 d1))
    (setq nnb  (+ 1 nnb)
          test 1
    )
    (setq nlst (subst (list nty nd1 nd2 nl nnb nsec nsurf) nel nlst))
)

(t)
     )					; f cond

   )
				; f foreach nel
   (setq tour (+ 1 tour))
   (if	(= 0 test)
     (setq nlst (append (list el) nlst))
   )
 )					;f foreach el

 nlst
)






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun traite-bloc (ent / Vba-ent ty d1 d2 l nb px sec surf)
 (setq	d1   "0.00"
d2   "0.00"
l    "0.00"
sec  "np"
surf "np"
nb   1
 )
 (setq	Vba-ent	(vlax-ename->vla-object ent)
ty	(vla-get-effectivename Vba-ent)
 )
 (cond
   ;; si coude
   ((= "cd" (substr ty 1 2))
	(setq d1 (rtos (cdr (assoc 41 (entget ent))) 2 3)
      d2 d1
	)
   )
   ;;si bloc dynamique avec un x dnas le nom
   ((and (= (vla-get-isdynamicblock Vba-ent) :vlax-true)
 	(/= nil (vl-string-position (ascii "x") ty))
	)
	(setq px (vl-string-position (ascii "x") ty))
	(setq l (rtos (LM:getdynpropvalue Vba-ent "long") 2 3))
	(setq d1 (substr ty 1 px)
      d2 (substr ty (+ 2 px) (strlen ty))
      sec (rtos (* (atof d1) (atof d2)) 2 3)
      surf (rtos (* (atof l) (* 2 (+ (atof d1) (atof d2)))) 2 3)
	)
   )
 )
 (list ty d1 d2 l nb sec surf)

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun traite-solide (ent /  ls-brep c1 c2 ty d1 d2 l nb sec surf d)
;;;  (setq ls-brep (cddr (car (cdr (gc-brep ent)))))
;;;  (Setq	c1 (car (cdr (car (cdr (car ls-brep)))))
;;;	c2 (car (cdr (car (cdr (cadr ls-brep)))))
;;;  )  ;vertion sans getBases pas de controle d'erreur


 (setq ls-brep (getBases (gc-brep ent)))
;(print ls-brep)
 (setq c1 (car ls-brep)
c2 (cadr ls-brep))
 
 
 
 (Setq	d1 (rtos (round (* 2 (cdr (assoc 40 c1))) 0.005) 2 2)
d2 (rtos (round (* 2 (cdr (assoc 40 c2))) 0.005) 2 2)
l  (rtos (distance (cdr (assoc 10 c1)) (cdr (assoc 10 c2))) 2 2)
sec "np"
surf "np"
Nb 1
 )

 (if (/= d1 d2)
   (setq ty "reduc"
 	l  "np"
   )
   (setq ty "cyl"
 	d (atof d1)
sec (rtos (* 0.25 pi d d) 2 2)
surf (rtos (* pi d (atof l)) 2 2)
      )
 )

 (list ty d1 d2 l nb sec surf)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue (blk prp)
 (setq prp (strcase prp))
 (vl-some '(lambda (x)
     	(if (= prp (strcase (vla-get-propertyname x)))
	(vlax-get x 'value)
     	)
   	)
      (vlax-invoke blk 'getdynamicblockproperties)
 )
)



;;; ROUND (gile)                                           	
;;; Arrondit à la valeur la plus proche en fonction de prec    
;;; (round pi 0.01) -> 3.14                                    
;;; (round pi 1e-5) -> 3.14159                             	
;;; (round 5456.50 1) -> 5457                                  
;;; (round 5456.50 100.0) -> 5500.0                            

(defun round (num prec)
 (if (zerop (setq prec (abs prec)))
   num
   (* prec
  	(fix ((if (minusp num)
          -
          +
        )
     	(/ num prec)
     	0.5
   	)
  	)
   )
 )
)



;;routine d'écriture dans un fichier odieusement pompée de metre_2, lisp de (gile)
;; post d'origine  ici  http://cadxp.com/topic/36638-lisp-calculer-le-metre-de-differente-type-de-ligne-selon-son-calque/

(defun ecrit-fichier (lst / sep filename file l)
;  (print lst)
 (setq	sep     (vl-registry-read
       "HKEY_CURRENT_USER\\Control Panel\\International"
       "sList"
     )
filename (strcat (getvar 'dwgprefix)
	     (vl-filename-base (getvar 'dwgname))
	     "_metre.csv"
     )
file     (open filename "w")
 )
 (write-line
   (strcat "type" sep "dim" sep "dim2" sep "longueur" sep "section" sep "surface" sep "nombre" )
   file
 )
 (foreach l lst
   (print l)
   (write-line
     (strcat (NTH 0 l)
     	sep
     	(NTH 1 l)
     	sep
     	(NTH 2 l)
     	sep
     	(NTH 3 l)
     	sep
     	(NTH 5 l)
     	sep
     	(NTH 6 l)
     	sep
     	(itoa (NTH 4 l))
     	
     )
     file
   )
 )
 (close file)
 (startapp "notepad" filename)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;fonction de (gile) pour choper directement les code DXF d'un gc-brep                             	
;; voir ici http://cadxp.com/topic/46322-devoir-de-vacances-objet-3d/page__view__findpost__p__270198   
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun getBases (brepList / shells faces bases winding)
 (if
   (and
     ;; une seule entrée "COMPLEX"
     (= (car brepList) "COMPLEX")
     ;; une seule entrée "SHELL"
     (= (length (setq shells (cdr brepList))) 1)
     ;; trois entrées "FACE"
     (= (length (setq faces (cdar shells))) 3)
     ;; dont deux faces avec une seule entrée "LOOP"
     (= (length (setq bases (mapcar 'cadadr
                                	(vl-remove-if-not
                                  	'(lambda (face)
                                         (= 2 (length face))
                                       )
                                  	faces
                                	)
                        	)
            	)
    	)
    	2
     )
     ;; et une face avec deux entrées "LOOP"
     (= (length (setq winding (vl-some '(lambda (face)
                                      	(if (= (length face) 3)
                                        	(mapcar 'cadr (cdr face))
                                      	)
                                    	)
                                       faces
                          	)
            	)
    	)
    	2
     )
     ;; qui sont identiques à celles des deux autres faces
     (member (car bases) winding)
     (member (cadr bases) winding)
     ;; et qui représentent toutes deux des cercles ou des ellipses
     (vl-every '(lambda (loop) (member (cdar loop) '("CIRCLE" "ELLIPSE"))) bases)
   )
   bases
 )
)

Lien vers le commentaire
Partager sur d’autres sites

et puis c'était des vacances studieuses le 2eme tuyau pour les largeurs des poly, c'est aussi un truc CVC en gaines circulaires.

 

J'avais fait ça pour aider au dimensionnement des gaines en fonction des vitesses d'air. A la fin, en ligne de commande, j'affiche un récap des longueurs par diamètres si le schéma est calé sur le plan ça peut être une bonne 1ere approximation.

Je l'ai amélioré pour que ça trace une poly avec épaisseur sur le schéma dans un calque temporaire.

Grace à l'astuce de (gile) J'ai pu ajouter une fonction pour tracer des coudes (R=1D) pour faire un presque réseau vite fait en APD (passer fillmode à 0 pour avoir un aspect correct avant traçage ou supportez les gros à plats)

 

Le code et un exemple dans ce fichier joch04.free.fr/tmp/vsom6.zip

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é