Aller au contenu
Problème de lien d'inscription (résolu ?) ×

% de pente

cdi

Par cdi
dans AutoCAD 2008

 Partager

Messages recommandés

cdi Newbie

cdi

Posté(e)
Posté(e)

 

Bonjour

ci-joint une routine sans grand intérêt sauf: la commande % de pente pour le tracé

Mais voila toute ces commandes marchent, sauf elle ....en fin je crois.

Si une personne compétente pouvait me donner son avis 

 

;;;    Commande : %valeur permet de changer d'altitude suivant la valeure en pourcentage donnée jusqu'à un point donné. 
;;;     Commande : >angle permet de changer d'altitude en suivant un angle spécifié (en degrés) par rapport au plan (0XY). 


;; trace de la ligne
(defun c:do_line ( / osm pt0 pt1 pt2 pt_last inc tincz tciny decz decaz ang 
	   aa ab ac ba bb bc)
 (setq olderr *error*
*error* do_err_line)

 (setq li_ent nil) ;; liste des entitees crees
 (setq li_pt nil) ;; liste des points crees
 (setq pt0 nil) ;; point precedent du point precedent
 (setq pt2 T) ;; point courant
 (setq rotucs 0) ;; angle de rotation d'ucs
     
 (command "_ucs" "_w")
 (setq osm (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 ;; attente du premier point
 (while (not pt1)
   (progn
     (setq pt1 (getpoint (strcat "\n" "First point : ")))
     (setq li_pt (cons pt1 li_pt))
     )
   )
 (setvar "LASTPOINT" pt1)
 ;; attente des autres points
 (while pt2
   (initget 128)
   (setq pt2 (getpoint (strcat " \n" "Next point : ") (getvar "lastpoint")))
   (cond 
    ( (= 'LIST (type pt2)) ;; entree d'un point
      ;; differents decalages en altitude
      (if tincz 
   (progn
     (entdel (entlast))
     (setq tincz nil)
     )
 )
      (if decz
   (progn
     (setq pt2 (append (list (car pt2)) (list (cadr pt2)) 
		       (list (+ (caddr pt1)
				(* (distance (restli 1 pt1) 
					     (restli 1 pt2))
				   (/ decz 100))
				)))) 
     (setq decz nil)
     )
 )
      (if decaz
   (progn
     (setq pt2 (append (list (car pt2)) (list (cadr pt2)) 
		       (list (+ (caddr pt1)
				(* (distance (restli 1 pt1) 
					     (restli 1 pt2)) 
				   (tand decaz))
				))))
     (setq decaz nil)
     )
 )
      ;; changement d'ucs
      ;;(command "_ucs" "_z" rotucs)
      ;;(setq pt1 (trans pt1 0 1))
      ;;(setvar "lastpoint" pt1)
      ;; test si les points sont alignes
      (if pt0 
   (progn
     (setq aa (- (car pt1) (car pt0)))     
     (setq ba (-(car pt2) (car pt1)))
     (setq ab (- (cadr pt1) (cadr pt0)))   
     (setq bb (- (cadr pt2) (cadr pt1)))
     (setq ac (- (caddr pt1) (caddr pt0))) 
     (setq bc (- (caddr pt2) (caddr pt1)))
     (if (and (= 0 (- (* ab bc) (* bb ac))) 
	      (= 0 (- (* ac ba) (* aa bc)))
	      (= 0 (- (* aa bb) (* ab ba))))
	 (progn ;; lignes colineaires
	   (setq pt1 pt0)
	   ;; retire l'encienne entite 
	   (setq li_pt (cdr li_pt))
	   (entdel (car li_ent))
	   (setq li_ent (cdr li_ent))
	   )
       )
     )	
 )  
      ;; trace de la ligne
      (command "_line" pt1 pt2 "")
      ;; ajout du dernier point et de la derniere entitee
      (setq li_pt (cons pt2 li_pt))
      (setq li_ent (cons (entlast) li_ent))
	
      ;; conditions d'avancement
      (setq pt0 pt1)
      (setq pt1 pt2)
      )
    ( (= 'STR (type pt2)) ;; si l'utilisateur entre une commande
      (cond 
((= "u" pt2) 
 (if (car li_ent) 
     (progn 
       (entdel (car li_ent))
       (setvar "lastpoint" pt0)
       ;; mise a jour des points courants
       (setq pt1 (cadr li_pt))
       (setq pt2 (car li_pt))
       (setq pt0 (caddr li_pt))
       ;; supprime la derniere entitee
       (setq li_pt (cdr li_pt))
       (setq li_ent (cdr li_ent))
       )
   )
 )
;;((= "r" (substr pt2 1 1))
;; (setq rotucs (+ rotucs (substr pt2 2)))
;; )
((= "a" (substr pt2 1 1))
 (setq ang (- 180 (atof (substr pt2 2))))
 (setq pt2 (getpoint (strcat " \n" "Second point : ") 
		     (getvar "lastpoint"))) 
 (if pt0
     (progn
       (setq aa (- (car pt1) (car pt0)))     
       (setq ba (-(car pt2) (car pt1)))
       (setq ab (- (cadr pt1) (cadr pt0)))   
       (setq bb (- (cadr pt2) (cadr pt1)))
       (setq ac (- (caddr pt1) (caddr pt0))) 
       (setq bc (- (caddr pt2) (caddr pt1)))
       (if (or (/= 0 (- (* ab bc) (* bb ac))) 
		(/= 0 (- (* ac ba) (* aa bc)))
		(/= 0 (- (* aa bb) (* ab ba))))
	   (progn
	     ;; positionnement dans le scu objet + point de raccrochage
	     (command "_ucs" "_3" pt1 pt0 pt2)
	     ;; calcul du decalage sur y dans le scu courant
	     (setq pt2 (trans pt2 0 1))
	     (setq tincy (cadr pt2))
	     (setvar "lastpoint" pt1)
	     (command "_line" "0,0,0" 
		      (strcat "@" 
			      (ftoa 
			       (/ tincy (sin (/ (* ang PI) 180))))
			      "<" (ftoa ang)) "")
	     (setq pt2 (cdr (assoc 11 (entget (entlast)))))
	     (setq tincy nil)
	     (command "_ucs" "_p")

	     (setq li_ent (cons (entlast) li_ent))
	     (setq li_pt (cons pt2 li_pt))
	     (setq pt0 pt1)
	     (setq pt1 pt2)
	     )
	 )
       )
   )
 )
((= "+" (substr pt2 1 1)) 
        ;; incremant sur Z
 (setq inc (atof (substr pt2 2)))
 (setq pt2 (getvar "lastpoint"))
 (setvar "lastpoint" (list (car pt2) (cadr pt2) (+ (caddr pt2) inc)) )
 (setq pt2 (getvar "lastpoint"))

 ;; verification de l'alignement
 (if pt0	
     (progn
       (setq aa (- (car pt1) (car pt0)))     
       (setq ba (-(car pt2) (car pt1)))
       (setq ab (- (cadr pt1) (cadr pt0)))   
       (setq bb (- (cadr pt2) (cadr pt1)))
       (setq ac (- (caddr pt1) (caddr pt0))) 
       (setq bc (- (caddr pt2) (caddr pt1)))
       (if (and (= 0 (- (* ab bc) (* bb ac))) 
		(= 0 (- (* ac ba) (* aa bc)))
		(= 0 (- (* aa bb) (* ab ba))))
	   (progn
	     (setq pt1 pt0)
	     ;; retire l'encienne entite 
	     (setq li_pt (cdr li_pt))
	     (entdel (car li_ent))
	     (setq li_ent (cdr li_ent))
	     )
	 )
       )
   )
 (command "_line" pt1 pt2 "")
 
 (setq li_ent (cons (entlast) li_ent))
 (setq li_pt (cons pt2 li_pt))
 (setq pt0 pt1)
 (setq pt1 pt2)
 )
((= "-" (substr pt2 1 1)) 
 ;; incremant sur Z (negatif)
 (setq inc (atof (substr pt2 2)))
 (setq pt2 (getvar "lastpoint"))
 (setvar "lastpoint" (list (car pt2) (cadr pt2) (- (caddr pt2) inc)) )
 (setq pt2 (getvar "lastpoint"))
			
 ;; verification de l'alignement
 (if pt0	
     (progn
       (setq aa (- (car pt1) (car pt0)))     
       (setq ba (-(car pt2) (car pt1)))
       (setq ab (- (cadr pt1) (cadr pt0)))   
       (setq bb (- (cadr pt2) (cadr pt1)))
       (setq ac (- (caddr pt1) (caddr pt0))) 
       (setq bc (- (caddr pt2) (caddr pt1)))
       (if (and (= 0 (- (* ab bc) (* bb ac))) 
		(= 0 (- (* ac ba) (* aa bc)))
		(= 0 (- (* aa bb) (* ab ba))))
	   (progn
	     (setq pt1 pt0)
	     ;; retire l'encienne entite 
	     (setq li_pt (cdr li_pt))
	     (entdel (car li_ent))
	     (setq li_ent (cdr li_ent))
	     )
	 )
       )
   )
 (command "_line" pt1 pt2 "")
 
 (setq li_ent (cons (entlast) li_ent))
 (setq li_pt (cons pt2 li_pt))
 (setq pt0 pt1)
 (setq pt1 pt2)
 )
((= "x" (substr pt2 1 1))
 (setq inc (atof (substr pt2 2)))
 (setq pt2 (getvar "lastpoint"))
 (setvar "lastpoint" (list (+ (car pt2) inc) (cadr pt2) (caddr pt2)))
 (setq pt2 (getvar "lastpoint"))

 ;; verification de l'alignement
 (if pt0	
     (progn
       (setq aa (- (car pt1) (car pt0)))     (setq ba (-(car pt2) (car pt1)))
       (setq ab (- (cadr pt1) (cadr pt0)))   (setq bb (- (cadr pt2) (cadr pt1)))
       (setq ac (- (caddr pt1) (caddr pt0))) (setq bc (- (caddr pt2) (caddr pt1)))
       (if (and (= 0 (- (* ab bc) (* bb ac))) 
		(= 0 (- (* ac ba) (* aa bc)))
		(= 0 (- (* aa bb) (* ab ba))))
	   (progn
	     (setq pt1 pt0)
	     ;; retire l'encienne entite 
	     (setq li_pt (cdr li_pt))
	     (entdel (car li_ent))
	     (setq li_ent (cdr li_ent))
	     )
	 )
       )
   )
 (command "_line" pt1 pt2 "")

 (setq li_ent (cons (entlast) li_ent))
 (setq li_pt (cons pt2 li_pt))
 (setq pt0 pt1)
 (setq pt1 pt2)
 )
((= "y" (substr pt2 1 1))
 (setq inc (atof (substr pt2 2)))
 (setq pt2 (getvar "lastpoint"))
 (setvar "lastpoint" (list (car pt2) (+ (cadr pt2) inc) (caddr pt2)))
 (setq pt2 (getvar "lastpoint"))

 ;; verification de l'alignement
 (if pt0	
     (progn
       (setq aa (- (car pt1) (car pt0)))     (setq ba (-(car pt2) (car pt1)))
       (setq ab (- (cadr pt1) (cadr pt0)))   (setq bb (- (cadr pt2) (cadr pt1)))
       (setq ac (- (caddr pt1) (caddr pt0))) (setq bc (- (caddr pt2) (caddr pt1)))
       (if (and (= 0 (- (* ab bc) (* bb ac))) 
		(= 0 (- (* ac ba) (* aa bc)))
		(= 0 (- (* aa bb) (* ab ba))))
	   (progn
	     (setq pt1 pt0)
	     ;; retire l'encienne entite 
	     (setq li_pt (cdr li_pt))
	     (entdel (car li_ent))
	     (setq li_ent (cdr li_ent))
	     )
	 )
       )
   )
 (command "_line" pt1 pt2 "")

 (setq li_ent (cons (entlast) li_ent))
 (setq li_pt (cons pt2 li_pt))
 (setq pt0 pt1)
 (setq pt1 pt2)
 )
((= "%" (substr pt2 1 1))
 (setq decz (atof (substr pt2 2)))
 )
((= ">" (substr pt2 1 1))
 (setq decaz (atof (substr pt2 2)))
 )
((= "p" (substr pt2 1 1)) 
 ;; incremant sur Z
 (setq inc (atof (substr pt2 2)))
 (setq pt_last (getvar "lastpoint"))
 (setq pt2 (list (car pt_last) (cadr pt_last) 
		 (+ (caddr pt_last) inc)) )
 
 (command "_line" pt1 pt2 "")
 (redraw (entlast) 3)
 (setq tincz (entlast))
 )
((= "m" (substr pt2 1 1)) 
 ;; incremant sur Z
 (setq inc (atof (substr pt2 2)))
 (setq pt_last (getvar "lastpoint"))
 (setq pt2 (list (car pt_last) (cadr pt_last) 
		 (- (caddr pt_last) inc)) )
 
 (command "_line" pt1 pt2 "")
 (redraw (entlast) 3)
 (setq tincz (entlast))
 )
( T (princ "\nInvalid command")) ;; commande non valide
)
      )
    ( T (setq pt2 nil) ) ;; sortie de la fonction do_line
    ) ;; fin cond
   ) ;; fin while pt2
 (command "_ucs" "_p")
 (setvar "OSMODE" osm)
 (setq li_ent (reverse li_ent)
li_ent nil li_pt nil)

 (setq *error* olderr)
 (graphscr)
 (princ)
 )
 )

;; 0 a nb premiers elements d'une liste
(defun restli (nb liste)
 (if (< nb 0) 
     nil
   (reverse (member (nth nb liste) (reverse liste)))
   )
 )

(princ "\nPlease see source file for more infos about use of 3D_Line.mns.")
(princ "\nc:do_line loaded - type do_line to use.")
(princ)

 

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Bonjour,

 

J'ai voulu tester pour voir, déjà lors du copier-coller j'ai une parenthèse supplémentaire en entrée.

 

Après j'ai eu un peu de mal à comprendre le fonctionnement.

 

En fait en me mettant en vue 3d, j'ai saisi a peu près comment ça marche.

 

Si au message "Next point :" tu rentre par exemple %45, il stocke ce paramètre.

Au prochain "Next point :" tu donne un point graphique en XY, et il se sert de ce dernier point pour mettre en place le segment avec une pente de 45% [surligneur]AVEC [/surligneur] le plan XY.

 

On peut faire la même avec un angle en mettant >35 à la place de %xx, mais là il y a un problème car la fonction (TAND) est absente. (Lisp incomplet, as tu bien donné le code source intégralement?)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

cdi Newbie

cdi

Posté(e)
  • Auteur
Posté(e)

Bonjour Bonus

 

 

 

C'est exactement ça .

Alors aprés avoir regardé il me manquait .......du copier colle sans doute enfin ok ça marche.

 

 

IL faut que je recherche car ce n'ai pas l'original celui-ci

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é