courbes

capde06 · le 22 mars 2010

je met en ligne le dernier né

création de courbes de niveau sur un MNT

le style de programmation et la méthode n'est pas très académique, mais bon....

le lissage a la fin du traitement ne satisfait pas vraiment, mais si vous avez des idées.....

(defun c:courbeniv ()
::auteur Capde06 - CapTopo


 (setq	zmax	-9999999.99
zmin	9999999.99
cpx	0
plan	125
listsom	nil
;tpoly nil
plcourt	(getvar "clayer")
oldos	(getvar "osmode")
espace	nil

 ) ;_ Fin de setq

 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
(if (not (tblsearch "LAYER" "TOPO-COURBES-NIVEAU"))
 (cap_crea_pl "TOPO-COURBES-NIVEAU" 7)
 )
(if (not (tblsearch "LAYER" "TOPO-COURBES-NIVEAU-5"))
 (cap_crea_pl "TOPO-COURBES-NIVEAU-5" 2)
 )
 (if (not (tblsearch "LAYER" "TOPO-COURBES-NIVEAU-10"))
 (cap_crea_pl "TOPO-COURBES-NIVEAU-10" 3)
   )
 (setvar "clayer" "TOPO-COURBES-NIVEAU")

 ;(command "scu" "g")
 (setq sel (ssget '((0 . "3DFACE"))))
 ;;           recherche zmini zmaxi
 (repeat (sslength sel)
   (setq ent	 (ssname sel cpx)
  dxf10	 (cdr (assoc 10 (entget ent)))
  dxf11	 (cdr (assoc 11 (entget ent)))
  dxf12	 (cdr (assoc 12 (entget ent)))
  dxf10z (caddr dxf10)
  dxf11z (caddr dxf11)
  dxf12z (caddr dxf12)

   ) ;_ Fin de setq
   (if	(> dxf10z zmax)
     (setq zmax dxf10z)
   ) ;_ Fin de if
   (if	(> dxf11z zmax)
     (setq zmax dxf11z)
   ) ;_ Fin de if
   (if	(> dxf12z zmax)
     (setq zmax dxf12z)
   ) ;_ Fin de if
   (if	(< dxf10z zmin)
     (setq zmin dxf10z)
   ) ;_ Fin de if
   (if	(< dxf11z zmin)
     (setq zmin dxf11z)
   ) ;_ Fin de if
   (if	(< dxf12z zmin)
     (setq zmin dxf12z)
   ) ;_ Fin de if
   (setq listsom (cons (list dxf10 dxf11 dxf12) listsom))


   (setq cpx (+ cpx 1))
 ) ;_ Fin de repeat


 (prompt (strcat "\nAltitude maxi : "
	  (rtos zmax 2 0)
	  " - Altitude mini : "
	  (rtos zmin 2 0)
  ) ;_ Fin de strcat
 ) ;_ Fin de prompt
 (setq espace (getreal "\nValeur de l'espacement des courbes : "))
 (if (not espace)
   (setq espace 1)
 ) ;_ Fin de if

;;;; creation liste des coupes
 (setq	listcoupe nil
cp (fix zmin)
 ) ;_ Fin de setq

 (while (< cp zmax) ; (/(fix (- zmax zmin))espace)
   (setq cp (+ cp espace))
   (setq listcoupe (cons cp listcoupe))
 ) ;_ Fin de repeat
 (setq listcoupe (reverse listcoupe))
;(setq listcoupe (list 327.22))

 ;;==========================================================


 (foreach plan	listcoupe
   (print plan)
   (setq cpx 0) ;_ Fin de setq

   (repeat (length listsom)
     (setq llist (nth cpx listsom))
     (setq p1 (car llist)
    p2 (cadr llist)
    p3 (caddr llist)

     ) ;_ Fin de setq
     (setq mini (min (caddr p1)
	      (caddr p2)
	      (caddr p3)
	 ) ;_ Fin de min
    maxi (max (caddr p1)
	      (caddr p2)
	      (caddr p3)
	 ) ;_ Fin de max
     ) ;_ Fin de setq
     (setq pt1	nil
    pt2	nil
    pt3	nil
    listcal nil
     ) ;_ Fin de setq



     

     (if (and (>= plan mini) (<= plan maxi))
(progn

  (if (and (<= plan (caddr p1)) (> plan (caddr p2)))
    (setq listcal (cons (cap-i3d p1 p2 plan) listcal))
  ) ;_ Fin de if
  (if (and (<= plan (caddr p1)) (> plan (caddr p3)))
    (setq listcal (cons (cap-i3d p1 p3 plan) listcal))
  ) ;_ Fin de if
  (if (and (<= plan (caddr p2)) (> plan (caddr p3)))
    (setq listcal (cons (cap-i3d p2 p3 plan) listcal))
  ) ;_ Fin de if+++
  (if (and (>= plan (caddr p1)) (< plan (caddr p2)))
    (setq listcal (cons (cap-i3d p1 p2 plan) listcal))
  ) ;_ Fin de if
  (if (and (>= plan (caddr p1)) (< plan (caddr p3)))
    (setq listcal (cons (cap-i3d p1 p3 plan) listcal))
  ) ;_ Fin de if
  (if (and (>= plan (caddr p2)) (< plan (caddr p3)))
    (setq listcal (cons (cap-i3d p2 p3 plan) listcal))
  ) ;_ Fin de if

  (cond

   ((= (length listcal)1) ;_ Fin de =
   
      (if (equal plan (caddr p1))
       (setq listcal (cons p1 listcal))
      )
      (if(equal plan (caddr p2))
       (setq listcal (cons p2 listcal))
      )
      (if(equal plan (caddr p3))
       (setq listcal (cons p3 listcal))
      )
    (cap_cn_pol (car listcal) (cadr listcal))
   
   )
   ((= (length listcal) 2)
    (cap_cn_pol (car listcal) (cadr listcal))
   ) ;_ Fin de progn
 ) ;_ Fin de cond
  )

     ) ;_ Fin de if

     (setq cpx (+ cpx 1))
;
   ) ;_ Fin de repeat
 ) ;_ Fin de foreach

 
 (setq	sel (ssget "x" '((0 . "LINE") (8 . "TOPO-COURBES-NIVEAU*")))) ;_ Fin de setq
 (setvar "peditaccept" 1)
 (setvar "splinetype" 5)
 (command "pedit" "m" sel "" "j" "0" "")
 (setvar "peditaccept" 0)





 ;;traitement des couleurs
(setq	sel (ssget "x" '((0 . "LWPOLYLINE") (8 . "TOPO-COURBES-NIVEAU*")))) ;_ Fin de setq
 (setq cpt 0)
 (print "======================")
 (repeat (sslength sel)
(setq ent (ssname sel cpt))
   (setq elev (cdr(assoc 38 (entget ent))))
   
   (cond
   ((= (rem elev 10.) 0.)
    (upd_ent ent 8 "TOPO-COURBES-NIVEAU-10")
   )
   ((= (rem elev 5.) 0.)
    (upd_ent ent 8 "TOPO-COURBES-NIVEAU-5")
   )
 )
   (setq cpt (+ cpt 1))
   )
;;===========================


 (setvar "osmode" oldos)
 (setvar "clayer" plcourt)
) ;_ Fin de defun

;;;fonctions==================

(defun cap_cn_pol (a b)
 (setq	pt1 (list (car a) (cadr a))
pt2 (list (car b) (cadr b))
 ) ;_ Fin de setq
 (if (not (equal pt1 pt2))
   (entmake

     (list

'(0 . "LINE")

'(8 . "TOPO-COURBES-NIVEAU")

(cons 10 (list (car a) (cadr a) plan))

(cons 11 (list (car b) (cadr b) plan))
'(210 0.0 0.0 1.0)

     ) ;_ Fin de list

   ) ;_ Fin de entmake
 ) ;_ Fin de if

) ;_ Fin de defun







(defun cap-i3d (p1 p2 comp)

 (setq	c    (/ (- (caddr p1) comp) (- (caddr p2) comp))
newx (/ (- (* c (car p2)) (car p1)) (- c 1))

newy (/ (- (* c (cadr p2)) (cadr p1)) (- c 1))

 ) ;_ Fin de setq

 (list newx newy)

) ;_ Fin de defun


;; ; met a jour une entite : entité avant entget  + code + valeur 

(defun upd_ent (obj code txt)

 (setq obj (entget obj))
 (entmod (subst (cons code txt) (assoc code obj) obj))
) ;_ Fin de defun


(defun cap_crea_pl  (pl cl)

 (if (not (tblsearch "LAYER" pl))
   (entmake (list
       '(0 . "LAYER")
       '(100 . "AcDbSymbolTableRecord")
       '(100 . "AcDbLayerTableRecord")
       (cons 2 pl)
       '(70 . 0)
       (cons 62 cl)
       '(6 . "Continuous")
       )
     )
   )
 )

[Edité le 4/5/2010 par capde06][Edité le 5/5/2010 par capde06]

[Edité le 12/5/2010 par capde06]

RhymOne · le 26 avril 2010

Salut cadpe06

Super ravi de ce code j'ai plein d'idée la dessus si tu pouvais intervenir à mes remarques je pense que qqchose de propre est a sortir...

RhymOne · le 26 avril 2010

Super ce lisp vraiment .

Dire qu'un certain utilisateur m'avait dit que cetait impossible en lisp de pondre des courbe de niveau.

Merci cadpe06...

J'aimerais si possible avoir le choix de lisser les courbes ou non.

Merci d'avance j'essaye d'adapté ton lisp a un dcl ou le choix des calque et des couleur se ferait.

pierrevigneux · le 27 avril 2010

Bonsoir capde06

Je viens d'essayer ton code, d'un levé que j'ai fait la semaine dernière en montagne.

Ça m,as pris presque 30 minutes à faire tracer les courbes de niveau, c'est bien mais les polylignes qui sont générées n'ont pas d'altitudes, elles sont placées aux bons endroits en x et y mais n'ont pas de valeurs Z.

Bonsoir @+

RhymOne · le 28 avril 2010

Salut

Biensur que si les courbes sont elevé.

Le seul petit truc c'est le lissage.

J'avou sur des gros MNT sa met du temps.

Pas de reponse de l'auteur ?

A plus

pierrevigneux · le 28 avril 2010

Bonjour rhymone

 Biensur que si les courbes sont elevé.
Le seul petit truc c'est le [surligneur] lissage [/surligneur].

De quelle façon tu le fais?

@+

RhymOne · le 28 avril 2010

Ba il se fait tout seul justement et j'aimerais avoir la main pendant le lisp pour choisir le parametre de lissage:

(-Aucune

-Lissée

-Second Ordre

-Toisième ordre)

A plus.

capde06 · le 28 avril 2010

hello l'auteur c'est moi

  Ba il se fait tout seul justement et j'aimerais avoir la main pendant le lisp pour choisir le parametre de lissage:

pour le lissage voir (setvar "splinetype" 5) mettre 5 ou 6

Je viens d'essayer ton code, d'un levé que j'ai fait la semaine dernière en montagne.
Ça m,as pris presque 30 minutes à faire tracer les courbes de niveau, c'est bien mais les polylignes qui sont générées n'ont pas d'altitudes, elles sont placées aux bons endroits en x et y mais n'ont pas de valeurs Z.

effectivement en lisp le temps de traitement est long, il faudrait d'une âme charitable pour le traduise en .net.

elles n'ont pas de Z parce que ce sont des polylignes 2d

[Edité le 28/4/2010 par capde06]

RhymOne · le 28 avril 2010

Ouh la je comprend plus même si l'auteur commence a denigrer son lisp.

Les courbes ont chacun un z différents ce sont des polyligne nouvelle de type LW.

Par contre j'aimerais qu'on puisse choisir le mode de lissage pendant le lisp est-ce possible de l'integrer au code?

(gile) · le 28 avril 2010

effectivement en lisp le temps de traitement est long, il faudrait d'une âme charitable pour le traduise en .net.

Déja en utilisant entmake ou les fonctions vla* à la place de command, il y a certainement moyen d'accélérer notablement l'histoire.

capde06 · le 4 mai 2010

J'ai un peu améliore la première version (voir 1er envoi mis a jour)

j'ai traité des cas particuliers.

j'ai optimisé le code

comme dit (gile) avec entmake ca va beaucoup plus vite.

mais y reste un peu de boulot dessus

[Edité le 4/5/2010 par capde06]

pierrevigneux · le 4 mai 2010

Bravo capde06

Nettement meilleur super rapide en plus,

C'est franchement mieux encore Bravo,

Merci à toi !

@+

pierrevigneux · le 4 mai 2010

mais y reste un peu de boulot dessus

Si tu pouvais faire une autre commande pour écrire leurs valeur, aux lignes de contours ce serait top.

Merci d'avance!

capde06 · le 5 mai 2010

salut

 Nettement meilleur super rapide en plus,

peux tu le tester avec le fichier qui a mis 30 minute

pour voir la différence

Je viens d'essayer ton code, d'un levé que j'ai fait la semaine dernière en montagne.
Ça m,as pris presque 30 minutes à faire tracer les courbes de niveau

pierrevigneux · le 5 mai 2010

Mais mon cher s'est sur ce même dessin que je l'ai testé et ça marche Nickel.

Merci !

Voilà la différence.

RhymOne · le 5 mai 2010

(Re)

Citation:

pour le lissage voir (setvar "splinetype" 5) mettre 5 ou 6

Ok sa c'est cool mais pour aucun lissage c'est quoi.

Il faudrait vraiment un .dcl a coté pour choisir le nom des calques la couleur l'equidistance et pourquoi pas le lissage se serait au top.

Par contre la dernière mis a jour ne fonctionne pas chez moi :

Commande: courbeniv2 Commande inconnue:"CAP_CREA_PL"

J'ai autocad 2010 x64

Merci d'avance

capde06 · le 5 mai 2010

dans la nouvelle version j'ai supprimé le lissage

tant que le prog n'est pas au point et si j'ai le temps, je ferai peut être une boite de dialogue

 Commande: courbeniv2 Commande inconnue:"CAP_CREA_PL"

le command est :

courbniv

j'ai aussi 2010 x64

RhymOne · le 5 mai 2010

(Re)Bonjour,

Autant pour moi le code marche nikel le temps gange est impressionant.

RhymOne · le 5 mai 2010

Merci cadpe c'st cool pour la dcl se serait vraiment sympathique.

Par contre le lissage m'interessait c'est seulement que je veut avoir le choix selon le type de mnt je veut soit des courbes lissées ou des droites.

En tout cas sa l'arrange bien ton petit progr.

Mon applicatifs perso s'enrichient si cela ne te derange pas.

pierrevigneux · le 5 mai 2010

Parfaitement d'accoprd avec toi rhymone

Mon applicatifs perso s'enrichient si cela ne te derange pas.

Moi aussi capde06

Je te remercie beaucoup !

RhymOne · le 6 mai 2010

Salut a vous,

Pierrevigneux de quel genre d'applicatif il sagit stp.

On aurait peut etre des chose en commun a se communiquer.

Moi c'est une appli TOPO et 3D.

pierrevigneux · le 6 mai 2010

Salut rhymone

Je suis un technicien en génie-civil et je travaille pour un entrepreneur en construction et j'agit comme chef de chantier, je fais de l'estimation pour la firme.

Nous avons également une firme de génie-conseil d'ou j'effectue tous les plans et relevés topographiques et nous possédons un laboratoire en sol.

Nous possédons des carrières et gravières dont j'effectue des relevés pour les quantitées de l'exploitation des carrières.

J'adore faire de la géométie routière bref nous oeuvrons surtout avec des promoteur, genre clée en main (de la conception à l'exécution.)

Est-ce que ça répond à ta question?

Je suis Canadien!

capde06 · le 7 mai 2010

je vous signale que moi aussi j'ai fait une appli topo

CapTopo

vous pouvez la telecharger la

http://sites.google.com/site/captopo/Home

il y a tout pour la topo 2D un peu de 3D

et en plus c'est gratuit et les codes ne sont pas criptés

RhymOne · le 7 mai 2010

(Re)Salut,

Citation:

Est-ce que ça répond à ta question?

Je suis Canadien!

A peu près mais je voulais savoir quelle est ton genre d'applicatif que tu crée dans ta boite.

Je vais regarde cadpe06

T'interesse tu au mien?

pierrevigneux · le 7 mai 2010

Salut

A peu près mais je voulais savoir quelle est ton genre d'applicatif que tu crée dans ta boite

Ce sont des plans et profils,

Je travaille avec Autocad 2004 avec un logciel intégré Cadarp pour le traitement des donnée de ma station totale.

Merci capde06 pour ton appli topo je vais l'essayer.

Connexion

courbes

Messages recommandés

capde06

RhymOne

RhymOne

pierrevigneux

RhymOne

pierrevigneux

RhymOne

capde06

RhymOne

(gile)

capde06

pierrevigneux

pierrevigneux

capde06

pierrevigneux

RhymOne

capde06

RhymOne

RhymOne

pierrevigneux

RhymOne

pierrevigneux

capde06

RhymOne

pierrevigneux

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante