pente

[Invité bapt26]

salut les amis! je viens de trouver un programme qui me donne la pente entre deux points topographique ce qui est très interressant pour moi :

 

(defun c:pente ()

(setvar "cmdecho" 0)

(setq ht (getreal "\nHauteur des écritures ? :\n"))

(setq dec 2);;deux décimales

(setq PT1 (getpoint"\nPoint 1 ?\n"))

(setq PT2 (getpoint"\nPoint 2 ?\n"))

(setq xPT1 ( car PT1) yPT1 ( cadr PT1 ) zPT1 ( caddr PT1))

(setq xPT2 ( car PT2) yPT2 ( cadr PT2 ) zPT2 ( caddr PT2))

(setq dist (sqrt (+ (* (- (car PT1) (car PT2))(- (car PT1) (car PT2)))

(* (- (cadr PT1) (cadr PT2))(- (cadr PT1) (cadr PT2)))

)

)

)

(setq pente1 ( * ( / ( - zPT1 zPT2) dist) 100 ) )

(setq pins (getpoint "\nPoint d'inscription du texte ? "))

(setq dir (angtos(angle PT1 PT2)))

(command "_TEXT" pins ht dir (strcat (rtos pente1 2 dec ) " %"))

(setvar "cmdecho" 1)

 

Mais j'aimerai qu'il y apparaisse en plus de la pente la distance de la ligne au dessous de celle ci.

 

Et ensuite jaimerai qu'on m'exlique comment faire apparaître des étiquettes sur chaques points topo ( qui correspondent aux axes de regards d'assainissement) ou serait marqué ( l'atitude tampon, le fil d'eau et la profondeur du regard) ces étiquettes je les ai crée il suffit de les placer chose que j'arrive pas a programmer.

merci d'avance

amicalement

 

 

 

 

 

 

 

[x13]

Voiçi un lisp qui va peut-être t'aider,

 

;; Pipe Text Marker by Lee McDonnell 13.04.2009

 

;;; Updated 30.07.2009 (Lee McDonnell)

 

(defun c:pipetxt (/ *error* CANG COBJ CPT DIAM DOC GR LANG LENT LEPT

LLEN LMID LSLP LSPT MANHOL MSG OSPT OVAR PT SCL

SPC TBOX TOBJ TSTR TSZE TWID VLST WBSE XDIS)

(vl-load-com)

 

(defun *error* (msg)

(if doc (vla-EndUndoMark doc))

(if ovar (mapcar 'setvar vlst ovar))

(and tObj (not (vlax-erased-p tObj))

(vla-delete tObj))

(if (not

(wcmatch

(strcase msg) "*BREAK,*CANCEL*,*EXIT*"))

(princ

(strcat "\n** Error: " msg " **"))

(princ "\n*Cancel*"))

(redraw) (princ))

 

(setq vlst '("CLAYER" "DIMZIN")

ovar (mapcar 'getvar vlst))

(mapcar 'setvar (cdr vlst) '(1))

 

(if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))

(progn

(princ "\n<< Current Layer Locked >>") (exit)))

 

(setq doc (vla-get-ActiveDocument

(vlax-get-Acad-Object))

spc (if (zerop (vla-get-activespace doc))

(if (= (vla-get-mspace doc) :vlax-true)

(vla-get-modelspace doc)

(vla-get-paperspace doc))

(vla-get-modelspace doc)))

 

(or (tblsearch "LAYER" "TXT-100")

(vla-add (vla-get-layers doc) "TXT-100"))

 

(or (and (zerop (getvar "DIMSCALE")) (setq scl 1.0))

(setq scl (getvar "DIMSCALE")))

 

(or pip:dia (setq pip:dia 8))

(or man:hol (setq man:hol 10.96))

(or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))

(or *Mac$tOff* (setq *Mac$tOff* 1.))

 

(initget 6)

(or (not (setq diam

(getreal

(strcat "\nSpécifez le diamètre du tuyau <"

(rtos pip:dia 2 0) "\">: "))))

(setq pip:dia diam))

(initget 6)

(or (not (setq manhol

(getreal

(strcat "\nSpécifiez diamètre du regard <"

(rtos man:hol 2 2) "'>: "))))

(setq man:hol manhol))

 

(while

(and

(setq lEnt (car (entsel "\nSélectionnez le tuyau: ")))

(eq "LINE" (cdadr (entget lEnt))))

(setq cObj (vlax-ename->vla-object lEnt)

lSpt (vlax-curve-getStartPoint cObj)

lEpt (vlax-curve-getEndPoint cObj)

lAng (angle lSpt lEpt)

xdis (- (car lEpt) (car lSpt)))

(if (zerop xdis)

(setq lSlp "-")

(setq lSlp (rtos (/ (- (cadr lEpt) (cadr lSpt)) (* 10.0 xdis)) 2 3)))

(setq lLen (+ (abs (- (car lEpt) (car lSpt))) man:hol)

lMid (vlax-curve-getPointatParam cObj

(/ (vlax-curve-getEndParam cObj) 2.0)))

(setq tStr (strcat (rtos lLen 2 0) " L.F. OF "

(rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE ("

(rtos (* (distof lSlp 2) 100.) 2 2) "%)")

tSze (* 0.1 scl))

(setq tBox (textbox (list (cons 1 (strcat tStr ".."))

(cons 40 tSze)

(cons 7 (getvar "TEXTSTYLE"))))

wBse (textbox (list (cons 1 ".")

(cons 40 tSze)

(cons 7 (getvar "TEXTSTYLE"))))

wBse (- (caadr wBse) (caar wBse)))

(vla-put-attachmentpoint

(setq tObj

(vla-addMText spc

(vlax-3D-point '(0 0 0))

(setq tWid (- (caadr tBox) (caar tBox))) tStr))

acAttachmentPointMiddleCenter)

(vla-put-Height tObj tSze)

(vla-put-layer tObj "TXT-100")

 

(setq msg

(princ "\n<< Tapez [+] or [-] pourr offset, [P]er & [<] ou [>] pour MText Width >>"))

 

;; Place Text

 

(while

(progn

(setq gr (grread t 15 0))

(redraw)

(cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))

(setq pt (vlax-curve-getClosestPointto cObj cPt))

(if (and (< 0 (getvar "OSMODE") 16383)

(setq osPt (osnap pt (osLst (getvar "OSMODE")))))

(osMark osPt))

(setq cAng (angle pt cPt)

lAng (+ cAng *Mac$Per*))

 

;; Correct Angle

 

(cond ((and (> lAng (/ pi 2)) (<= lAng pi))

(setq lAng (- lAng pi)))

((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))

(setq lAng (+ lAng pi))))

 

(vla-move tObj

(vla-get-InsertionPoint tObj)

(vlax-3D-point

(polar pt cAng (* tSze *Mac$tOff*))))

(vla-put-Rotation tObj lAng) t)

 

((eq 2 (car gr))

(cond ((vl-position (cadr gr) '(43 61))

(setq *Mac$tOff*

(+ (/ 1 10.) *Mac$tOff*)))

((eq (cadr gr) 45)

(setq *Mac$tOff*

(- *Mac$tOff* (/ 1 10.))))

((eq 6 (cadr gr))

(cond ((< 0 (getvar "OSMODE") 16384)

(setvar "OSMODE" (+ 16384 (getvar "OSMODE")))

(princ (strcat "\n" msg)))

(t (setvar "OSMODE" (- (getvar "OSMODE") 16384))

(princ (strcat "\n" msg)))) t)

((vl-position (cadr gr) '(80 112))

(setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))

((vl-position (cadr gr) '(60 44))

(if (> (- (vla-get-Width tObj) wBse) 0)

(vla-put-Width tObj

(- (vla-get-Width tObj) wBse))) t)

((vl-position (cadr gr) '(62 46))

(vla-put-Width tObj

(+ (vla-get-Width tObj) wBse)) t)

((vl-position (cadr gr) '(13 32)) nil)

(t)))

 

((eq 3 (car gr))

(if (and (< 0 (getvar "OSMODE") 16383)

(setq osPt (osnap pt (osLst (getvar "OSMODE")))))

(progn

(osMark osPt)

(setq cAng (angle pt cPt)

lAng (+ cAng *Mac$Per*))

 

;; Correct Angle

 

(cond ((and (> lAng (/ pi 2)) (<= lAng pi))

(setq lAng (- lAng pi)))

((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))

(setq lAng (+ lAng pi))))

 

(vla-move tObj

(vla-get-InsertionPoint tObj)

(vlax-3D-point

(polar ospt cAng (* tSze *Mac$tOff*))))

(vla-put-Rotation tObj lAng)))

 

nil)

 

((eq 25 (car gr)) nil) (t)))))

 

(mapcar 'setvar vlst ovar)

(redraw) (princ))

 

(princ "\n.: PipeText chargé, tapez \"Pipetxt\" pour démarrer :.")

(princ)

 

(defun oSlst (os / str cnt)

(setq str "" cnt 0)

(if (< 0 os 16383)

(foreach mod '("_end" "_mid" "_cen" "_nod" "_qua"

"_int" "_ins" "_per" "_tan" "_nea"

"_non" "_app" "_ext" "_par")

(if (not (zerop (logand (expt 2 cnt) os)))

(setq str (strcat str mod (chr 44))))

(setq cnt (1+ cnt))))

(vl-string-right-trim (chr 44) str))

 

(defun osMark (pt / drft osSz osCol ratio bold glst i)

(setq drft (vla-get-drafting

(vla-get-preferences

(vlax-get-acad-object)))

osSz (vla-get-AutoSnapMarkerSize drft)

oscol (vla-get-AutoSnapMarkerColor drft)

ratio (/ (getvar "VIEWSIZE")

(cadr (getvar "SCREENSIZE")))

bold (mapcar

(function

(lambda (x)

(* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0)

 

(repeat 50

(setq glst

(cons

(polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i)))

 

(foreach x bold

(grvecs (append (list oscol) glst (cdr glst) (list (car glst)))

(list (list x 0.0 0.0 (car pt))

(list 0.0 x 0.0 (cadr pt))

(list 0.0 0.0 1.0 0.0)

(list 0.0 0.0 0.0 1.0)))))

 

Salut, :)