CADxp: devoir de vacances objet 3d - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

devoir de vacances objet 3d métrés de cylindres

#1 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 22 décembre 2018 - 12:21

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?
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#2 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 22 décembre 2018 - 12:49

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
Image IPB
0

#3 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 22 décembre 2018 - 18:10

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


"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#4 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 27 décembre 2018 - 11:53

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

"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#5 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 27 décembre 2018 - 22:13

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)

)

 



"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#6 L'utilisateur est hors-ligne   philsogood 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2233
  • Inscrit(e) : 03-mars 10

Posté 28 décembre 2018 - 07:59

moi j'ai jamais aimé les devoirs de vacances...
Phil
Image IPB
Projeteur génie climatique - traitement de l'air
0

#7 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 28 décembre 2018 - 10:12

Image IPB 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à...
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#8 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 28 décembre 2018 - 10:47

Voir le messagex_all, le 27 décembre 2018 - 11:53 , dit :

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
Image IPB
0

#9 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 28 décembre 2018 - 20:57

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" ?
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#10 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 28 décembre 2018 - 23:52

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
Image IPB
0

#11 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 29 décembre 2018 - 00:44

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...
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#12 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 29 décembre 2018 - 11:19

Voir le messagex_all, le 29 décembre 2018 - 00:44 , dit :

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

Malheureusement oui...

Voir le messagex_all, le 29 décembre 2018 - 00:44 , dit :

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
Image IPB
0

#13 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 30 décembre 2018 - 08:49

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



"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#14 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 30 décembre 2018 - 14:43

Voir le messagex_all, le 30 décembre 2018 - 08:49 , dit :

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
Image IPB
0

#15 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 30 décembre 2018 - 21:03

pou lala.... je voyais pas du tout par quel bout le prendre.
super merci encore une fois...

et bonnes fêtes à tous :)
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#16 L'utilisateur est hors-ligne   philsogood 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2233
  • Inscrit(e) : 03-mars 10

Posté 31 décembre 2018 - 08:57

eureka!
tu cherches à faire tes métrés de tubes, non?? ;)
Phil
Projeteur génie climatique - traitement de l'air
0

#17 L'utilisateur est hors-ligne   lecrabe 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8128
  • Inscrit(e) : 10-décembre 03
  • LocationLoire (42)

Posté 31 décembre 2018 - 11:07

Hello
SVP tu nous redonneras la version dernier cri ?!
Et aussi qq explications sur ce à quoi cela sert...
Et quelles sont les limitations ?
Quels types de SOLID 3D sont supportés...
Merci, Bye, lecrabe
Autodesk Expert Elite Team
0

#18 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11069
  • Inscrit(e) : 02-septembre 05

Posté 31 décembre 2018 - 12:12

Voir le messagelecrabe, le 31 décembre 2018 - 11:07 , dit :

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
Image IPB
0

#19 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 01 janvier 2019 - 10:31

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

"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

#20 L'utilisateur est hors-ligne   x_all 

  • ceinture rouge et blanche 6em dan
  • Groupe : Membres
  • Messages : 3391
  • Inscrit(e) : 27-juin 06
  • Location04190

Posté 01 janvier 2019 - 10:56

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
"La possibilité d'expliquer m'a toujours paru comme la seule excuse à l’existence de la parole"
JL Godard

quelques trucs sur autocad
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)