Aller au contenu

Lisp pour determiner la valeur de la pente d une droite


Messages recommandés

Posté(e)

Bonsoir ,

 

J aimerais savoir s'il existe un lisp qui peu me permettre de déterminer la valeur de la pente d' une droite ou il y a une procédure dans autocad pour la déterminer

 

merci d' avance

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Posté(e)

Bonsoir Gile

 

J'ai copié ton lisp calcul de pente z, Super

 

Question pourrais-tu demander à l'utilisateur de choisir une auteur de texte?

Par ce que le texte généré par le lisp est trop petit.

 

Merci !

Acadnadien

Posté(e)

Bonjour ,

Comment rendre ces code en fichier lisp

j ai fait un copier coller dans un bloc note et j ai enregistré sous l'extension .lsp

mais quand j charge sous autocad 2008 ca ne marche pas

merci d' avance

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Posté(e)

Question pourrais-tu demander à l'utilisateur de choisir une auteur de texte?

 

Le LISP utilise la hauteur de texte courante (TEXTSIZE).

Néanmoins, je l'ai modifié pour qu'il affiche cette hauteur au lancement de la routine et permette à l'utilisateur de la modifier.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Merci Gile

 

je l'ai modifié pour qu'il affiche cette hauteur au lancement de la routine et permette à l'utilisateur de la modifier.

 

 

Petit problème:

Il demande le premier point en même temp qu'il demande la hauteur de texte, une légère confusion!

 

Merci de ton attention.

Acadnadien

  • 1 an après...
Posté(e)

Salut,

 

 

Ne sachant pas ce que tu veux exactement : pente 2D par rapport à l'axe X ou pente 3d par rapport au paln XY, je te propose quelques liens rapidement trouvés en faisant une recherche dans les forums.

 

 

En 2d

 

Cotation en pourcentage

 

 

 

Distance avec pente

 

 

En 3d

 

LISP calcul de pente en Z

 

Bonjour

 

les liens sont invalide

 

Cordialement

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

  • 7 ans après...
Posté(e)

Hello

 

Et voici encore 2 Lisp (relatifs aux problemes de Pente) tires de mon stock de qq milliers de routines ...

 

MERCI a Bruno & Gilles et autres Super-Developpeurs ...

 

PENTE (de Bruno) dessine une ligne devant avec une pente de xx.yy % ...

 

PENTEPC (de Gilles) ecrit un texte simple par rapport a 2 Points cliques, qui indique la Pente en %

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;; 
;; http://cadxp.com/topic/36187-dessiner-une-pente-en-pourcentage/page__pid__210618__st__20
;; Par Bonuscad vs 1.00
;; Version simplifiee de l ancien programme Pente de Bonuscad 
;; 

(defun errlsp (ch)
       (cond
               ((eq ch "Function cancelled") nil)
               ((eq ch "quit / exit abort") nil)
               ((eq ch "console break") nil)
               (T (princ ch))
       )
       (setvar "cmdecho" v1)
       (setvar "orthomode" v2)
       (setvar "osmode" v3)
       (setvar "blipmode" v4)
       (setvar "snapang" v5)
       (setq *error* olderr)
       (princ)
)

(defun C:PENTE ( / v1 v2 v3 v4 v5 d_pc p_o p_f dlt_x d olderr)
       (setq v1 (getvar "cmdecho")
             v2 (getvar "orthomode")
             v3 (getvar "osmode")
             v4 (getvar "blipmode")
             v5 (getvar "snapang")
       )
       (setvar "cmdecho" 0)
       (setvar "orthomode" 0)
       (setvar "blipmode" 0)
       (setq olderr *error* *error* errlsp)
       (initget 1)
       (setq d_pc (getreal "\nEntrer la valeur de la Pente (Rampe) en % ?: "))
       (initget 8)
       (setq p_o (getpoint "\nPoint de Depart : "))
       (if (eq p_o ()) (setq p_o (getvar "lastpoint")))
       (setvar "snapang" (atan (/ d_pc 100.0)))
       (setvar "orthomode" 1)
       (initget 41)
       (setq p_f (getpoint p_o "\nPoint Final : "))
       (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384)))
       (setq dlt_x (- (car p_f) (car p_o)))
       (setq d (/ dlt_x (cos (atan (/ d_pc 100.0)))))
       (command "_.line" p_o (polar p_o (atan (/ d_pc 100.0)) d) "")
       (setvar "cmdecho" v1)
       (setvar "orthomode" v2)
       (setvar "osmode" v3)
       (setvar "blipmode" v4)
       (setvar "snapang" v5)
       (setq *error* olderr)
       (prin1)
)

 


;; Cree un objet texte le long de la pente
;; Il suffit de cliquer 2 points
;; Par GC le 08/06/2009
;; http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=24151#pid103835

;(defun c:pente%  (/ p1 p2 a)
(defun c:pentepc (/ p1 p2 a)

 (if
   (and
     (setq p1 (getpoint "\nPremier  point: "))
     (setq p2 (getpoint "\nDeuxieme point: "))
     (setq a (angle p1 p2))
   )
    (entmake
      (list
 '(0 . "TEXT")
 '(100 . "AcDbEntity")
 '(100 . "AcDbText")
 '(10 0. 0. 0.)
 (cons 40 (getvar 'textsize))
 (cons 1
       (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
 )
 (cons 50
       (if (minusp (cos a))
	 (+ pi a)
	 a
       )
 )
 '(72 . 1)
 (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
 '(73 . 1)
      )
    )
 )
 (princ)
)

Autodesk Expert Elite Team

Posté(e)

Hello

 

Et voici encore 2 Lisp (relatifs aux problemes de Pente 3D) de Gilles tires de mon stock de qq milliers de routines ...

 

SVP tu lis bien les commentaires et tu verras la difference entre les 2 routines (de 06/2016) !!

 

---- SVP tu nous diras si cela fonctionne bien !?

 

---- ET si OUI sur quelle version de AutoCAD ??

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;; 
;; http://forums.autodesk.com/t5/autocad-francais/connaitre-la-pente-de-la-partie-courbe-d-une-polyligne-3d/td-p/6345605
;; 
;; Routine pour: Furtiffl
;; 
;; Routine: PentePoly3D v1 par GC 
;; 

(defun c:PentePoly3D (/ sel pl3d elst pt1 pt2 dist deniv) 
(vl-load-com)
 (and (setq sel (entsel "\nSelectionnez une Polyligne 3D: "))
      (setq pl3d (car sel))
      (setq elst (entget pl3d))
      (= (cdr (assoc 0 elst)) "POLYLINE")
      (= 8 (logand 8 (cdr (assoc 70 elst))))
      (setq pt1 (getpoint "\nSpecifiez le premier point: "))
      (setq pt2 (getpoint "\nSpecifiez le deuxième point: "))
      (setq pt1   (vlax-curve-getClosestPointTo pl3d (trans pt1 1 0))
            pt2   (vlax-curve-getClosestPointTo pl3d (trans pt2 1 0))
            dist  (abs (- (vlax-curve-getDistAtPoint pl3d pt1) (vlax-curve-getDistAtPoint pl3d pt2)))
            deniv (- (caddr pt2) (caddr pt1))
      )
      (prompt (strcat "\nLongueur : "
                     (rtos dist 2 2)
                     "\tDenivele = "
                     (rtos deniv 2 2)
                     "\tPente : "
                     (rtos (/ (* 100. deniv) dist) 2 2)
                     "%"
             )
      )
 )
 (princ)
)

 


;; 
;; http://forums.autodesk.com/t5/autocad-francais/connaitre-la-pente-de-la-partie-courbe-d-une-polyligne-3d/td-p/6345605
;; 
;; Routine pour: Furtiffl
;; 
;; Routine: PentePoly3D v2 par GC 
;; 
;; la solution de _gile, c'est exactement ce qu'il me fallait 
;; mais je m'aperçois que je me suis trompé dans mon exemple : 
;; la longueur à calculer n'est pas 20m mais 17.9m 
;; (c'est à dire la longeur plane de la polyligne (voir l'image)).
;; 

(defun c:PentePoly3D (/ flat sel pl3d elst pt1 pt2 pa1 pa2 deniv comp inc dist)
 (vl-load-com)
 (defun flat (p) (list (car p) (cadr p) 0.0))
 (if
   (and
     (setq sel (entsel "\nSelectionnez une Polyligne 3D: "))
     (setq pl3d (car sel))
     (setq elst (entget pl3d))
     (= (cdr (assoc 0 elst)) "POLYLINE")
     (= 8 (logand 8 (cdr (assoc 70 elst))))
     (setq pt1 (getpoint "\nSpecifiez le premier point: "))
     (setq pt2 (getpoint "\nSpecifiez le deuxième point: "))
   )
    (progn
      (setq pt1   (vlax-curve-getClosestPointTo pl3d (trans pt1 1 0))
            pt2   (vlax-curve-getClosestPointTo pl3d (trans pt2 1 0))
            pa1   (vlax-curve-getParamAtPoint pl3d pt1)
            pa2   (vlax-curve-getParamAtPoint pl3d pt2)
            deniv (- (caddr pt2) (caddr pt1))
      )
      (if (< pa1 pa2)
        (setq comp <
              inc  1+
              pa1  (1+ (fix pa1))
        )
        (setq comp >
              inc  1-
              pa1  (fix pa1)
        )
      )
      (setq dist 0.0)
      (while (comp pa1 pa2)
        (setq dist (+ dist
                      (distance (flat pt1) (flat (setq pt1 (vlax-curve-getPointAtParam pl3d pa1))))
                   )
              pa1  (inc pa1)
        )
      )
      (setq dist (+ dist (distance (flat pt1) (flat pt2))))
      (prompt (strcat "\nLongueur PLANE : "
                      (rtos dist 2 2)
                      "\tDenivele = "
                      (rtos deniv 2 2)
                      "\tPente : "
                      (rtos (/ (* 100. deniv) dist) 2 2)
                      "%"
              )
      )
    )
 )
 (princ)
)

Autodesk Expert Elite Team

Posté(e)

Hello

 

Et voici encore 1 Lisp "Slope3D" (relatif aux problemes de Pente 3D) de BeeKeeCZ ...

 

Tu cliques 2 Points en 3D ... Et il indique la Pente 3D en % ...

 

---- SVP tu nous diras si cela fonctionne bien !?

 

---- ET si OUI sur quelle version de AutoCAD ??

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/label-slope/m-p/1787900/highlight/true#M224078
;; 
;; Routine Slope3D by BeekeeCZ  -- Use SNAP to EndPoint (Accrochage EXTremite)
;; 
;; Micro-Modif par Patrice B. pour avoir seulement un Texte de Pourcentage de Pente 
;; 
;; Voir TEXTSIZE pour la Hauteur par defaut du texte genere ... 
;; 
;; A PRIORI OK avec Style de Courant et Hauteur = ZERO ou xx.xx 
;;

(defun c:Slope3D ( / pt1 pt2 h1 h2 d12 ang ptm arr)
 (if (and (setq pt1 (getpoint      "\nChange TEXTSIZE Before (Avant) if necessary\nPick  first 3D Point: "))
   (setq pt2 (getpoint pt1  "\nPick second 3D Point: "))
   (not (equal pt1 pt2))
   (setq h1  (last pt1)
	 h2  (last pt2)
	 pt1 (reverse (cdr (reverse pt1)))
	 pt2 (reverse (cdr (reverse pt2)))
	 d12 (distance pt1 pt2)
	 ang (angle pt1 pt2)
	 ptm (polar pt1 ang (/ d12 2))))
   (progn
     (setq arr (cond ((= slp 0) 0)
		((< (- h1 h2) 0.) -1)
		(1)))
     (if (< (* pi 0.5) ang (* pi 1.5))
(setq ang (+ ang pi)
      arr (* arr -1)))
     (entmakex (list (cons 00 "TEXT")
                     (cons 10  (trans ptm 1 0))
                     (cons 11  (trans ptm 1 0))
                     (cons 01  (strcat (rtos (abs (* (/ (- h1 h2) d12) 100)) 2 2) "%"))
                     (cons 07 (getvar 'TEXTSTYLE))
                     (cons 40 (getvar 'TEXTSIZE))
                     (cons 50 (angle (trans '(0 0 0) 1 0) (trans (polar '(0 0 0) ang 1e6) 1 0))) ; by John Uhden
                     (cons 72 1)
                     (cons 73 1)
                     ))
;;    (command 
;;             "_-text" "_j" "_bc" "_none" ptm 1 (angtos ang) (strcat (rtos (abs (* (/ (- h1 h2) d12) 100)) 2 2) "%") 
;;	       "_-insert" ( strcat ; "c:/Users/Beekee/AppData/Local/Autodesk/AutoCAD 2015/R20.0/enu/Support/" "Arrow" (itoa arr) ".dwg") "_none" ptm (getvar 'TEXTSIZE) "" (angtos ang) 
;;    ) 

)
)
 (princ)
) 

Autodesk Expert Elite Team

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité