interpolation de points

[alainajaccio]

bonjour,

Je cherche une méthode pour interpoler des points (x,y,z) sur un plan existant (exemple: levé de géomètre)??? merci

 

[x_all]

interpoler..

 

sur covadis ya un truc quand on fait les plateformes (dans le tableau qui apparait avec un double clic pas celui de modif-plaeforme), mais c vrai qu'un lisp qui me calcule l'altitude d'un point entre deux autre me rendrai parfois service.

 

en fait, pour etre complet, il faudrai soit calculer le Z si on clique un pts entre les deux, soit donner la distance pour arriver à un z donné... bref ce que je me suis fait avec deux formules dans un fichier exel...(que je peu te faire passer si tu me laisse une adresse mail)

 

bon, quand est ce que j'ai une semaine pour me metre au lisp moi...

 

à noter que si tu travaille en 3d et que tu as tracé la polyligne 3d entre tes deux points il suffit de poser un pts dessus avec un accrochage proche et tu as ton Z directement...

 

donner le Z d'un pts quelconque sur une face 3d d'un mnt doit etre un peu plus compliqué... là encore ya une fonction dans covadis mais je ne saurai le résoudre mathématiquement

 

[Edité le 27/11/2007 par x_all]

[thierry.garré]

en fait, pour etre complet, il faudrai soit calculer le Z si on clique un pts entre les deux, soit donner la distance pour arriver à un z donné... bref ce que je me suis fait avec deux formules dans un fichier exel...(que je peu te faire passer si tu me laisse une adresse mail)

 

regarde

 

Covadis3D/Construction 3D/Interpolation linéaire

 

 

par contre pour les lisps , désolé je n'ai rien en stock :mad2:

 

[Edité le 28/11/2007 par thierry.garré]

[bonuscad]

Bonjour,

 

Sachant que par trois points en 3D on peut placer une 3Dface.

 

La proposition faite dans ce sujet pourra peut être t'aider.

 

Il ya aussi cette discussion dans le même acabit, toujours avec des 3Dfaces....

 

Un lisp que j'ai réalisé il y a fort longtemps, et que je n'utilise plus. C'est une interpolation/extrapolation linéaire entre 2 points, la commande place des nouveaux points sur la ligne de coupe choisie.

 

(defun interr (ch / )
(cond
	((eq ch "Function cancelled") nil)
	((eq ch "quit / exit abort") nil)
	((eq ch "console break") nil)
	(T (princ ch))
)
(command "_.undo" "_end")
(command "_.u")
(command "_.ucs" "_r" "tmp")
(command "_.ucs" "_d" "tmp")
(setvar "clayer" plnam)
(setvar "aunits" sv_aun)
(setvar "angdir" sv_and)
(setvar "angbase" sv_anb)
(redraw)
(setq *error* olderr)
(setvar "cmdecho" 1)
(princ)
)
(defun lpl ( / l l1 x y z)
(setq des '())
(setq l (entget (entlast)))
(setq l1 (entget (entnext (cdr (assoc -1 l)))))
(while (/= "SEQEND" (cdr (assoc 0 l1)))
	(setq x (cadr (assoc 10 l1)))
	(setq y (caddr (assoc 10 l1)))
	(setq z (cadddr (assoc 10 l1)))
	(setq des (append des (trans (list x y z) 0 1)))
	(setq l1 (entget (entnext (cdr (assoc -1 l1)))))
)
)
(defun ns ( / nus des)
(lpl)
(prompt "Nombre de sommets disponibles: ") (prin1 (/ (length des) 3))
(initget 7)
(while
	(>
		(setq nus (getint "\nNumero du sommet a chercher : "))
		(/ (length des) 3)
	)
		(prompt "\nSommet inexistant, doit être [b]<[/b] a ")
		(prin1 (/ (length des) 3))
		(initget 7)
) 
(prompt 
	(strcat
		"\nSommet "
		(rtos nus 2 0)
		"\nX = "
		(rtos (nth (- (* nus 3) 3) des) 2 3)
		"\tY = "
		(rtos (nth (- (* nus 3) 2) des) 2 3)
		"\tZ = "
		(rtos (nth (- (* nus 3) 1) des) 2 3)
	)
)
)
(defun sommet (vx / vx sv en fn som)
(setq fn "VERTEX"
      som ()
      jj ()
)
(while (= fn "VERTEX")
	(setq sv (entnext vx)
	      en (entget sv)
	      fn (cdr (assoc 0 en))
	      som (cons (cdr (assoc 10 en)) som)
	      vx sv
	)
)
(setq som (reverse (cdr som))
      listou (mapcar '(lambda (x) (trans x 0 1)) som)
)
)
(defun mdf ( / scle sscle svcle wcle pt sscl cl)
(setq svcle "N")
(cond
	((ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN")))
		(command "_.pedit" "_l")
		(while (/= scle "Sortir")
			(setq scle "Sortir")
			(initget "Modifier annUler Sortir")
			(if	(eq (setq scle
			              (getkword "\nSommet [Modifier/annUler/Sortir] [b]<[/b]S>: ")) ()
			        )
					(setq scle "Sortir")
			)
			(cond
				((eq scle "Modifier")
					(command "_E")
					(while (/= sscle "Sortir")
						(initget "N SUIVANt Preced Inser Deplac Regen Lineair ? Sortir Znouveau \r")
						(prompt "\n[suivaNt/Preced/Inser/Deplac/Znouveau/Regen/Lineair/?/Sortir] [b]<[/b]")
						(prin1 (read (substr svcle 1 1)))
						(prompt ">: ")
						(setq wcle (getkword))
						(if (eq wcle ())
							(setq sscle svcle)
							(setq sscle wcle)
						)
						(cond
							((or (eq sscle "N") (eq sscle "SUIVANt"))
								(setq svcle "N")
								(command "_N")
							)
							((eq sscle "Preced")
								(setq svcle "Preced")
								(command "_P")
							)
							((eq sscle "Inser")
								(command "_I")
								(setq pt (getpoint (getvar"lastpoint")
								         "\nEntrez la position du nouveau sommet :")
								)
								(setq pt (list (car pt) 0.0 (caddr (getvar "lastpoint"))))
								(command pt)
							)
							((eq sscle "Deplac")
								(command "_M")
								(setq pt (getpoint (getvar"lastpoint")
								         "\nEntrez la nouvelle position :")
								)
								(setq pt (list (car pt) 0.0 (caddr (getvar "lastpoint"))))
								(command pt)
							)
							((eq sscle "Znouveau")
								(command "_M")
								(setq pt (getpoint (getvar "lastpoint")
								         "\nEntrez la nouvelle position en Z :")
								)
								(setq pt (list (car (getvar "lastpoint")) 0.0 (caddr pt)))
								(command pt)
							)
							((eq sscle "Regen")
								(command "_R")
							)
							((eq sscle "?")
								(ns)
							)
							((eq sscle "Lineair")
								(command "_S")
								(setq sscl "N")
								(while (and (/= sscl "Go") (/= sscl "Sortir"))
									(initget "N SUIVANt Preced Go Sortir \r")
									(prompt "\n[suivaNt/Preced/Go/Sortir] [b]<[/b]")
									(prin1 (read (substr sscl 1 1)))
									(prompt ">: ")
									(setq cl (getkword))
									(if (eq cl ())
										(setq sscl sscl)
										(setq sscl cl)
									)
									(cond
										((or (eq sscl "N") (eq sscl "SUIVANt"))
											(setq sscl "N")
											(command "_N")
										)
										((eq sscl "Preced")
											(setq sscl "Preced")
											(command "_P")
										)
									)
								)
								(cond
									((eq sscl "Go")
										(command "_G")
									)
									((eq sscl "Sortir")
										(command "_X")
									)
								)
							)
						)
					)
					(command "_X")
					(setq sscle "N")
				)
				((or (eq scle "U") (eq scle "ANNUler"))
					(command "_U")
				)
			)
		)
		(command "_X")
		(image (sommet (entlast)))
	)
)
)
(defun image (soumi / pl o1 o2 l_drw l_draw)
(setvar "cvport" (getvar "useri2"))
(if (ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN")))
	(command "_.erase" "_p" "")
)
(setq pl soumi l_draw soumi l_drw nil)
(command "_.3dpoly")
(repeat (length pl)
	(command (car pl))
	(setq pl (cdr pl))
)
(command "")
(command "_.ucs" "_r" "_PT-TN")
(command "_.zoom" "_w"
	(list
		(apply 'min (mapcar 'car soumi))
		(apply 'min (mapcar 'caddr soumi))
	)
	(list
		(apply 'max (mapcar 'car soumi))
		(apply 'max (mapcar 'caddr soumi))
	)
)
(command "_.zoom" "_c" 
	(list
		(/
			(+
				(apply 'min (mapcar 'car soumi))
		      (apply 'max (mapcar 'car soumi))
			)
			2
		)
		(/
			(+
				(apply 'min (mapcar 'caddr soumi))
		      (apply 'max (mapcar 'caddr soumi))
			)
			2
		)
	)
	"0.8X"
)
(setq o1 (trans (list '0.0 (cadr (getvar "vsmin"))) 1 0))
(setq o2 (trans (list '0.0 (cadr (getvar "vsmax"))) 1 0))
(command "_.ucs" "_r" "_GEN")
(grdraw (trans o1 0 1) (trans o2 0 1) 1)
(while (cadr l_draw)
	(setq l_drw (append (list 3 (car l_draw) (cadr l_draw)) l_drw))
	(setq l_draw (cdr l_draw))
)
(grvecs l_drw)
(setvar "cvport" (getvar "useri1"))
)
(defun grpl (pt / pt1 pt2 pt3 pt4 rap)
(setq rap (getvar "viewsize")
      pt1 (list (+ (car pt) (/ rap 50)) (+ (cadr pt) (/ rap 50)))
      pt2 (list (+ (car pt) (/ rap 50)) (- (cadr pt) (/ rap 50)))
      pt3 (list (- (car pt) (/ rap 50)) (- (cadr pt) (/ rap 50)))
      pt4 (list (- (car pt) (/ rap 50)) (+ (cadr pt) (/ rap 50)))
)
(grdraw pt pt1 -1)
(grdraw pt pt2 -1)
(grdraw pt pt3 -1)
(grdraw pt pt4 -1)
)
(defun vrf_pt (p l / nw_seg end_sg l_m ptx ptf cut_po)
(setq nw_seg (list p (car l)) end_sg (list p (last l)) l_m l)
(while (and (not cut_po) (cdr l))
	(setq ptx (inters (car nw_seg) (cadr nw_seg) (car l) (cadr l)))
	(setq ptf (inters (car end_sg) (cadr end_sg) (car l) (cadr l)))
	(if (and ptx (not (member T (mapcar '(lambda (x) (equal ptx x 0.000001)) l_m))))
		(setq cut_po T)
		(setq cut_po nil)
	)
	(if (and ptf (not (member T (mapcar '(lambda (x) (equal ptf x 0.000001)) l_m))) (not cut_po))
		(setq cut_pt T)
	)
	(setq l (cdr l))
)
(if cut_po
	T
	nil
)
)
(defun drw_cp (l col / l_drw)
(setq l_drw '())
(while (cdr l)
	(setq l_drw (append (cons (car l) (list (cadr l))) l_drw))
	(setq l (cdr l))
)
(grvecs (cons col l_drw))
)
(defun defpo ( / pt pt_lst cut_pt)
(setq pt_lst ())
(initget 40 "ANNUler U")
(while
	(or
		(setq pt
			(if (car pt_lst)
				(getpoint	(car pt_lst) "\nannUler/[b]<[/b]Extrémité de la ligne>:")
				(getpoint	"\nPremier point du polygone:")
			)
		)
		cut_pt
	)
	(cond
		((or (eq pt "ANNUler") (eq pt "U"))
			(drw_cp pt_lst 0)
			(setq pt_lst (cdr pt_lst))
		)
		((= (type pt) 'LIST)
			(if (> (length pt_lst) 1)
				(drw_cp pt_lst 0)
			)
			(if (vrf_pt pt pt_lst)
				(prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.")
				(setq pt_lst (cons pt pt_lst))
			)
		)
		(T
			(drw_cp pt_lst 0)
			(prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.")
			(setq pt_lst (cdr pt_lst) cut_pt nil)
		)
	)
	(if (> (length pt_lst) 1)
		(drw_cp pt_lst -1)
	)
	(initget 40 "ANNUler U")
)
(if ([b]<[/b] (length pt_lst) 3)
	(progn
		(if (> (length pt_lst) 1)
			(progn
				(prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.")
				(drw_cp pt_lst 0)
			)
		)
		(setq pt_lst nil)
	)
	(drw_cp pt_lst 0)
)
pt_lst
)
(defun delete (lsb / dl)
(setq dl (length lsb)
      nwlst ()
)
(repeat (1- dl)
	(setq nwlst (cons (exfonc min lsb) nwlst)
	      lsb (subst () (car nwlst) lsb)
	      lsb (append
							(cdr (member () (reverse lsb)))
							(while (not (null (cdr (member () lsb))))
								(setq lsb (cdr (member () lsb)))
							)
	          )
	      lsb (subst (car nwlst) () lsb)
	)
)
(setq nwlst (cons (car lsb) nwlst))
)
(defun exfonc (fonc l / prov)
(setq prov (car l))
(foreach elm (cdr l)
	(setq prov (eval (list fonc prov elm)))
)
)
(defun ordre (cumul / lnb dl cmpt suiv prec pint)
(setq lnb (mapcar 'car cumul)
      dl (length lnb)
      cmpt 0
)
(delete lnb)
(setq dl (length nwlst)
      listou ()
)
(repeat dl
	(setq listou (cons (assoc (car nwlst) cumul) listou)
	      nwlst (cdr nwlst)
	)
)
(setq nwlst listou)
(while nwlst
	(setq cmpt (1+ cmpt))
	(if (eq (car nwlst) ppax)
		(setq nwlst ())
	)
	(setq nwlst (cdr nwlst))
)
(setq dl 0
      lnb -2
)
(if (= cmpt (length listou))
	(setq dl -3 lnb -2)
)
(if (= cmpt 1)
	(setq dl 1 lnb 0)
)
(setq suiv (nth (+ cmpt dl) listou)
      prec (nth (+ cmpt lnb) listou)
      pint (inters
           	(cons (car suiv) (list (caddr suiv)))
            (cons (car prec) (list (caddr prec)))
            '(0.0 0.0)
            '(0.0 500.0)
            ()
           )
      pint (cons (car pint) (list '0.0 (cadr pint)))
      listou (subst pint ppax listou)
)
)
(defun avec (l / l_bis effect pt test to l_tmp l1 l2 f1 f2 qf q_pt px)
(setq l_bis l effect ())
(while l
	(setq pt (car l))
	(setq test
		(mapcar
			'(lambda (x)
				(if
					(>
						(angle (list (car pt) (cadr pt)) (list (car x) (cadr x)))
						pi
					)
					(- (angle (list (car x) (cadr x)) (list (car pt) (cadr pt))) vec_di)
					(- (angle (list (car pt) (cadr pt)) (list (car x) (cadr x))) vec_di)
				)
			)
			l_bis
		)
	)
	(setq t0 (mapcar 'minusp test) l_tmp test l1 () l2 () f1 nil f2 nil)
	(while t0
		(if (car t0)
			(setq l1 (cons (car l_tmp) l1))
			(setq l2 (cons (car l_tmp) l2))
		)
		(setq t0 (cdr t0) l_tmp (cdr l_tmp))
	)
	(if l1 (setq f1 (apply 'max l1)))
	(if l2 (setq f2 (apply 'min l2)))
	(cond
		((and f1 f2)
			(setq qf (min (abs f1) (abs f2)))
			(if (zerop (rem (abs f1) qf)) (setq qf f1) (setq qf f2))
		)
		((and f1 (not f2))
			(setq qf f1)
		)
		((and f2 (not f1))
			(setq qf f2)
		)
	)
	(setq q_pt (- (length test) (length (member qf test))))
	(setq px (nth q_pt l_bis))
	(if (null (member (list pt px) effect))
		(progn
			(setq effect (cons (list px pt) effect))
			(grdraw pt px 1)
			(if ptz (grpl ptz))
			(interp pt px ppax exg)
			(grpl ptz)
			(setq cumul (cons ptz cumul))
		)
	)
	(setq l (cdr l))
)
)
(defun interp (pt1 pt2 ppaxe exg / p1 p2 pint)
(setq p1 (cons (car pt1) (cons (cadr pt1) '(0.0)))
      p2 (cons (car pt2) (cons (cadr pt2) '(0.0)))
      pint (inters ppaxe exg p1 p2 ())
      ptz (inters (cdr pt1) (cdr pt2) '(0.0 0.0) '(0.0 500.00) ())
      ptz (cons (car pint) (list '0.0 (cadr ptz)))
)
)
(defun param (/ plnw cle cbg chd cbgb first_win second_win po_rec OK)
(command "_.undo" "_control" "_all")
(command "_.undo" "_auto" "_off")
(setvar "maxactvp" 48)
(setvar "tilemode" 1)
(command "_.view" "_save" "tmp")
(command "_.ucs" "")
(command "_.plan" "")
(prompt "\nNom du plan pour les points interpolés ?[b]<[/b]SEMIS-SUPP>: ")
(setq plnw (getstring))
(if (= plnw "")
	(setvar "users1" "SEMIS-SUPP")
	(setvar "users1" plnw)
)
(prompt "\nLes points interpolés seront exclus de la sélection")
(prompt "\nen mode Automatique ou Reprise")
(initget "Oui Non")
(if (eq (getkword " [Oui/Non][b]<[/b]O>?: ") "Non")
	(setq exclu nil)
	(setq exclu T)
)		
(setvar "tilemode" 0)
(command "_.pspace")
(if (ssget "X" '((0 . "VIEWPORT")))
	(progn
		(alert
			(strcat
				"\tATTENTION !!!."
				"\nUne mise en page dans l'espace papier existe."
				"\nSi vous continuez elle sera perdue."
				"\nTravaillez sur une copie du fichier,"
				"\nou ne sauvegardez pas vos modifications"
				"\naprès avoir récupéré vos points interpolés"
			)
		)
		(initget "Oui Non")
		(if (eq (getkword "\nVoulez vous continuer [Oui/Non][b]<[/b]N>: ") "Oui")
			(command "_.erase" "_p" "")
			(exit)
		)
	)
)
(command "_.zoom" "_ex")
(setq cbg (getvar "vsmin")
      chd (getvar "vsmax")
)
(setq cbgb
	(list
		(+ (* (/ (- (car chd) (car cbg)) 4.0) 3.0) (car cbg))
		(+ (* (/ (- (cadr chd) (cadr cbg)) 4.0) 3.0) (cadr cbg))
	)
)
(command "_.mview" "_polygonal"
	cbg
	(list (car chd) (cadr cbg))
	(list (car chd) (cadr cbgb))
	cbgb
	(list (car cbgb) (cadr chd))
	(list (car cbg) (cadr chd)) 
	"_close"
) 
(setq first_win (entlast))
(setvar "useri1" (cdr (assoc 69 (entget (entlast)))))
(command "_.zoom" "_ex")
(command "_.mview" cbgb chd)
(setq second_win (entlast))
(setvar "useri2" (cdr (assoc 69 (entget (entlast)))))
(command "_.mview" "_on" first_win second_win "")
(command "_.mspace")
(setvar "cvport" (getvar "useri2"))
(command "_.layer" "_m" "_PT-TN" "_co" "3" "" "")
(command "_.vplayer" "_f" "*" "" "_t" "_PT-TN" "" "")
(grdraw '(0.0 0.0) '(0.0 100.0) 1)
(setvar "cvport" (getvar "useri1"))
(command "_.view" "_restore" "tmp")
(command "_.view" "_delete" "tmp")
(setvar "users3" "T")
)

(defun c:interpol (/ pt ppax exg pt1 pt2 cumul key_md ptz listou codp nom plnam
                    orip absc nwlst cml lmc sv_aun sv_and sv_anb ent js
									 l_wp n vec_di)
(setvar "cmdecho" 0)
(setq olderr *error* *error* interr)
(setq plnam (getvar "clayer")
      sv_anb (getvar "angbase")
      sv_and (getvar "angdir")
      sv_aun (getvar "aunits")
)
(setvar "expert" 5)
(setvar "limcheck" 0)
(setvar "aunits" 0)
(setvar "angdir" 0)
(setvar "angbase" 0)
(command "_.ucs" "_s" "tmp")
(if (null (tblsearch "LAYER" "_PT-TN"))
	(setvar "users3" "nil")
)
(if (not (read (getvar "users3")))
	(param)
)
(command "_.undo" "_group")
(command "_.layer" "_thaw" "_PT-TN" "_set" "_PT-TN" "")
(if (= (getvar "tilemode") 1) (setvar "tilemode" 0))
(command "_.ucs" "")
(setvar "osmode" 32)
(initget 17)
(setq ppax (getpoint "\nPointez l'axe du profil: int de")
      ppax (cons (car ppax) (cons (cadr ppax) '(0.0)))
)
(setvar "osmode" 1)
(initget 17)
(setq exg (getpoint "\nPointez l'extrèmité DROITE du profil: ext de")
      exg (cons (car exg) (cons (cadr exg) '(0.0)))
)
(setvar "osmode" 0)
(command "_.ucs" "_o" ppax)
(setq orip (trans exg 0 1))
(command "_.ucs" "_z" '(0.0 0.0 0.0) orip)
(command "_.ucs" "_s" "_GEN")
(setvar "cvport" (getvar "useri2"))
(command "_.ucs" "_x" "90")
(command "_.plan" "")
(command "_.ucs" "_s" "_PT-TN")
(setvar "cvport" (getvar "useri1"))
(command "_.ucs" "_r" "_GEN")
(setq cumul ())
(while (/= key_md "OK")
	(initget "Reprise Automatique MAnuelle MOdification OK")
	(setq key_md (getkword "\nInterpolation par [Reprise/Automatique/MAnuelle/MOdification/OK] ?[b]<[/b]OK>: "))
	(if (not key_md) (setq key_md "OK"))
	(cond
		((eq key_md "Reprise")
			(setq l_wp (defpo) js (ssadd))
			(if exclu
				(setq js (ssget "_WP" l_wp (list '(0 . "POINT") '(-4 . "*,*,>") '(10 0.0 0.0 0.0) '(-4 . "[b]<[/b]NOT") (cons 8 (getvar "users1")) '(-4 . "NOT>"))) n 0 l_wp ())
				(setq js (ssget "_WP" l_wp '((0 . "POINT") (-4 . "*,*,>") (10 0.0 0.0 0.0))) n 0 l_wp ())
			)
			(cond
				(js
					(prompt (strcat "\n" (itoa (sslength js)) " point(s) trouvé(s)."))
					(repeat (sslength js)
						(setq ent (ssname js n))
						(setq l_wp (cons (cdr (assoc 10 (entget ent))) l_wp))
						(setq n (1+ n))
					)
					(setq l_wp (mapcar '(lambda (x) (trans x 0 1)) l_wp))
					(setq l_wp (mapcar '(lambda (x) (list (car x) 0.0 (caddr x))) l_wp))
					(setq cumul
						(if (null cumul)
							l_wp
							(append l_wp cumul)
						)
					)
					(cond
						((>= (length cumul) 2)
							(setq ppax '(0.0 0.0 0.0))
							(ordre (cons ppax cumul))
						)
						(T ())
					)
				)
				(T
					(prompt "\nAucun point trouvé")
					(setq cumul ())
				)
			)
		)
		((eq key_md "Automatique")
			(initget 33)
			(setq vec_di (getangle '(0.0 0.0) "\nAngle prioritaire d'interpolation ?: "))
			(if (> vec_di pi) (setq vec_di (- vec_di pi)))
			(setq ppax '(0.0 0.0 0.0) exg (cons (car (trans exg 0 1)) '(0.0 0.0)))
			(setq l_wp (defpo) js (ssadd))
			(if exclu
				(setq js (ssget "_WP" l_wp (list '(0 . "POINT") '(-4 . "*,*,>") '(10 0.0 0.0 0.0) '(-4 . "[b]<[/b]NOT") (cons 8 (getvar "users1")) '(-4 . "NOT>"))) n 0 l_wp ())
				(setq js (ssget "_WP" l_wp '((0 . "POINT") (-4 . "*,*,>") (10 0.0 0.0 0.0))) n 0 l_wp ())
			)
			(cond
				(js
					(prompt (strcat "\n" (itoa (sslength js)) " point(s) trouvé(s)."))
					(repeat (sslength js)
						(setq ent (ssname js n))
						(setq l_wp (cons (trans (cdr (assoc 10 (entget ent))) 0 1) l_wp))
						(setq n (1+ n))
					)
					(avec l_wp)
					(cond
						((>= (length cumul) 2)
							(ordre (cons ppax cumul))
						)
						(T ())
					)
				)
				(T
					(prompt "\nAucun point trouvé")
					(setq cumul ())
				)
			)
		)
		((eq key_md "MAnuelle")
			(setvar "osmode" 8)
			(initget 17)
			(while (zerop (caddr (setq pt1 (getpoint "\nDonnez le 1er point: nod de"))))
				(alert "ATTENTION Z du 1er point nul!")
				(initget 17)
			)
			(while (/= pt1 ())
				(setq pt2 '(0.0 0.0 0.0))
				(initget 17)
				(while
					(zerop (caddr pt2))
					(setq pt2 (getpoint pt1 "\nDonnez le 2ème point: nod de"))
					(cond
						((zerop (caddr pt2))
							(alert "ATTENTION Z du 2ème point nul!")
							(initget 17)
						)
						((equal
							(distance
								(list (car pt1) (cadr pt1))
								(list (car pt2) (cadr pt2))
							)
							0.0 0.0001
						 )
							(alert "ATTENTION point identique au 1er point")
							(setq pt2 '(0.0 0.0 0.0))
							(initget 17)
						)
					)
				)
				(grdraw pt1 pt2 1)
				(setq ppax '(0.0 0.0 0.0) exg (cons (car (trans exg 0 1)) '(0.0 0.0)))
				(if ptz (grpl ptz))
				(interp pt1 pt2 ppax exg)
				(grpl ptz)
				(while (member ptz cumul)
					(setq ptz (cons (+ 0.0001 (car ptz)) (cdr ptz)))
				)
				(setq cumul (cons ptz cumul))
				(cond
					((>= (length cumul) 2)
						(ordre (cons ppax cumul))
					)
					(T ())
				)
				(prompt "\nPoint interpolé : ")(prin1 (rtos (caddr ptz) 2 2))
				(initget 16)
				(while
					(zerop
						(if
							(eq
								()
								(caddr
									(setq pt1
										(getpoint "\nDonnez le 1er point[b]<[/b]RETURN pour fin>: nod de")
									)
								)
							)
							(quote 1)
							(caddr pt1)
						)
					)
					(alert "ATTENTION Z du 1er point nul!")
					(initget 16)
				)
			)
			(setvar "osmode" 0)
		)
		((and cumul (eq key_md "MOdification"))
			(setvar "osmode" 0)
			(cond
				(([b]<[/b] (length cumul) 2)
					(prompt "\nNe peut faire un profil avec un seul point! INCORRECT ")
					(exit)
				)
				(T
					(if (not (member '0.0 (mapcar 'car cumul)))
						(ordre (cons ppax cumul))
					)
					(if ptz (grpl ptz))
					(image listou)
					(mdf)
					(if (not (member '0.0 (mapcar 'car listou)))
						(progn
							(ordre (cons ppax listou))
							(setq cumul listou)
						)
						(progn
							(ordre listou)
							(setq cumul listou)
						)
					)
				)
			)
		)
		((and listou (eq key_md "OK"))
			(prompt "\nPoint interpolé a l'axe : ")
			(prin1 (rtos (caddr (assoc 0.0 listou)) 2 2))
			(initget "Oui Non")
			(cond
				((eq (getkword "\nSauvegarde du profil? [Oui/Non] [b]<[/b]N>: ") "Oui")
					(repeat (length listou)
						(entmake
							(list
								'(0 . "POINT")
								(cons 8 (getvar "users1"))
								(cons 10 (trans (car listou) 1 0))
								'(210 0.0 0.0 1.0)
								'(50 . 0.0)
							)
						)
						(setq listou (cdr listou))
					)
				)
				(T (entdel (entlast)))
			)
			(command "_.ucs" "_r" "tmp")	
			(command "_.ucs" "_d" "tmp")
		)
		(T
			(setq key_md "Interpolation")
			(prompt "\nProfil non défini. Interpolez ou exécutez une reprise")
		)
	)
	(if listou (image listou))
)
(command "_.ucs" "")
(command "_erase" (ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN"))) "")
(redraw)
(setvar "clayer" plnam)
(setvar "aunits" sv_aun)
(setvar "angdir" sv_and)
(setvar "angbase" sv_anb)
(command "_.undo" "_end")
(setq *error* olderr)
(setvar "cmdecho" 1)
(prin1)
)

[lili2006]

Bonsoir à toutes et tous,

 

bonuscad, un développeur de géomédia ?

 

Si ce n'est le cas, ceux-ci n'ont qu'à bien s'tenir,...

 

Et quand on pense que c'est un "vieux Lisp",...

 

Bravo pour ce travail et cet esprit de partage. (j'ai lu ton autre réponse du jour!).

 

Bonne nuit.