ca coule d source

(gile) · le 23 mars 2010

Une dernière version (je ne pense pas aller plus loin dans ce sens)

Ajoute un cercle orange (index 30) sur les faces horizontales (les faces verticales ont toujours eu une flèche verticale).

Ajoute un attribut invisible (affichable avec ATTMODE = 2) au bloc "PENTE-FLECHE" dont la valeur est la pente de la face.

;; PF3D (gile)
;; Insère le bloc "PENTE" sur toutes les faces 3d sélectionnées

(defun c:PF3D (/  size  n	 ss   ent  new	elst p1	  p2   p3   cg	 no
       pgp  lst	 minp maxp moy	l0   l1	  l2   l3   l4	 l5
       l6   l7	 l8
      )
 (initget 5)
 (setq size (getdist "\nTaille des flèches: "))
 ;; Création du calque s'il n'existe pas
 (if (not (tblsearch "LAYER" "PENTE-FLECHE"))
   (entmake '((0 . "LAYER")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbLayerTableRecord")
       (2 . "PENTE-FLECHE")
       (70 . 0)
       (62 . 3)
       (6 . "Continuous")
      )
   )
 )

 ;; Création du bloc s'il n'existe pas
 (if (not (tblsearch "BLOCK" "PENTE-FLECHE"))
(progn
  (entmake
    '((0 . "BLOCK")
      (100 . "AcDbEntity")
      (8 . "0")
      (100 . "AcDbBlockBegin")
      (2 . "PENTE-FLECHE")
      (70 . 2)
      (10 0.0 0.0 0.0)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 -0.5 0. 0.)
      (11 0.5 0. 0.)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 0.5 0. 0.)
      (11 0.25 0.1 0.)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 0.5 0. 0.)
      (11 0.25 -0.1 0.)
     )
  )
  (entmake
    '((0 . "ATTDEF")
      (100 . "AcDbEntity")
      (8 . "0")
      (62 . 0)
      (100 . "AcDbText")
      (10 0.0 0.0 0.0)
      (40 . 0.08)
      (1 . "0")
      (50 . 0.0)
      (72 . 1)
      (11 0.0 0.0 0.0)
      (100 . "AcDbAttributeDefinition")
      (3 . "Pente ?")
      (2 . "PENTE")
      (70 . 9)
      (74 . 1)
      (280 . 1)
     )
  )
  (entmake '((0 . "ENDBLK") (8 . "0")))
)
     )
 
 ;; Traitement du jeu de sélection
 (if (and (setq n  -1
	 l0 0
	 l8 0
	 ss (ssget '((0 . "3DFACE")))
   )
     )
   (while (setq ent (ssname ss (setq n (1+ n))))
     ;; si la face a 4 sommets elle est divisée
     (if (setq new (Triang3dFace ent))
(ssadd new ss)
     )
     (setq elst (entget ent)
    p1	 (cdr (assoc 10 elst))
    p2	 (cdr (assoc 11 elst))
    p3	 (cdr (assoc 12 elst))
     )
     (if
(and
  (setq	cg (mapcar
	     '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.))
	     p1
	     p2
	     p3
	   )
  )
  ;; normale de la face
  (setq no (v^v (mapcar '- p2 p1) (mapcar '- p3 p1)))
  (not (equal '(0. 0. 0.) no 1e-9))
  (setq	no (if (minusp (caddr no))
	     (mapcar '- no)
	     no
	   )
  )
  (setq pgp (vpgp no))		; vecteur de plus grande pente
)
 (progn
   (setq ins (trans cg 0 no)
	 slp (*	-100
		(/ (caddr pgp)
		   (distance '(0. 0.)
			     (list (car pgp) (cadr pgp))
		   )
		)
	     )
   )
   (entmake
     (list '(0 . "INSERT")
	   '(66 . 1)
	   '(2 . "PENTE-FLECHE")
	   '(8 . "PENTE-FLECHE")
	   (cons 10 (trans cg 0 no))
	   (cons 50 (angle '(0. 0. 0.) (trans pgp 0 no)))
	   (cons 41 size)
	   (cons 42 size)
	   (cons 43 size)
	   (cons 210 no)
     )
   )
   (entmake
     (list '(0 . "ATTRIB")
	   '(62 . 0)
	   (cons 10 ins)
	   (cons 40 (* 0.08 size))
	   (cons
	     1
	     (if (equal pgp '(0. 0. -1.) 1e-9)
	       "Vertical"
	       (strcat (rtos slp 2 2) "%")
	     )
	   )
	   (cons 50 (angle '(0. 0. 0.) (trans pgp 0 no)))
	   '(72 . 1)
	   (cons 11 ins)
	   '(2 . "PENTE")
	   (cons 210 no)
	   '(70 . 9)
	   '(74 . 1)
	   '(280 . 1)
     )
   )
   (entmake '((0 . "SEQEND")))
   (if (equal pgp '(0. 0. -1.) 1e-9)
     (setq l8 (1+ l8))
     (setq lst
	    (cons
	      (cons
		(entlast)
		(* -100.
		   (/ (caddr pgp)
		      (distance '(0. 0.) (list (car pgp) (cadr pgp)))
		   )
		)
	      )
	      lst
	    )
     )
   )
 )
(progn
  (entmake
    (list
      '(0 . "CIRCLE")
      '(8 . "PENTE-FLECHE")
      (cons 10 (trans cg 0 no))
      (cons 40 (/ size 4.))
      '(62 . 30)
      (cons 210 no)
    )
  )
  (setq l0 (1+ l0))
)
     )
   )
 )
 (setq	minp (apply 'min (mapcar 'cdr lst))
maxp (apply 'max (mapcar 'cdr lst))
moy  (/ (- maxp minp) 7.)
 )
 (foreach l '(l1 l2 l3 l4 l5 l6 l7) (set l 0))
 (foreach p lst
   (cond
     ((       (setq l1 (1+ l1))
      (entmod (append (entget (car p)) (list '(62 . 1))))
     )
     ((       (setq l2 (1+ l2))
      (entmod (append (entget (car p)) (list '(62 . 2))))
     )
     ((       (setq l3 (1+ l3))
      (entmod (append (entget (car p)) (list '(62 . 3))))
     )
     ((       (setq l4 (1+ l4))
      (entmod (append (entget (car p)) (list '(62 . 4))))
     )
     ((       (setq l5 (1+ l5))
      (entmod (append (entget (car p)) (list '(62 . 5))))
     )
     ((       (setq l6 (1+ l6))
      (entmod (append (entget (car p)) (list '(62 . 6))))
     )
     (T
      (setq l7 (1+ l7))
      (entmod (append (entget (car p)) (list '(62 . 7))))
     )
   )
 )
 (if (setq pt (getpoint "\nPoint d'insertion de la légende: "))
   (entmake
     (list
'(0 . "MTEXT")
'(100 . "AcDbEntity")
'(8 . "LEGENDE")
'(100 . "AcDbMText")
(cons 10 (trans pt 1 0))
(cons 1
      (strcat
	"{\\C1;de "
	(rtos minp)
	"% à "
	(rtos (+ minp moy))
	"% ("
	(itoa l1)
	" faces)\\P\\C2;de "
	(rtos (+ minp moy))
	"% à "
	(rtos (+ minp (* 2 moy)))
	"% ("
	(itoa l2)
	" faces)\\P\\C3;de "
	(rtos (+ minp (* 2 moy)))
	"% à "
	(rtos (+ minp (* 3 moy)))
	"% ("
	(itoa l3)
	" faces)\\P\\C4;de "
	(rtos (+ minp (* 3 moy)))
	"% à "
	(rtos (+ minp (* 4 moy)))
	"% ("
	(itoa l4)
	" faces)\\P\\C5;de "
	(rtos (+ minp (* 4 moy)))
	"% à "
	(rtos (+ minp (* 5 moy)))
	"% ("
	(itoa l5)
	" faces)\\P\\C6;de "
	(rtos (+ minp (* 5 moy)))
	"% à "
	(rtos (+ minp (* 6 moy)))
	"% ("
	(itoa l6)
	" faces)\\P\\C7;de "
	(rtos (+ minp (* 6 moy)))
	"% à "
	(rtos maxp)
	"% ("
	(itoa l7)
	" faces)}"
	(if (		  (strcat "\n" (itoa l0) " faces horizontales")
	  ""
	)
	(if (		  (strcat "\n" (itoa l0) " faces verticales")
	  ""
	)
      )
)
     )
   )
 )
 (princ)
)

;; V^V
;; Retourne le produit vectoriel (vecteur) de deux vecteurs
;;
;; Arguments : deux vecteurs

(defun v^v (v1 v2)
 (list	(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)

;; VUNIT
;; Retourne le vecteur unitaire d'un vecteur
;;
;; Argument : un vecteur

(defun vunit (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)

;; VPGP
;; Retourne le vecteur unitaire de plus grande pente du plan
;; défini par sa normale (nil si le plan est horizontal)
;;
;; Argument : le vecteur normal du plan

(defun vpgp (norm)
 (if (/= 0 (caddr norm))
   ((lambda (d)
      (vunit
 (list (car norm) (cadr norm) (/ (* d d) (- (caddr norm))))
      )
    )
     (distance '(0. 0.) (list (car norm) (cadr norm)))
   )
   '(0. 0. -1.)
 )
)

;; Triang3dFace
;; Divise une face3d quadrilatérale en 2 faces 3d triangulaires ou 'normalise'
;; la face triangulaire (3ème et 4ème sommets confondus)
;; Retourne le ename de la nouvelle face créée ou nil si la face était triangulaire
;;
;; Argument : une face 3d (ENAME)

(defun Triang3dFace	(f3d / p1 p2 p3 p4)
 (setq	elst (entget f3d)
p1   (cdr (assoc 10 elst))
p2   (cdr (assoc 11 elst))
p3   (cdr (assoc 12 elst))
p4   (cdr (assoc 13 elst))
 )
 (cond
   ((equal p3 p4 1e-9) nil)
   ((equal p1 p2 1e-9)
    (entmod (subst (cons 11 p3)
	    (assoc 11 elst)
	    (subst (cons 12 p4) (assoc 12 elst) elst)
     )
    )
    nil
   )
   ((equal p1 p4 1e-9)
    (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
    nil
   )
   ((equal p2 p3 1e-9)
    (entmod (subst (cons 12 p4) (assoc 12 elst) elst))
    nil
   )
   (T
    (if (       (progn
 (entmod
   (subst (cons 12 p4) (assoc 12 elst) elst)
 )
 (entmakex
   (subst (cons 10 p2)
	  (assoc 10 elst)
	  (subst (cons 11 p3)
		 (assoc 11 elst)
		 (subst (cons 12 p4) (assoc 12 elst) elst)
	  )
   )
 )
      )
      (progn
 (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
 (entmakex
   (subst (cons 11 p3)
	  (assoc 11 elst)
	  (subst (cons 12 p4) (assoc 12 elst) elst)
   )
 )
      )
    )
   )
 )
)

lecrabe · le 24 mars 2010

Hello Gilles

Merci ta routine devient "delirante" , c la grande classe ! :) :D

Cependant je me permet de proposer encore une petite amelioration

Question supplementaire :

Coloriage des faces 3D (O/N) Defaut=N : ?

Si OUI, alors au moment ou tu ajoutes ton bloc fleche sur une face 3D,

tu ajoutes en plus un hachurage en motif SOLID (aplat couleur) de la couleur voulue (idem le bloc fleche)

Note : Il sera peut etre necessaire de changer de SCU pour "se plaquer" sur la face 3D

avant de hachurer !?

Ainsi on pourra avoir en plus un magnifique coloriage du MNT en fonction de la pente !

En esperant cette "ultime" amelioration, Bonne Journee, Le Decapode

lecrabe · le 24 mars 2010

Hello

D'ailleurs si on veut le coloriage, peut etre que l'on ne voudra pas le bloc pente-fleche !

Donc a mon avis, le mieux c de poser 2 questions !

Bloc pente-fleche (O/N) defaut =O

et Coloriage des Faces 3D (O/N) defaut =N

On dessine le tout sur le calque courant

il sera facile d'isoler apres les 2 objets par la selection rapide d'AutoCAD !

Le Decapode (qui devale la pente)

lecrabe · le 24 mars 2010

ReHello Gilles

J'ai un probleme avec tes 2 dernieres versions de PF3D

et le vieux terrain MNT 3D que je t'avais envoye par MP !

Avec l'avant derniere version :

PF3D ne traite pas toutes les faces 3D !

Les facettes horizontales/planes ne sont pas traitees mais je pense que c'est normal !

Avec la derniere version : PF3D colorie les facettes et je n'ai aucun bloc pente-fleche !

Avec aucun bloc, il devrait pourtant le creer automatiquement et le dessiner !

Les facettes horizontales sont marquees par un cercle, c parfait !

Qu'en penses tu ?

Encore merci pour tes efforts, Le Decapode

(gile) · le 24 mars 2010

Je réponds (presque*) à la dernière demande mais j'arrête d'ajouter des options à cette routine pour deux raisons :

- la première est que les performances commencent à s'en ressentir et que je suis de plus en plus convaincu que vouloir en faire faire trop à une seule routine n'est pas la bonne solution. L'utilisation d'une base de données légère et embarqué (type SQLite) permettrait, en conservant les données géométriques des faces, de définir différentes commandes qui pourraient répondre à des besoins plus divers tout en donnant plus de souplesse à chaque commande, par exemple la façon dont sont réparties les couleurs suivant les pentes : dans l'état actuel, avec un terrain plutôt plat contenant une seule face très abrupte on pourrait avoir toutes les faces rouge et une seule violette.

- la seconde découle de la première, un développement de ce type représente à mes yeux un travail suffisamment conséquent pour qu'il sorte du cadre des routines distribuées gracieusement et fasse l'objet d'une rémunération.

* je dis "presque" parce que pour faire plus simple, je n'ajoute pas de hachure solide aux face mais colorie directement celle-ci. Il suffit de passer en affichage réaliste pour avoir son MNT colorisé.

;; PF3D (gile)
;; Insère le bloc "PENTE" sur toutes les faces 3d sélectionnées
;; ou les colorise.

(defun c:PF3D (/    blk col	 size n	   ss	ent  new  elst p1   p2	 p3
       cg   no	 pgp  lst  minp	maxp moy  l0   l1   l2	 l3
       l4   l5	 l6   l7   l8
      )
 (initget "Oui Non")
 (if (not
(= "Non"
   (getkword "\nInsérer le bloc flèche ? [Oui/Non] : ")
)
     )
   (progn
     (setq blk T)
     (initget 5)
     (setq size (getdist "\nTaille des flèches: "))
     ;; Création du calque s'il n'existe pas
     (if (not (tblsearch "LAYER" "PENTE_FLECHE"))
(entmake '((0 . "LAYER")
	   (100 . "AcDbSymbolTableRecord")
	   (100 . "AcDbLayerTableRecord")
	   (2 . "PENTE_FLECHE")
	   (70 . 0)
	   (62 . 3)
	   (6 . "Continuous")
	  )
)
     )

     ;; Création du bloc s'il n'existe pas
     (if (not (tblsearch "BLOCK" "PENTE_FLECHE"))
(progn
  (entmake
    '((0 . "BLOCK")
      (100 . "AcDbEntity")
      (8 . "0")
      (100 . "AcDbBlockBegin")
      (2 . "PENTE_FLECHE")
      (70 . 2)
      (10 0.0 0.0 0.0)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 -0.5 0. 0.)
      (11 0.5 0. 0.)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 0.5 0. 0.)
      (11 0.25 0.1 0.)
     )
  )
  (entmake
    '((0 . "LINE")
      (8 . "0")
      (62 . 0)
      (10 0.5 0. 0.)
      (11 0.25 -0.1 0.)
     )
  )
  (entmake
    '((0 . "ATTDEF")
      (100 . "AcDbEntity")
      (8 . "0")
      (62 . 0)
      (100 . "AcDbText")
      (10 0.0 0.0 0.0)
      (40 . 0.08)
      (1 . "0")
      (50 . 0.0)
      (72 . 1)
      (11 0.0 0.0 0.0)
      (100 . "AcDbAttributeDefinition")
      (3 . "Pente ?")
      (2 . "PENTE")
      (70 . 9)
      (74 . 1)
      (280 . 1)
     )
  )
  (entmake '((0 . "ENDBLK") (8 . "0")))
)
     )
   )
 )

 (initget "Oui Non")
 (if (= "Oui"
 (getkword "\nColorer les faces ? [Oui/Non] : ")
     )
   (setq col T)
 )

 ;; Traitement du jeu de sélection
 (if (and (or col blk)
   (setq n  -1
	 ss (ssget '((0 . "3DFACE")))
   )
     )
   (progn
     (while (setq ent (ssname ss (setq n (1+ n))))
;; si la face a 4 sommets elle est divisée
(if (setq new (Triang3dFace ent))
  (ssadd new ss)
)
(setq elst (entget ent)
      p1   (cdr (assoc 10 elst))
      p2   (cdr (assoc 11 elst))
      p3   (cdr (assoc 12 elst))
)
(if
  (and
    (setq cg (mapcar
	       '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.))
	       p1
	       p2
	       p3
	     )
    )
    ;; normale de la face
    (setq no (v^v (mapcar '- p2 p1) (mapcar '- p3 p1)))
    (not (equal '(0. 0. 0.) no 1e-9))
    (setq no (if (minusp (caddr no))
	       (mapcar '- no)
	       no
	     )
    )
    (setq pgp (vpgp no))	; vecteur de plus grande pente
  )
   (progn
     (setq slp (* -100
		  (/ (caddr pgp)
		     (distance '(0. 0.)
			       (list (car pgp) (cadr pgp))
		     )
		  )
	       )
     )
     (if blk
       (progn
	 (setq ins (trans cg 0 no))
	 (entmake
	   (list '(0 . "INSERT")
		 '(66 . 1)
		 '(2 . "PENTE_FLECHE")
		 '(8 . "PENTE_FLECHE")
		 (cons 10 (trans cg 0 no))
		 (cons 50 (angle '(0. 0. 0.) (trans pgp 0 no)))
		 (cons 41 size)
		 (cons 42 size)
		 (cons 43 size)
		 (cons 210 no)
	   )
	 )
	 (entmake
	   (list '(0 . "ATTRIB")
		 '(62 . 0)
		 (cons 10 ins)
		 (cons 40 (* 0.08 size))
		 (cons
		   1
		   (if (equal pgp '(0. 0. -1.) 1e-9)
		     "Vertical"
		     (strcat (rtos slp 2 2) "%")
		   )
		 )
		 (cons 50 (angle '(0. 0. 0.) (trans pgp 0 no)))
		 '(72 . 1)
		 (cons 11 ins)
		 '(2 . "PENTE")
		 (cons 210 no)
		 '(70 . 9)
		 '(74 . 1)
		 '(280 . 1)
	   )
	 )
	 (entmake '((0 . "SEQEND")))
       )
     )
     (if (equal pgp '(0. 0. -1.) 1e-9)
       (setq l8 (cons ent l8))
       (setq lst
	      (cons
		(list
		  (if blk
		    (entlast)
		  )
		  (* -100.
		     (/	(caddr pgp)
			(distance '(0. 0.) (list (car pgp) (cadr pgp)))
		     )
		  )
		  ent
		)
		lst
	      )
       )
     )
   )
   (progn
     (if blk
       (entmake
	 (list
	   '(0 . "CIRCLE")
	   '(8 . "PENTE_FLECHE")
	   (cons 10 (trans cg 0 no))
	   (cons 40 (/ size 4.))
	   '(62 . 30)
	   (cons 210 no)
	 )
       )
     )
     (setq l0 (cons ent l0))
   )
)
     )
     (setq minp (apply 'min (mapcar 'cadr lst))
    maxp (apply 'max (mapcar 'cadr lst))
    moy	 (/ (- maxp minp) 7.)
     )
     (foreach l '(l1 l2 l3 l4 l5 l6 l7) (set l 0))
     (foreach p lst
(cond
  ((	   (setq l1   (1+ l1)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 1))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 1) (assoc 62 elst) elst)
	       (append elst (list '(62 . 1)))
	     )
     )
   )
  )
  ((	   (setq l2   (1+ l2)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 2))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 2) (assoc 62 elst) elst)
	       (append elst (list '(62 . 2)))
	     )
     )
   )
  )
  ((	   (setq l3   (1+ l3)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 3))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 3) (assoc 62 elst) elst)
	       (append elst (list '(62 . 3)))
	     )
     )
   )
  )
  ((	   (setq l4   (1+ l4)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 4))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 4) (assoc 62 elst) elst)
	       (append elst (list '(62 . 4)))
	     )
     )
   )
  )
  ((	   (setq l5   (1+ l5)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 5))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 5) (assoc 62 elst) elst)
	       (append elst (list '(62 . 5)))
	     )
     )
   )
  )
  ((	   (setq l6   (1+ l6)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 6))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 6) (assoc 62 elst) elst)
	       (append elst (list '(62 . 6)))
	     )
     )
   )
  )
  (T
   (setq l7   (1+ l7)
	 elst (entget (caddr p))
   )
   (if blk
     (entmod (append (entget (car p)) (list '(62 . 200))))
   )
   (if col
     (entmod (if (assoc 62 elst)
	       (subst '(62 . 200) (assoc 62 elst) elst)
	       (append elst (list '(62 . 200)))
	     )
     )
   )
  )
)
     )
     (foreach f l0
(if col
  (progn
    (setq elst (entget f))
    (entmod (if	(assoc 62 elst)
	      (subst '(62 . 30) (assoc 62 elst) elst)
	      (append elst (list '(62 . 30)))
	    )
    )
  )
)
     )
     (foreach f l8
(if col
  (progn
    (setq elst (entget f))
    (entmod (if	(assoc 62 elst)
	      (subst '(62 . 7) (assoc 62 elst) elst)
	      (append elst (list '(62 . 7)))
	    )
    )
  )
)
     )
     (if (setq pt (getpoint "\nPoint d'insertion de la légende: "))
(entmake
  (list
    '(0 . "MTEXT")
    '(100 . "AcDbEntity")
    '(8 . "LEGENDE")
    '(100 . "AcDbMText")
    (cons 10 (trans pt 1 0))
    (cons 1
	  (strcat
	    "{\\C1;de "
	    (rtos minp)
	    "% à "
	    (rtos (+ minp moy))
	    "% ("
	    (itoa l1)
	    " faces)\\P\\C2;de "
	    (rtos (+ minp moy))
	    "% à "
	    (rtos (+ minp (* 2 moy)))
	    "% ("
	    (itoa l2)
	    " faces)\\P\\C3;de "
	    (rtos (+ minp (* 2 moy)))
	    "% à "
	    (rtos (+ minp (* 3 moy)))
	    "% ("
	    (itoa l3)
	    " faces)\\P\\C4;de "
	    (rtos (+ minp (* 3 moy)))
	    "% à "
	    (rtos (+ minp (* 4 moy)))
	    "% ("
	    (itoa l4)
	    " faces)\\P\\C5;de "
	    (rtos (+ minp (* 4 moy)))
	    "% à "
	    (rtos (+ minp (* 5 moy)))
	    "% ("
	    (itoa l5)
	    " faces)\\P\\C6;de "
	    (rtos (+ minp (* 5 moy)))
	    "% à "
	    (rtos (+ minp (* 6 moy)))
	    "% ("
	    (itoa l6)
	    " faces)\\P\\C200;de "
	    (rtos (+ minp (* 6 moy)))
	    "% à "
	    (rtos maxp)
	    "% ("
	    (itoa l7)
	    " faces)}"
	    (if	(		      (strcat "{\\P\\C30;"
		      (itoa (length l0))
		      " faces horizontales}"
	      )
	      ""
	    )
	    (if	(		      (strcat "{\\P\\C7;"
		      (itoa (length l8))
		      " faces verticales}"
	      )
	      ""
	    )
	  )
    )
  )
)
     )
   )
 )
 (princ)
)

;; V^V
;; Retourne le produit vectoriel (vecteur) de deux vecteurs
;;
;; Arguments : deux vecteurs

(defun v^v (v1 v2)
 (list	(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)

;; VUNIT
;; Retourne le vecteur unitaire d'un vecteur
;;
;; Argument : un vecteur

(defun vunit (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)

;; VPGP
;; Retourne le vecteur unitaire de plus grande pente du plan
;; défini par sa normale (nil si le plan est horizontal)
;;
;; Argument : le vecteur normal du plan

(defun vpgp (norm)
 (if (/= 0 (caddr norm))
   ((lambda (d)
      (vunit
 (list (car norm) (cadr norm) (/ (* d d) (- (caddr norm))))
      )
    )
     (distance '(0. 0.) (list (car norm) (cadr norm)))
   )
   '(0. 0. -1.)
 )
)

;; Triang3dFace
;; Divise une face3d quadrilatérale en 2 faces 3d triangulaires ou 'normalise'
;; la face triangulaire (3ème et 4ème sommets confondus)
;; Retourne le ename de la nouvelle face créée ou nil si la face était triangulaire
;;
;; Argument : une face 3d (ENAME)

(defun Triang3dFace (f3d / p1 p2 p3 p4)
 (setq	elst (entget f3d)
p1   (cdr (assoc 10 elst))
p2   (cdr (assoc 11 elst))
p3   (cdr (assoc 12 elst))
p4   (cdr (assoc 13 elst))
 )
 (cond
   ((equal p3 p4 1e-9) nil)
   ((equal p1 p2 1e-9)
    (entmod (subst (cons 11 p3)
	    (assoc 11 elst)
	    (subst (cons 12 p4) (assoc 12 elst) elst)
     )
    )
    nil
   )
   ((equal p1 p4 1e-9)
    (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
    nil
   )
   ((equal p2 p3 1e-9)
    (entmod (subst (cons 12 p4) (assoc 12 elst) elst))
    nil
   )
   (T
    (if (       (progn
 (entmod
   (subst (cons 12 p4) (assoc 12 elst) elst)
 )
 (entmakex
   (subst (cons 10 p2)
	  (assoc 10 elst)
	  (subst (cons 11 p3)
		 (assoc 11 elst)
		 (subst (cons 12 p4) (assoc 12 elst) elst)
	  )
   )
 )
      )
      (progn
 (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
 (entmakex
   (subst (cons 11 p3)
	  (assoc 11 elst)
	  (subst (cons 12 p4) (assoc 12 elst) elst)
   )
 )
      )
    )
   )
 )
)

lecrabe · le 24 mars 2010

Hello Gilles

I am sorry, tu as parfaitement raison ! :)

Je me suis laisse emporte par mon enthousiasme pour ta fabuleuse routine ! :D

En plus j'avais completement oublie l'evolution dynamique en 3D avec un style visuel realiste ou conceptuel qui est largement suffisant !! :P

Tests realises sous MAP 2010 = OK, sous MAP 2008 = OK

Sous MAP 2006 : coloriage OK mais pas d'Insertion du bloc PENTE_FLECHE : c pas grave !

Mille Mercis pour tes efforts et ta gentillesse, Le Decapode

pierrevigneux · le 24 mars 2010

Pour ma part J'aimais mieux la dernière version.

mais pas d'Insertion du bloc PENTE_FLECHE : c pas grave !

Le bloc pente-flèche est important.

Je suis sur Autocad 2004

Merci !

(gile) · le 25 mars 2010

Salut,

Il y a effectivement un problème de création de bloc+attribut avec les versions > 2007, je pense que ça vient d'un changement dans les codes DXF (annotativité).

Je regarde ça ce soir.

philous2 · le 25 mars 2010

Slt Giles,

Je viens d'essayer ta dernière mouture sur le fichier que je t'avais envoyé.

Je confirme que le bloc flèche n'apparait nul part.

Concernant le coloriage comment tu l'as envisagé les facettes sont rempli ou pas car moi j'ai la couloeur dees contours qui ont changé passant du vert au rouge je suppose que c'est normal non.

C'était juste pour ton info des éventuels problèmes que j'ai de mon coté :cool:

Grand merci qd même pour ton boulot Gilles

Phil

(gile) · le 25 mars 2010

Salut,

Voilà, les deux dernières versions semble fonctionner correctement (testé sur AutoCAD 2007, MAP 2009 et AutoCAD 2010).

Pour information, c'était juste un problème d'ordre des paires pointées dans la liste DXF de ATTDEF.

philous2,

Ce sont les entités face 3d qui sont colorées donc suivant l'affichage (style visuel) on ne voit que le contour (filaire) ou toute la face (conceptuel ou réaliste).

RhymOne · le 10 mai 2010

Bonjour,

Je viens de decouvrir ce post.

Gile est une vraie bête.....

J'aimerais recensé tout les lisp concernat les faces 3D (MNT).

J'agrement de jour en jour mon appli topo-3D

Merci les gars

Connexion

ca coule d source

Messages recommandés

(gile)

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

lecrabe

lecrabe

lecrabe

(gile)

lecrabe

pierrevigneux

(gile)

philous2

(gile)

RhymOne

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante