ca coule d source

[capde06]

je met en ligne la derniere petite application de Captopo

 

l'appli indique le sens d'écoulement de l'eau sur un MNT en face3d

 

dite moi se que vous en pensez .........

 

(defun c:pente-mnt (/ p1 p2 p3 g pt1 pt2 pt3 pt4 pt5 sel i)

 (if (not (member "geomcal.arx" (arx)))
   (arxload "geomcal")
 ) ;_ Fin de if
 (setq	oldpl	 (getvar "clayer")
oldos	 (getvar "osmode")
oldcolor (getvar "cecolor")
 )
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 ;; creation du bloc
 (If (Not (tblsearch "BLOCK" "Fleche-pente"))
   (progn
     (setq pt1	(list 0 -0.5 0)
    pt2	(list 0 0 0)
    pt3	(list 0 0.5 0)
    pt4	(list 0.125 0.125 0)
    pt5	(list -0.125 0.125 0)
     ) ;_ Fin de setq

     (setvar "clayer" "0")
     (command "polylign" pt1 pt2 pt3 pt4 pt5 pt3 "")
     (command "-bloc" "Fleche-pente" pt2 (entlast) "")
   )
 ) ;_ Fin de If
 (if (not (tblsearch "LAYER" "Pente-Fleche"))
   (command "_layer" "_N" "Pente-Fleche" "_CO"	"3" "Pente-Fleche" "")
 )
 (setvar "clayer" "Pente-Fleche")

 ;; sélection des points d'une face 3D
 (setq	sel (ssget '((0 . "3DFACE")))
i   0
 ) ;_ Fin de setq
 (repeat (sslength sel)

   (setq ent (ssname sel i))

   (setq p1 (cdr (assoc 10 (entget ent)))
  p2 (cdr (assoc 11 (entget ent)))
  p3 (cdr (assoc 12 (entget ent)))
   )
   ;; calcul centre du triangle
   (setq g (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.)) p1 p2 p3))

   ;; calcul du vecteur normal du plan passant par les trois points
   (setq n  (cal "nor(p1,p2,p3)")
  Xg (car g)
  Yg (cadr g)
  Xn (car n)
  Yn (cadr n)
  Zn (caddr n)
   )

   ;; calcul de la direction de la pente

   (setq ang (angtos (angle g (list (+ Xg Xn) (+ Yg Yn)))))
   ;; insertion de la fleche

   (command "-inserer" "Fleche-pente" g "1" "1" ang)

   (setq i (+ i 1))

 ) ;_ Fin de repeat


 (setvar "clayer" oldpl)
 (setvar "osmode" oldos)
 (setvar "cecolor" oldcolor)
)

 

[(gile)]

Salut,

 

S'il te plait, quand tu postes du code, pour le rendre plus lisible utilise les bbcodes :

 

[surligneur][[/surligneur][surligneur]code[/surligneur][surligneur]][/surligneur] ici le code [surligneur][[/surligneur][surligneur]/code[/surligneur][surligneur]][/surligneur]

 

donne :

 ici  le code 

 

Accessibles avec l'icône # :

http://img94.imageshack.us/img94/8380/bbcode.png

 

Sinon, plutôt que de faire appel à la calculatrice géométrique d'AutoCAD, tu peux utiliser la routine norm_3pts dans Vecteurs&Matrices.lsp sur cette page.

[lili2006]

Bonjour à toutes et tous,

 

Terrible ! :D

 

Avec ton prog =>

 

http://img689.imageshack.us/img689/1485/mnt1.jpg

 

Avec Covadis V11 =>

 

http://img245.imageshack.us/img245/44/mnt2.jpg

 

Les résultats sont identiques et justes !

 

Bravo pour cet utilitaire !

:P

[capde06]

merci gile pour la rectif bbcode

j'ai récupère ton fichier de fonctions vectorielles.

aussi, la syntaxe centre du triangle vient d'un de tes précèdent post

 

 

:)

 

[capde06]

attention dans l'etat actuel le prog ne trait pas une face3d avec les sommets a la même altitude

donc risque d'erreur.

[capde06]

problème des face 3d de niveau traité

 

 

 (defun c:pente-mnt  (/ p1 p2 p3 g pt1 pt2 pt3 pt4 pt5 sel i)

 (if (not (member "geomcal.arx" (arx)))
   (arxload "geomcal")
   ) ;_ Fin de if
 (setq	oldpl	 (getvar "clayer")
oldos	 (getvar "osmode")
oldcolor (getvar "cecolor")
)
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
;creation du bloc
 (If (Not (tblsearch "BLOCK" "Fleche-pente"))
   (progn
     (setq pt1	(list 0 -0.5 0)
    pt2	(list 0 0 0)
    pt3	(list 0 0.5 0)
    pt4	(list 0.125 0.125 0)
    pt5	(list -0.125 0.125 0)
    ) ;_ Fin de setq

     (setvar "clayer" "0")
     (command "polylign" pt1 pt2 pt3 pt4 pt5 pt3 "")
     (command "-bloc" "Fleche-pente" pt2 (entlast) "")
     )
   ) ;_ Fin de If
 (if (not (tblsearch "LAYER" "Pente-Fleche"))
   (command "_layer" "_N" "Pente-Fleche" "_CO" "3" "Pente-Fleche" "")
   )
 (setvar "clayer" "Pente-Fleche")

;sélection des points d'une face 3D
 (setq	sel (ssget '((0 . "3DFACE")))
i   0
) ;_ Fin de setq
 (repeat (sslength sel)

   (setq ent (ssname sel i))

   (setq p1 (cdr (assoc 10 (entget ent)))
  p2 (cdr (assoc 11 (entget ent)))
  p3 (cdr (assoc 12 (entget ent)))
  
  )
;calcul centre du triangle
   (setq g (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.)) p1 p2 p3))

;calcul du vecteur normal du plan passant par les trois points
   (setq n  (cal "nor(p1,p2,p3)")
  Xg (car g)
  Yg (cadr g)
  Xn (car n)
  Yn (cadr n)
  Zn (caddr n)
  )

;calcul de la direction de la pente

   (setq ang (angtos (angle g (list (+ Xg Xn) (+ Yg Yn)))))
;insertion de la fleche
(if (= (caddr p1)(caddr p2)(caddr p3))
 (command "cercle" g 0.5)
   (command "-inserer" "Fleche-pente" g "1" "1" ang)
)
   (setq i (+ i 1))

   ) ;_ Fin de repeat


 (setvar "clayer" oldpl)
 (setvar "osmode" oldos)
 (setvar "cecolor" oldcolor)

 )

[pierrevigneux]

Bonsoir capde06

 

J'ai essayé ta commande pente-mnt

Petite question, ton block Fleche-pente, faut'il le créer ?

Ça semble très bien fonctionner, mais aucune flèche ne c'est insérée dans mon dessin.

La réponse fût Unknown command "245.1684G". Press F1 for help

 

Je travaille sous AutoCAD 004.

 

Merci @+

[capde06]

normalement le prog crée bloc

maintenant peut être que sur la 2004 ca ne marche pas

je l'ai testé sur 2010 tout va bien

 

 

PS ce prog marche que sur la version en français

si s'est le cas il faut traduire les command en anglais

(command "polylign"

(command "_pline"

 

_3dface

 

"_insert" pour "inserer"

"_circle" pour "cercle"

[bonuscad]

La réponse fût Unknown command "245.1684G"

 

Bonjour,

 

Vu le retour, je penche pour un problème d'unité utilisé pour les angles.

A priori tu travaille en "Grades", peut être que le prog ne supporte que les degrés....

Fais un test en degré ;)

[capde06]

comme tout topo qui se respect je suis en grade

mais la fonction (angtos) sans précision utilise l'unité du du système courant

donc la valeur de la variable AUPREC

donc j'pense qu'il ne devrait pas avoir de problème

 

[pierrevigneux]

Bravo capde06

Ça fonctionne à merveille ce sera très utile, pour une étude de drainage.

 

et Merci! bonuscad

Vu le retour, je penche pour un problème d'unité utilisé pour les angles.

A priori tu travaille en "Grades", peut être que le prog ne supporte que les degrés....

Fais un test en degré

 

Pour ma part qui travaille en degré, pas de problème.!

[(gile)]

Salut,

 

Un exemple, en 3d (chaque bloc est inséré dans le plan de la face 3d), sans command ni geomcal (l'exécution est incomparablement plus rapide).

 

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

(defun c:PF3D (/ lgpgp n ss ent elst p1 p2 p3 cg no pgp)
 ;; 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 -1. 0. 0.) (11 1. 0. 0.)))
     (entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 1. 0. 0.) (11 0.5 0.2 0.)))
     (entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 1. 0. 0.) (11 0.5 -0.2 0.)))
     (entmake '((0 . "ENDBLK") (8 . "0")))
   )
 )

 ;; Traitement du jeu de sélection
 (if (and (setq n  -1
	 ss (ssget '((0 . "3DFACE")))
   )
     )
   (while (setq ent (ssname ss (setq n (1+ n))))
     (if
(and
  (setq	elst (entget ent)
	p1   (cdr (assoc 10 elst))
	p2   (cdr (assoc 11 elst))
	p3   (cdr (assoc 12 elst))
  )
  ;; contrôle si la face 3d est triangulaire
  (equal (cdr (assoc 13 elst)) p3 1e-9)
  ;; centre du triangle
  (setq	cg (mapcar
	     '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.))
	     p1
	     p2
	     p3
	   )
  )
  ;; normale de la face
  (setq no (norm_3pts p1 p2 p3))
  ;; vecteur de plus grande pente
  (setq
    pgp
     (vunit (ilp no
		 (list (car no) (cadr no) (- (caddr no) 1.))
		 '(0 0 0)
		 no
	    )
     )
  )
)
 ;; insertion du bloc
 (entmake
   (list '(0 . "insert")
	 '(2 . "PENTE-FLECHE")
	 '(8 . "PENTE-FLECHE")
	 (cons 10 (trans cg 0 no))
	 (cons 50 (angle '(0. 0. 0.) (trans pgp 0 no)))
	 (cons 210 no)
   )
 )
     )
   )
 )
 (princ)
)

;; VXV
;; Retourne le produit scalaire (réel) de deux vecteurs
;;
;; Arguments : deux vecteurs

(defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))

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

;; NORM_3PTS
;; Retourne le vecteur normal du plan défini par 3 points
;;
;; Arguments : trois points

(defun norm_3pts (p0 p1 p2)
 (vunit (v^v (mapcar '- p1 p0) (mapcar '- p2 p0)))
)

;; ILP Retourne le point d'intersection de la droite définie par p1 p2
;; et du plan défini par un point et sa normale.
;;
;; Arguments
;; p1 et p2 : les points définissant la droite dont on cherche l'intersection
;; org : un point queconque du plan d'intersection
;; nor : le vecteur normal du plan d'intersection

(defun ilp (p1 p2 org nor / scl)
 (if (and
(/= 0 (setq scl (vxv nor (mapcar '- p2 p1))))
(setq scl (/ (vxv nor (mapcar '- p1 org)) scl))
     )
   (mapcar (function (lambda (x1 x2) (+ (* scl (- x1 x2)) x1)))
    p1
    p2
   )
 )
)

[lecrabe]

 

Hello

 

Je dois etre une truffe mais avec mon MAP 3D 2009 et un bloc deja defini ou NON,

il ne dessine rien du tout sur mes 3Dfaces ! :o

 

Le Decapode

 

[capde06]

bravo

j'ai testé sur un gros fichier le temps de traitement est presque instantané

on voit la différence entre un pro et un amateur autodidacte

merci pour la leçon.

mais il y a des mystères dans la fonction entmake

quand on regarde tes blocs ils ont tous la même valeur de rotation "200g" pas sur mon prog

quand on regarde les codes DXF des blocs inseré avec entget

le code 50 ne varie pas seul le code 210 est diffèrent ????

 

 

la j'avoue, je ne comprend pas.

 

[(gile)]

lecrabe,

 

Je ne sais que te dire si ce n'est que ce noble champignon (la truffe) doit pouvoir s'accommoder avec un non moins noble crustacé.

Je viens de faire un test sur MAP2009, ça fonctionne.

 

capde06,

 

Je suis aussi autodidacte, j'ai seulement un peu plus de pratique.

mais il y a des mystères dans la fonction entmake

quand on regarde tes blocs ils ont tous la même valeur de rotation "200g" pas sur mon prog

quand on regarde les codes DXF des blocs inseré avec entget

le code 50 ne varie pas seul le code 210 est diffèrent ????

 

Il s'agit en fait des mystère de l'utilisation par AutocAD d'un Système de Coordonnées Objet (SCO) pour décrire la géométrie des entités 2D, clé des arcanes de la programmation LISP en 3d.

 

La fonction entmake fonctionne avec les données DXF, autrement dit la façon dont AutoCAD gère et stocke les propriétés des objets.

Le moyen utilisé pour économiser l'espace en mémoire pour les entités 2d (bloc, textes, cercles, polylignes, etc) est de considérer leur géométrie en 2d dans leur SCO (ou OCS), ce SCO étant définit par le vecteur normal du plan de construction de l'entité (code DXF 210).

 

Dans les données DXF d'une référence de bloc,

- le point d'insertion est décrit en coordonnées SCO, d'où le :

(trans cg 0 no))

- la rotation (code 50) est mesurée à parti de l'axe X du SCO, d'où le :

(angle '(0. 0. 0.) (trans pgp 0 no)

 

Voir ce sujet (réponse 2)

[pierrevigneux]

Bonjour Gile

 

J'ai testé le fichier ça fonctionne très bien, de façon très rapide .

 

Par contre avec le fichier de capde06 les pentes ne sont pas dans le mêmes directions, je crois que le lisp de Gile est plus exacte.

J'envoie le lien dans le dessin que je l'ai testé.

 

http://dl.free.fr/mw7v1Z5Jw

 

Merci à vous deux.

[Patrick_35]

Salut

 

on voit la différence entre un pro et un amateur autodidacte

 

J'ai vu (gile) débuter et très vite grandir et même nous dépasser.

Il a juste pris le temps de comprendre, de se renseigner.

Le site regorge d'exemples et d'explications.

 

Je suis aussi un autodidacte, et seul la passion de la programmation nous dirige

 

@+

[pierrevigneux]

Oh que tu as raison mon cher Patrick_35

 

Devant des pros comme vous je me sens tellement inférieur.

J'en apprend à tous les jours.

Vive CAD xp 

 

Salutations !

[capde06]

J'ai testé le fichier ça fonctionne très bien, de façon très rapide .

 

Par contre avec le fichier de capde06 les pentes ne sont pas dans le mêmes directions, je crois que le lisp de Gile est plus exacte.

J'envoie le lien dans le dessin que je l'ai testé.

 

attention

mon bloc et celui de (gile)

est construit avec une orientation différente

donc comparison impossible

avant d'utiliser les 2 programmes il faut changer les noms du bloc dans l'un des 2 prog

 

mon résultat a été comparé par lili2006 avec covadis : résultat identique

 

(gile)

jai regardé le post sur le SCO

ben la ca dépasse mes compétences en math

mais je vais mi penché

[bonuscad]

J'ai vu (gile) débuter et très vite grandir et même nous dépasser.

 

Je confirme, c'est devenu une pointure. Moi je suis rester dans les chaussettes, c'est lui qui maintenant me fait progresser, mais le temps (et des fois l'envie) me manque pour décortiquer ses codes et les comprendre.

 

Son investissement sur le site m'époustoufle, je n'en n'aurais pas fait autant :P

 

Bravo à lui et merci !

[Patrick_35]

Devant des pros comme vous je me sens tellement inférieur.

Il n'y a aucune raison.

Si tu as besoin d'une explication sur une ligne de code, c'est avec plaisir que l'on te donnera satisfaction

 

@+

[Patrick_35]

Son investissement sur le site m'époustoufle, je n'en n'aurais pas fait autant :P

 

Bravo à lui et merci !

Je ne saurai dire mieux

 

@+

[capde06]

le nouveau code insère les pourcentages de pente

pas encore optimisé a la mode (gile) mais bon....

il me faut du temps pour comprendre....

 

 

 

(defun c:pente-mnt  (/ p1 p2 p3 g pt1 pt2 pt3 pt4 pt5 sel i)
 (if (not (member "geomcal.arx" (arx)))
   (arxload "geomcal")
   ) ;_ Fin de if
 (setvar "attreq" 0) ;variable pour inserser bloc
 (command "scu" "g")
 (setq	oldpl	 (getvar "clayer")
oldos	 (getvar "osmode")
oldcolor (getvar "cecolor")
HT	 0.15
)
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
;(setvar "styletext" "standard")

 (If (Not (tblsearch "BLOCK" "Fleche-pente23"))

   (progn
     
     (setvar "aflags" 8)
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     (setq oldpl (getvar "clayer")
    pt1	  (list 0 -0.5 0)
    pt2	  (list 0 0 0)
    pt3	  (list 0 0.5 0)
    pt4	  (list 0.125 0.125 0)
    pt5	  (list -0.125 0.125 0)
    pt6	  (list -0.15 -0.5 0)
    pt7	  (list -0.15 0.5 0)
    ent	  nil
    ent	  (ssadd)
    Hatt  0.15
    sel nil
    ) ;_ Fin de setq
     (setvar "clayer" "0")
     (command "polylign" pt1 pt2 pt3 pt4 pt5 pt3 "")
     (setq ent (ssadd (entlast)))
     (command "-calque"
       "et"
       "Pente-Attribut"
       ""
       ) ;_ Fin de command
; créer l'attribut
     (command "-attdef"    "v"		 ""	      "NUM"
       "Pente de la face 3D"	 "0"	      "s"	   "standard"
       pt6	    Hatt	 pt7)
     (setq ent (ssadd (entlast) ent))
     (command "-bloc" "Fleche-pente23" pt2 ent "")
     (setvar "clayer" oldpl)
     
     (setvar "aflags" 0)
     )
   ) ;_ Fin de If

 (If (Not (tblsearch "LAYER" "Pente-Fleche"))
   (command "-calque"
     "n"
     "Pente-Fleche"
     ""
     ) ;_ Fin de command
   )
 (setvar "clayer" "Pente-Fleche")

;sélection des points d'une face 3D
 (prompt "\nSelection du MNT :")
 (setq	sel (ssget '((0 . "3DFACE")))
i   0
) ;_ Fin de setq
 (repeat (sslength sel)
;selection des entités un à un
   (setq ent (ssname sel i)
  p1  (cdr (assoc 10 (entget ent)))
  p2  (cdr (assoc 11 (entget ent)))
  p3  (cdr (assoc 12 (entget ent)))
  g   (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.)) p1 p2 p3)
  n   (cal "nor(p1,p2,p3)")
  Xg  (car g)
  Yg  (cadr g)
  Xn  (car n)
  Yn  (cadr n)
  Zn  (caddr n)
  )
;calcul de la pente
   (setq pente-tx
   (strcat
     (rtos
       (* 100 (/ (sqrt (+ (expt Xn 2) (expt Yn 2))) (abs Zn)))
       2
       1)
     "%"))

;calcul de la direction de la pente
   (setq liste (list (+ Xg Xn) (+ Yg Yn)))
;insertion du bloc avec l'attribut
   (setq ang (angtos (angle g liste)))
   (command "-inserer" "Fleche-pente23" g "0.5" "0.5" ang)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   (upd_blk (entlast) "NUM" 1 pente-tx)
   (setq i (+ i 1))

   ) ;_ Fin de repeat

(command "scu" "p")
 (setvar "clayer" oldpl)
 (setvar "osmode" oldos)
 (setvar "cecolor" oldcolor)

 )
(defun upd_blk(obj eti code txt)
  (setq ent_att (entnext obj))          
  (while (/= (cdr (assoc 0(entget ent_att))) "SEQEND")
     (if (= (cdr(assoc 2(entget ent_att))) eti)
        (progn
           (setq e (entget ent_att))
           (entmod (subst (cons code txt) (assoc code e)e))
           (entupd obj)              
        )
     )
     (setq ent_att (entnext ent_att))
  )
) 

[Patrick_35]

pas encore optimisé a la mode (gile) mais bon....

Petit à petit, l'oiseau fait son nid

 

@+

[(gile)]

Stop !

Vous allez me faire rougir...

 

Si j'ai "progressé si vite", c'est que j'ai eu la chance d'avoir du temps que j'ai principalement utilisé à assouvir cette "passion", et que certains ici m'ont beaucoup appris*.

Mais c'est aussi grâce à mon "investissement sur CADxp" : essayer de répondre aux différentes demandes est un très bon exercice parce qu'il amène à répondre des questions que l'on ne se serait certainement jamais posées en se cantonnant à son domaine (ce sujet en est l'illustration, je n'ai, à priori, rein à voir avec la topo).

 

*comme ceux qui ont aujourd'hui des ceintures noire et rouge en ayant donné beaucoup plus de réponses qu'ils n'ont posé de questions et parlent de "l'investissement" des autres.