Draper entités sur MNT

[chris_mtp]

Bonjour à tous

 

Existe t-il une routine lisp qui permet de plaquer une polyligne 2D sur un MNT pour en créer une polyligne 3D à chaque intersection d'une des faces du MNT ?

Je sais que cette fonction existe sous Covadis mais je ne l'ai pas.

 

Merci par avance de votre aide.

John.

[bonuscad]

Bonjour,

 

J'avais lancé un sujet similaire. Tu peux t'en inspiré.

 

Bien sur le code (mal fichu) n'est pas du tout généralisé à tous les environnements (écrit pour mon besoin propre), mais tu pourras peut être l'adapter à ton besoin?

[chris_mtp]

Merci pour cette info.

J'ai essayé de modifier le code mais le vlisp c chaud à comprendre.

 

J'ai enlevé la partie du code qui décompose les 3D maillles en faces 3D.

 

Mais après j'ai l'erreur suivante

 

 ; erreur: Erreur Automation Argument Distance incorrect dans Offset method

Un pb avec la commande Offset ok mais Pourquoi ?

Je manque de connaissances à ce niveau.

Pour l'instant je ne vois pas trop comment faire mais je vais chercher de mon côté.

 

La base de départ :

 

 

 

 (defun punktinpolylinie	(pointinquestion point_list /)
 (if (equal 0.0
     (pipwinkelsumme pointinquestion point_list)
     0.0001
     )
   nil
   t
 )
)
(defun pipwinkelsumme (pointinquestion		 point_list
	       /	    count	 p1
	       p2	    scheitel	 winkeleins
	       winkelzwei
	      )
 (setq
   winkeleins 0.0
   scheitel   (car point_list)
   count      1
 )
 (while (< 1 (length point_list))
   (setq
     p1	 (car point_list)
     p2	 (cadr point_list)
     point_list (cdr point_list)
     winkelzwei (pipwinkelhilfe pointinquestion p1 p2)
     winkelzwei (if (< 180.0 winkelzwei)
	   (- winkelzwei 360.0)
	   winkelzwei
	 )
     winkeleins (+ winkeleins winkelzwei)
   )
   (setq count (1+ count))
 )
 (setq
   winkelzwei (pipwinkelhilfe pointinquestion p2 scheitel)
   winkelzwei (if (< 180.0 winkelzwei)
	 (- winkelzwei 360.0)
	 winkelzwei
       )
 )
 (+ winkeleins winkelzwei)
)
(defun pipwinkelhilfe (pointinquestion p1 p2 / alpha beta)
 (setq
   beta  (angle pointinquestion p1)
   alpha (angle pointinquestion p2)
   alpha (- alpha beta)
 )
 (if (< alpha 0)
   (setq alpha (+ (* 2 pi) alpha))
 )
 (* (/ (float alpha) pi) 180.0)
)
(defun c:lw2pl3f (/)
 (princ "\nChoisir la polyligne 2D")
 (setq js_lw (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
 (cond
   (js_lw
    (setvar "cmdecho" 0)
    (setq
      dxf_lw  (entget (ssname js_lw 0))
      vla_obj (vlax-ename->vla-object (cdar dxf_lw))
      dxf_elw (cdr (assoc 40 dxf_lw))
      loop    0
    )
    (vla-Offset vla_obj (/ dxf_elw 2))
    (repeat 2
      (setq
 dxf_lw	(entget (entlast))
 dxf_10	(mapcar
	  'cdr
	  (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lw)
	)
 all_pt	nil
      )
      (while dxf_10
 (if (cdr dxf_10)
   (if (setq
	 rslt (vl-remove
		nil
		(mapcar
		  '(lambda (x y)
		     (inters (car dxf_10) (cadr dxf_10) x y T)
		   )
		  (cons (last bdx) bdx)
		  bdx
		)
	      )
       )
     (if (and (punktinpolylinie p1 bdx)
	      (not (equal (car dxf_10) (car rslt) 1E-12))
	 )
       (setq p1	    (car dxf_10)
	     dxf_10 (cons p1 (cons (car rslt) (cddr dxf_10)))
       )
       (setq p1 (car rslt))
     )
     (setq p1 (car dxf_10))
   )
 )
 (setq
   js	  (ssget "_C"
		 (list (- (car p1) 25.0) (- (cadr p1) 25.0))
		 (list (+ (car p1) 25.0) (+ (cadr p1) 25.0))
		 '((0 . "3DFACE") (8 . "MAILLAGE3D"))
	  )
   p1	  (trans p1 1 0)
   p1	  (list (car p1) (cadr p1))
   n	  -1
   lst_px nil
 )
 (cond
   (js
    (repeat (sslength js)
      (setq
	dxf_ent	(entget (ssname js (setq n (1+ n))))
	lst_pt
		(list
		  (cdr (assoc 10 dxf_ent))
		  (cdr (assoc 11 dxf_ent))
		  (cdr (assoc 12 dxf_ent))
		  (cdr (assoc 13 dxf_ent))
		)
      )
      (if (equal (caddr lst_pt) (cadddr lst_pt))
	(setq lst_pt (list (car lst_pt)
			   (cadr lst_pt)
			   (caddr lst_pt)
			   (car lst_pt)
		     )
	)
	(setq lst_pt (append lst_pt (list (car lst_pt))))
      )
      (if (punktinpolylinie p1 lst_pt)
	(progn
	  (command "_.ucs"
		   "_3point"
		   "_none"
		   (car lst_pt)
		   "_none"
		   (cadr lst_pt)
		   "_none"
		   (caddr lst_pt)
	  )
	  (setq
	    p_10   (trans (list (car p1) (cadr p1) 1000.0) 0 1)
	    p_11   (trans (list (car p1) (cadr p1) 0.0) 0 1)
	    p10_2d (list (car p_10) (cadr p_10) 0.0)
	    p11_2d (list (car p_11) (cadr p_11) 0.0)
	    p_int  (trans (inters p10_2d p11_2d p_10 p_11 nil)
			  1
			  0
		   )
	    lst_px (cons p_int lst_px)
	  )
	  (command "_.ucs" "_world")
	)
      )
    )
    (if	lst_px
      (setq all_pt (append lst_px all_pt))
    )
   )
 )
 (setq dxf_10 (cdr dxf_10))
      )
      (cond
 (all_pt
  (setq pt_all (list (car all_pt)))
  (while (cdr all_pt)
    (setq
      p1     (car all_pt)
      p2     (cadr all_pt)
      js     (ssget "_F" (list p1 p2) '((0 . "3DFACE") (8 . "MNT")))
      p1     (trans p1 1 0)
      p2     (trans p2 1 0)
      p1     (list (car p1) (cadr p1))
      p2     (list (car p2) (cadr p2))
      n	     -1
      lst_px nil
    )
    (cond
      (js
       (repeat (sslength js)
	 (setq
	   dxf_ent (entget (ssname js (setq n (1+ n))))
	   lst_pt
		   (list
		     (cdr (assoc 10 dxf_ent))
		     (cdr (assoc 11 dxf_ent))
		     (cdr (assoc 12 dxf_ent))
		     (cdr (assoc 13 dxf_ent))
		   )
	 )
	 (if (equal (caddr lst_pt) (cadddr lst_pt))
	   (setq lst_pt	(list (car lst_pt)
			      (cadr lst_pt)
			      (caddr lst_pt)
			      (car lst_pt)
			)
	   )
	   (setq lst_pt (append lst_pt (list (car lst_pt))))
	 )
	 (while	(cdr lst_pt)
	   (setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T))
	   (if px
	     (progn
	       (setq
		 px (inters (list (car px) (cadr px) 0.0)
			    (list (car px) (cadr px) 100.0)
			    (car lst_pt)
			    (cadr lst_pt)
			    nil
		    )
	       )
	       (if (and px (not (member px lst_px)))
		 (setq lst_px (cons px lst_px))
	       )
	     )
	   )
	   (setq lst_pt (cdr lst_pt))
	 )
       )
       (if lst_px
	 (progn
	   (setq new_lst nil)
	   (while lst_px
	     (setq
	       l (mapcar '(lambda (x) (distance x p1)) lst_px)
	     )
	     (setq
	       el (nth (- (length lst_px)
			  (length (member (apply 'min l) l))
		       )
		       lst_px
		  )
	     )
	     (setq
	       lst_px  (vl-remove el lst_px)
	       new_lst (cons el new_lst)
	     )
	   )
	   (setq pt_all
		  (append (list (cadr all_pt)) new_lst pt_all)
	   )
	 )
	 (setq pt_all (append (list (cadr all_pt)) pt_all))
       )
      )
      (T (setq pt_all (append (list (cadr all_pt)) pt_all)))
    )
    (setq all_pt (cdr all_pt))
  )
  (command "_.3dpoly")
  (foreach el pt_all (command "_none" (trans el 0 1)))
  (command "")
  (entdel (cdar dxf_lw))
 )
 (T (princ "\nAucune 3DFACE trouvée!"))
      )
      (if (not (zerop (rem (setq loop (1+ loop)) 2)))
 (vla-Offset vla_obj (- (/ dxf_elw 2.0)))
      )
    )
    (setvar "cmdecho" 1)
   )
 )
 (prin1)
)

Si vous avez du temps ou des idées.

 

Merci par avance de votre aide.

[bonuscad]

J'ai enlevé la partie du code qui décompose les 3D maillles en faces 3D.

 

Déjà, si tu fais ça, il ne se passera rien, car le code travaille avec des 3DFaces essentiellement.

 

Un pb avec la commande Offset ok mais Pourquoi ?

 

Çà par contre tu peux peut être supprimer, car à l'origine je voulais transformer une polyligne2D avec une épaisseur constante en deux polyligne3D (qui représenteraient les bords 3D).

 

Je manque de connaissances à ce niveau.

Il est peut être pas opportun de se lancer dans du code aussi complexe, car tu risque de bloquer à chaque étape. :exclam:

 

Si tu m'envoie un extrait de ton DWG, à temps perdu je pourrais voir si je peux faire une adaptation rapide... (rien de sûr)

 

valsecchi(at)ifrance.com

 

traduire (at) comme il se doit.

 

 

[chris_mtp]

Mon DWG est tout simple. J'ai des 3d faces dans le calque MNT et une polyligne 2D dans le calque 0 et d'épaisseur 0 avec une élevation à 0.

J'ai un MNT avec des 3D faces. Je n'ai pas de mailles ni de solides 3d.

Donc pas besoin je pense de la première partie(celle qui décompose les mailles en 3D faces) non ?

 

Je t'envoie quand même un DWG au cas où.

 

Merci quand même.

John.

[chris_mtp]

Pourquoi ne pourrait on pas changer la méthode de traitement initiale ?

Si au lieu de créer une polyligne 3D à partir de la 2D, on ne pourrait pas simplement créer à chaque intersection de la polyligne et d'une 3D face un point nodal classique.

 

Je suis en train de voir si je peux adapter un des lisp de Gile d'ici http:// http://www.cadxp.com/XForum+print-fid-100-tid-17001.html?POSTNUKESID=4bcf046fb35c7acd19fe2a01e3128703

 

pour en fait d'abord plaquer simplement un point sur une 3d face à la bonne altitude Z.

 

Mais je bloque sur la fonction INTERS-3DFACE-POINT.

Merci par avance de votre aide.

John.

 

 

[bonuscad]

Bonjour,

 

je suis parti de cette réponse pour extraire ce qui suit.

 

J'ai fait cela rapidement. Avec les fichier fournis en exemple ça fonctionne, il suffit de décomposer ta polyligne2D à deux sommet pour en faire une ligne simple et appliquer ce qui suit:

 

(defun c:coupe_MNT (/	    js_line dxf_line	    p1	    p2
	    all_pt  js	    n	    lst_px  dxf_ent lst_pt
	    px	    new_lst l	    el	    pt_all
	   )
 (setq js_line (ssget "_+.:E:S" '((0 . "LINE"))))
 (cond
   (js_line
    (setvar "cmdecho" 1)
    (setq
      dxf_line	(entget (ssname js_line 0))
      p1	(list (cadr (assoc 10 dxf_line))
	      (caddr (assoc 10 dxf_line))
	)
      p2	(list (cadr (assoc 11 dxf_line))
	      (caddr (assoc 11 dxf_line))
	)
      all_pt	nil
    )
    (command "_.zoom" "_window" p1 p2)
    (setq
      js     (ssget "_F" (list p1 p2) '((0 . "3DFACE")))
      n      -1
      lst_px nil
    )
    (cond
      (js
(repeat	(sslength js)
  (setq
    dxf_ent (entget (ssname js (setq n (1+ n))))
    lst_pt
	    (list
	      (cdr (assoc 10 dxf_ent))
	      (cdr (assoc 11 dxf_ent))
	      (cdr (assoc 12 dxf_ent))
	      (cdr (assoc 13 dxf_ent))
	    )
  )
  (if (equal (caddr lst_pt) (cadddr lst_pt))
    (setq lst_pt (list (car lst_pt)
		       (cadr lst_pt)
		       (caddr lst_pt)
		       (car lst_pt)
		 )
    )
    (setq lst_pt (append lst_pt (list (car lst_pt))))
  )
  (while (cdr lst_pt)
    (setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T))
    (if	px
      (progn
	(setq px (inters (list (car px) (cadr px) 0.0)
			 (list (car px) (cadr px) 100.0)
			 (car lst_pt)
			 (cadr lst_pt)
			 nil
		 )
	)
	(if (and px (not (member px lst_px)))
	  (setq lst_px (cons px lst_px))
	)
      )
    )
    (setq lst_pt (cdr lst_pt))
  )
)
(if lst_px
  (progn
    (setq new_lst nil)
    (while lst_px
      (setq l (mapcar '(lambda (x) (distance x p1)) lst_px))
      (setq el (nth (- (length lst_px)
		       (length (member (apply 'min l) l))
		    )
		    lst_px
	       )
      )
      (setq
	lst_px	(vl-remove el lst_px)
	new_lst	(cons el new_lst)
      )
    )
    (setq pt_all (append (list (cadr all_pt)) new_lst pt_all))
  )
  (setq pt_all (append (list (cadr all_pt)) pt_all))
)
      )
    )
    (setq all_pt (cdr all_pt))
    (setvar "expert" 5)
    (command "_.ucs" "_world")
    (command "_.ucs"
      "_3point"
      ".xy"
      "_none"
      (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5))
      0.0
      ".xy"
      "_none"
      p2
      0.0
      ".xy"
      "_none"
      (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5))
      1000.0
    )
    (command "_.plan" "")
				;			(setvar "cecolor" "3")
    (command "_.pline")
    (foreach el (cdr pt_all) (command "_none" (trans el 0 1)))
    (command "")
    (command "_.ucs" "_previous")
    (command "_.ucs" "_previous")
    (command "_.plan" "")
   )
 )
)

[chris_mtp]

Ca marche nickel avec mon fichier.

J'ai contrôlé l'altitude des points interpolés. Pas de souci.

J'ai modifié la commande -pline à la fin par -3dpoly pour qu'il trace une polyligne 3D en résultat.

Je l'ai testé avec un autre fichier toujours sur le même principe.

Pas de souci.

Bravo encore et merci.

John.

[chris_mtp]

Si pour les lignes ca marche, pour les points, c'est un peu plus compliqué.

 

J'essaye de faire une grille de point puis de faire projeter chaque point de cette grille sur la face3D à la verticale de ce point en utilisant la fonction de gile posté sur un autre sujet mais je bloque sur la partie surligné.

 

 (defun c:grille_nod (/ p1 p2 m lon lar x y ss1 i)

(setvar "PDMODE" 3)
(setvar "PDSIZE" 0.1)
(setq p1 (getpoint "\nPoint bas gauche de la grille : "))
(setq p2 (getcorner p1 "\nPoint haut droit de la grille : "))
(setq lon (- (car p2) (car p1)))
(setq lar (- (cadr p2) (cadr p1)))
(setq m (getdist "\nEntrer la taille d'une maille (m) : "))
(setq x (/ lon m))
(setq y (/ lar m))
(command "point" p1 "")
(command ".-reseau" (entlast) "" "R" (rtos y 2 0) (rtos x 2 0) m m)
(setq ss1 (ssget "_X" (list (cons 0 "POINT") (cons 8 "MAILLAGE"))))
(setq i 0)
(foreach point (sslength ss1)
   (if
     (and
(setq ss2
       (ssget
	 "_F"
	 (list pt (list (car pt) (+ (cadr pt) (getvar "VIEWSIZE"))))
	 (list '(0 . "3DFACE") (cons 8 "MNT"))
       )
)
(setq alt1 (Inters-3dFace-Point (trans pt 1 0) ss1))

;;ici je bloque

(setq i (+ i 1))
)



(prin1)
)


;; CLOCKWISE-P
;; Retourne T si les points p1 p2 et p3 tournent dans le sens horaire
(defun clockwise-p (p1 p2 p3)
 (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
;; INSIDE_3PTS
;; Evalue si pt est strctement à l'intérieur du triangle p1 p2 p3 (points 2d)
(defun inside_3pts (pt p1 p2 p3)
 (if (clockwise-p p1 p2 pt)
   (and (clockwise-p p2 p3 pt)
 (clockwise-p p3 p1 pt)
   )
   (and (clockwise-p p2 pt p3)
 (clockwise-p p3 pt p1)
 (clockwise-p p1 pt p2)
   )
 )
)
;; VEC1
;; Retourne le vecteur normé (1 unité) de sens  p1 p2
(defun vec1 (p1 p2 / d)
 (if (not (zerop (setq d (distance p1 p2))))
   (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2)
 )
)
;; VXV
;; Retourne le produit scalaire (réel) de deux vecteurs
(defun vxv (v1 v2)
 (apply '+ (mapcar '* v1 v2))
)
;; V^V
;; Retourne le produit vectoriel (vecteur) de 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)))
 )
)
;; IL3P
;; Retourne le point d'intersection de la droite définie par p1 p2
;; et du plan défini par p3 p4 p5.
(defun il3p (p1 p2 p3 p4 p5 / nor scl)
 (setq	nor (v^v (mapcar '- p4 p3) (mapcar '- p5 p3))
scl (/ (vxv nor (mapcar '- p1 p3))
       (vxv nor (mapcar '- p2 p1))
    )
 )
 (mapcar '(lambda (x1 x2) (+ (* scl (- x1 x2)) x1)) p1 p2)
)
;; REMOVE_DOUBLES_F
;; Suprime tous les doublons d'une liste (avec tolérance)
(defun remove_doubles_f	(lst fuzz)
 (if lst
   (cons (car lst)
  (remove_doubles_f
    (vl-remove-if '(lambda (x) (equal x (car lst) fuzz)) lst)
    fuzz
  )
   )
 )
)
;; INTERS-3DFACE-POINT
;; Retourne la liste des points d'intersections de la projectrice verticale
;; de pt avec chaque face 3d de la liste rencontrée
;;
;; Arguments
;; pt : point (coordonnées SCG)
;; ss : jeu de sélection (faces 3d)
;;
;; Algorythme
;; Tant qu'un point n'est pas trouvé sur une face 3d du jeu de sélection,
;; - on constitue la liste des sommets après suppression des doublons (plst)
;; - les sommets et le point spécifiés sont projetés sur le plan XY (p0 p1 p2 p3)
;; - on évalue si p0 est soit confondu avec un sommet soit sur une arrête soit à
;; l'intérieur du triangle p1 p2 p3. Si une de ces condition est vérifiée le
;; point 3d sur la face 3d est calculé et son altitude est retournée.
(defun Inters-3dFace-Point (pt ss / loop n ent plst p0 p1 p2 p3 alt)
 (setq	loop T
n 0
 )
 (while (and loop (setq ent (ssname ss n)))
   (setq plst
   (remove_doubles_f
     (mapcar 'cdr
	     (vl-remove-if-not
	       '(lambda (x) (member (car x) '(10 11 12 13 14)))
	       (entget ent)
	     )
     )
     1e-9
   )
  n (1+ n)
   )
   (mapcar '(lambda (s p) (set s (list (car p) (cadr p))))
    '(p0 p1 p2 p3)
    (cons pt plst)
   )
   (if	(= 3 (length plst))
     (cond
((equal p0 p1 1e-9)
 (setq loop nil
       alt  (caddr (car plst))
 )
)
((equal p0 p2 1e-9)
 (setq loop nil
       alt  (caddr (cadr plst))
 )
)
((equal p0 p3 1e-9)
 (setq loop nil
       alt  (caddr (caddr plst))
 )
)
((equal (vec1 p1 p0) (vec1 p0 p2) 1e-9)
 (setq loop nil
       alt (+ (caddr (car plst))
	       (* (- (caddr (cadr plst)) (caddr (car plst)))
		  (/ (distance p1 p0) (distance p1 p2))
	       )
	    )
 )
)
((equal (vec1 p2 p0) (vec1 p0 p3) 1e-9)
 (setq loop nil
       alt (+ (caddr (cadr plst))
	       (* (- (caddr (caddr plst)) (caddr (cadr plst)))
		  (/ (distance p2 p0) (distance p2 p3))
	       )
	    )
 )
)
((equal (vec1 p1 p0) (vec1 p0 p3) 1e-9)
 (setq loop nil
       alt (+ (caddr (car plst))
	       (* (- (caddr (caddr plst)) (caddr (car plst)))
		  (/ (distance p1 p0) (distance p1 p3))
	       )
	    )
 )
)
((inside_3pts p0 p1 p2 p3)
 (setq loop nil
       alt (caddr
	      (il3p pt
		    (list (car pt) (cadr pt) 1.0)
		    (car plst)
		    (cadr plst)
		    (caddr plst)
	      )
	    )
 )
)
     )
   )
 )
 alt
)

 

Par contre, il faudrait également à la fin du traitement si possible de sélectionner à la fin tous les points qui n'ont de face3D à leur verticale donc d'altitude égal à 0 pour les supprimer.

 

 

Merci par avance de votre aide.

John.

 

[Edité le 1/3/2009 par chris_mtp]

[chris_mtp]

Sérieux je suis bloqué

Je ne sais pas comment je peux déplacer les points qui ont des faces 3D à leur verticale.

Merci de m'aider please.

John

[chris_mtp]

J'ai pu faire pour la sélection des points d'altitude à 0

 

(defun c:erase_pt (/ i ss len nom entit pt)
(setq jeu (ssget "X" (list(cons 0 "POINT") (cons 8 "MAILLAGE"))))
(progn
(setq i 0)
(setq len (sslength jeu))
(while (< i len)
(setq i (+ i 1))
(setq nom (ssname jeu i))
(setq entit (entget nom))
(setq pt (cdr (assoc 10 entit)))
(setq val (caddr pt))
(if (= val 0)
(command "_erase" pt ""))))
(prin1)
) 

mais à la fin j'ai l'erreur "lentityp nil"

 

Pourquoi ?

 

John

[bonuscad]

Il te faut savoir que pour (ssname) l'index commence à 0

 

Tu as bien fixé ta valeur de départ avec (setq i 0), mais dans ta boucle (while tu incrémente ta variable i AVANT d'extraire le 1er index, donc tu "zappe" ta 1ère entité et crée un décalage qui va planter sur le dernier index (ssname jeu i) qui va retourner nil.

 

Place simplement ton incrémentation APRES l'extraction (setq nom (ssname jeu i))

[chris_mtp]

Et pour le plaquage des points sur le MNT, j'ai pu faire ca mais il me retourne Erreur de syntaxe

j'ai vérifié les parenthèses mais il doit y avoir un probleme dans le code.

 

 (defun c:grille_nod (/ p1 p2 m lon lar x y ss1 i nom entit pt alt1 pti)
(prompt "\nCREATION D'UNE GRILLE TYPE NODAL")
(if (not (tblsearch "LAYER" "MAILLAGE"))
(command "_layer" "_N" "MAILLAGE" "_CO" "3" "MAILLAGE" ""))
(setvar "CLAYER" "MAILLAGE")
(setvar "PDMODE" 3)
(setvar "PDSIZE" 0.1)
(setq p1 (getpoint "\nPoint bas gauche de la grille : "))
(setq p2 (getcorner p1 "\nPoint haut droit de la grille : "))
(setq lon (- (car p2) (car p1)))
(setq lar (- (cadr p2) (cadr p1)))
(setq m (getdist "\nEntrer la taille d'une maille (m) : "))
(setq x (/ lon m))
(setq y (/ lar m))
(command "point" p1 "")
(command ".-reseau" (entlast) "" "R" (rtos y 2 0) (rtos x 2 0) m m)
(setq ss1 (ssget "_X" (list (cons 0 "POINT") (cons 8 "MAILLAGE"))))
(setq i 0)

(while (< i (sslength ss1))
(setq nom (ssname ss1 i))
(setq i (+ i 1))
(setq entit (entget nom))
(setq pt (cdr (assoc 10 entit)))
   (if (and (setq ss2 (ssget "_F" (list pt (list (car pt) (+ (cadr pt) (getvar "VIEWSIZE"))))))
	 (list '(0 . "3DFACE") (cons 8 "MNT"))
       )
)

(setq alt1 (Inters-3dFace-Point (trans pt 1 0) ss1))
(setq pti (list (car pt) (cadr pt) (caddr pt)))
(command "_move" pt pti (list (car pt) (cadr pt) (rtos alt1 2 3)))



)



(prin1)
)

 

 

[bonuscad]

(if (and (setq ss2 (ssget "_F" (list pt (list (car pt) (+ (cadr pt) (getvar "VIEWSIZE"))))))

 

(list '(0 . "3DFACE") (cons 8 "MNT"))

 

)

 

)

 

Ta condition n'a rien a évaluer si celle si est remplie.

tu as englobé (list '(0 . "3DFACE") (cons 8 "MNT")) dans le (and), mais on se demande à quoi il sert, a priori il devrait faire plutôt parti du (ssget) et le (and) ne serait plus utile.

 

Quel est l'action que tu veux faire si SS2 est valide?

La fin est confuse...

 

J'écrirais ceci pour la boucle:

 

(while (< i (sslength ss1))
 (setq nom (ssname ss1 i))
 (setq i (+ i 1))
 (setq entit (entget nom))
 (setq pt (cdr (assoc 10 entit)))
 (if (setq ss2 (ssget "_F" (list pt (list (car pt) (+ (cadr pt) (getvar "VIEWSIZE")))) (list '(0 . "3DFACE") (cons 8 "MNT"))))
   (progn
     (setq alt1 (Inters-3dFace-Point (trans pt 1 0) ss2))
     (if alt1 (entmod (subst (cons 10 (list (car pt) (cadr pt) alt1)) (assoc 10 entit) entit)))
   )
 )
)

 

[Edité le 6/3/2009 par bonuscad]

[chris_mtp]

Merci Bonuscad pour ton aide.

Ca marche nickel.

Par contre, le traitement pour effacer les points d'altitude à 0 est un peu long avec un grand nombre de points.

Je vais essayer de le simplifier.

Et merci à Gile pour sa fonction INTERS-3DFACE-POINT

 

John

[(gile)]

Salut,

 

Par contre, le traitement pour effacer les points d'altitude à 0 est un peu long avec un grand nombre de points.

 

Essaye comme ça :

 

(defun c:erase_pt (/ ss)
 (if
   (setq ss (ssget "_X"
	    '((0 . "POINT")
	      (8 . "MAILLAGE")
	      (-4 . "*,*,=")
	      (10 0.0 0.0 0.0)
	     )
     )
   )
   (command "_erase" ss "")
 )
 (princ)
)

[chris_mtp]

En effet, c'est beaucoup plus rapide que ma méthode.

mais ton dxf -4, c'est quoi

 

  (-4 . "*,*,=")

	      (10 0.0 0.0 0.0) 

[(gile)]

Salut,

 

Ce n'est pas un code de groupe DXF, c'est le code utilisé dans les filtres de sélection avec les opérateurs logiques (AND, NOT, OR, XOR) ou les tests relationnels ("=", "!=", "", "&" etc).

 

Regarde dans l'aide aux développeurs :

AutoLISP Developer's Guide >> Using the AutoLISP Language >> Using AutoLISP to Manipulate AutoCAD Objects >> Selection Set Handling >> Selection Set Filter Lists

 

les chapitres : Relational Tests et Logical Grouping of Filter Tests

 

Tu as des liens en bas de l'aide pour la fonction ssget puis de Selection Set Filter Lists

 

[chris_mtp]

MErci Gile.