Aller au contenu

Ancien LISP qui ne marche pas sur AutoCAD 2008 et 2004


Messages recommandés

Posté(e)

Bonjour,

 

J'ai un LISP qui permet de générer les ARTDB mais malheuresement il ne marche pas, lorsque je sélectionne un objet

l'erreur suivant m'apparait : "; erreur: type d'argument incorrect: lentityp nil"

 

J'ai essayé sur AutoCAD 2008 et AutoCAD 2004 mais même problème.

 


;--------------------------------------------------------------------       
;                    Le programme ARTBD.LSP permet de calculer
;                les A.R.T.B.D d'un arc de cercle aprŠs avoir choisi 
;                … l'ecran les droites qui le forment.  Tout echelle
;--------------------------------------------------------------------       
(defun c:art ()

       (graphscr)
       (setq pi 3.141592654)
       (setq fin 1)

    (if (= echell nil) (setq echell 1000))
    (setq text_ech (strcat "\nL'echelle de sortie <" (rtos echell 2 2) "> : "))
    (setq val_ech (getreal text_ech))
    (if (/= val_ech nil) (setq echell val_ech))

    (setq haut(/ (* 1.7 echell) 1000))

     (setq rac (/ 1000 (* echell)))
      (setq rac1 (/ 3.85 (* rac)))
      (setq rac2 (/ 3 (* rac)))

        
        (setq or1 (getangle "\nAngle d'orientation"))

;;;;        (if (= anglea nil) (setq anglea 1))
;;;;        (setq or2 (strcat "\nAngle d'orientation <" (rtos anglea 2 2 ) "> : "))
;;;;        (setq or1 (getangle or2))
;;;;        (if (/= or1 nil) (setq anglea or1))


       (while fin 
       
       (setq or or1)
       
       (setq or (* (/ or pi) 180))
       (print or)
       
       (if (< or 90) (setq gis (- 90 or)))
       (if (and (< or 180) (> or 90))  (setq gis (- 450 or)))
       (if (and (< or 270) (> or 180))  (setq gis (- 450 or)))
       (if (and (< or 360) (> or 270))  (setq gis (- 450 or)))
       (print gis)
       (setq gis (* (/ gis 180) pi))
;--------------------------------- selection des droites formant 
;                                  l'arc de cercle
;
       (setq ent1 (entsel))
       (setq ab (entget (car ent1)))
       (setq pta (cdr (assoc 10 ab)))
       (setq ptb (cdr (assoc 11 ab)))
       (setq xa (car pta))
       (setq ya (cadr pta))
       (setq xb (car ptb))
       (setq yb (cadr ptb))

       (setq ent2 (entsel))
       (setq cd (entget (car ent2)))
       (setq ptc (cdr (assoc 10 cd)))
       (setq ptd (cdr (assoc 11 cd)))
       (setq xc (car ptc))
       (setq yc (cadr ptc))
       (setq xd (car ptd))
       (setq yd (cadr ptd))

;--------------------------------- calcul du sommet  --------------
       
       (setq a1 (/ (- ya yb) (- xa xb)))
       (setq a2 (/ (- yd yc) (- xd xc)))
       (setq b1 (- ya (* a1 xa)))
       (setq b2 (- yd (* xd a2)))
       (setq xs (/ (- b2 b1) (- a1 a2)))
       (setq ys (+ b1 (* a1 xs)))

;-------------------------------- calcul des gisements --------------
       
       (setq pi2 (* pi 2))
       
       (setq dxsa (- xs xa))
       (setq dysa (- ys ya))
       (setq dxsb (- xs xb))
       (setq dysb (- ys yb))
       
       (setq dxsc (- xs xc))
       (setq dysc (- ys yc))
       (setq dxsd (- xs xd))
       (setq dysd (- ys yd))
       
       
       (setq dsa (sqrt (+ (expt dxsa 2) (expt dysa 2) )))
       (setq dsb (sqrt (+ (expt dxsb 2) (expt dysb 2) )))
       
       
       (if (> dsa dsb) 
       (progn
       (setq dx (- xa xs)) 
       (setq dy (- ya ys))
       ))
       
       (if (< dsa dsb) 
       (progn
       (setq dx (- xb xs)) 
       (setq dy (- yb ys))
       ))
       
       (setq gd (atan (/ dx dy)))
       (if (and (< dx 0) (> dy 0)) (setq gd (+ pi2 gd))) 
       (if (< dy 0) (setq gd (+ gd pi)))


              
;-----------------------------------------------
       
       (setq dsc (sqrt (+ (expt dxsc 2) (expt dysc 2) )))
       (setq dsd (sqrt (+ (expt dxsd 2) (expt dysd 2) )))
       
       (if (> dsc dsd) 
       (progn
       (setq dx (- xc xs)) 
       (setq dy (- yc ys))
       ))
       
       (if (< dsc dsd) 
       (progn
       (setq dx (- xd xs)) 
       (setq dy (- yd ys))
       ))
       
       ;(if (/= xs xc) (setq dx (- xc xs)))
       ;(if (= xs xc) (setq dx (- xd xs)))
       ;(if (/= ys yc) (setq dy (- yc ys)))
       ;(if (= ys yc) (setq dy (- yd ys)))
       
       (setq ga (atan (/ dx dy)))
       (if (and (< dx 0) (> dy 0)) (setq ga (+ pi2 ga))) 
       (if (< dy 0) (setq ga (+ ga pi)))
        
;------------------------------ calcul de l'angle A --------------------
       
       (setq angletopo (- ga gd))
       (if (< angletopo 0) (setq angletopo (+ angletopo pi2)))
       ;(if (< angletopo 0) (setq angletopo (+ angletopo pi2)))
       (print (/ (* angletopo 200) pi))
       (setq angleint (abs (- pi angletopo)))
       (print (/ (* angleint 200) pi))

;------------------------------ saisie du rayon -------------------------
       
       (setq rayon (getreal "\nEntrez le rayon : "))
       
;------------------------------ calcul de T B D -------------------------
       
       (setq T (* rayon (/ (sin (/ angleint 2)) (cos (/ angleint 2)))))
       ;(setq T (abs (T)))
       (setq B (- (sqrt (+ (expt T 2) (expt rayon 2))) rayon))
       ;(setq B (abs (B)))
       (setq D (* rayon angleint))
       ;(setq D (abs (D)))

;------------------------- affichage … l'ecran du rectange des ARTBD----
       
       
       (setq an ( / (* angletopo 200) pi))
       (setq pos1 (getpoint "Point d'insertion : "))
       (setq gis1 gis)
       (print gis1)
       (setq gis2 (+  gis1 (/ pi 2)))
       (print gis2)
       (setq gis3 (+  gis2 (/ pi 2)))
       (print gis3)

       (setq pos2 (list (+ (car pos1) (* 12 (* haut (sin gis1)))) (+ (cadr pos1) (* 12 (* haut (cos gis1)))) ))
       
       (setq pos3 (list (+ (car pos2) (* 10 (* haut (sin gis2)))) (+ (cadr pos2) (* 10 (* haut (cos gis2)))) ))
       
       (setq pos4 (list (+ (car pos3) (* 12 (* haut (sin gis3)))) (+ (cadr pos3) (* 12 (* haut (cos gis3)))) ))
       
       (command "_line" pos1 pos2 pos3 pos4 pos1 "")
       
;----------- formation des textes correspondant a ARTBD--------
       
       (setq tex (strcat "A = " (rtos an 2 2)))
       (setq gis12 (/ (+ gis1 gis2) 2))
       (setq posa (list (+ (car pos1) (* rac1 (sin gis12))) (+ (cadr pos1) (* rac1 (cos gis12))) ))
       (command "_Text" posa haut or tex)
       
       (setq tex (strcat "R = " (rtos rayon 2 0)))
       (setq posr (list (+ (car posa) (* rac2  (sin gis2))) (+ (cadr posa) (* rac2 (cos gis2))) ))
       (command "_Text" posr haut or tex)
       
       (setq tex (strcat "T = " (rtos T 2 2)))
       (setq post (list (+ (car posr) (* rac2 (sin gis2))) (+ (cadr posr) (* rac2 (cos gis2))) ))
       (command "_Text" post haut or tex)
       
       (setq tex (strcat "B = " (rtos B 2 2)))
       (setq posb (list (+ (car post) (* rac2 (sin gis2))) (+ (cadr post) (* rac2 (cos gis2))) ))
       (command "_Text" posb haut or tex)
       
       (setq tex (strcat "D = " (rtos D 2 2)))
       (setq posd (list (+ (car posb) (* rac2 (sin gis2))) (+ (cadr posb) (* rac2 (cos gis2))) ))
       (command "_Text" posd haut or tex)




       (setq xsy1 (+ (* rac2 10) xs))
       (setq xsy2 (+ (* rac2 15) ys))
       (setq xy (list xsy1 xsy2))


       (setq tex (strcat "Y = " (rtos ys 2 2)))
       (setq posx (list (+ (car xy) (* rac2 ))  (+ (cadr xy) (* rac2 )) ))  
       (command "_Text" posx haut "0" tex)
     
       (setq tex (strcat "X = " (rtos xs 2 2)))
       (setq posy (list (+ (car posx) ) (+ (cadr posx) (* rac2) ) ))
       (command "_Text" posy haut "0" tex)
       

       (setq px (+ (* rac2 0.5) xsy1))
       (setq py (+ (* rac2 0.5) xsy2))
       (setq pos6 (list px py))

              (setq pos7 (list (+ (car pos6) (* 14 haut)) (+ (cadr pos6)) ))
              (setq pos8 (list (+ (car pos7)) (+ (cadr pos7) (* 4.5 haut)) ))
              (setq pos9 (list (+ (car pos8) (- (* 14 haut))) (+ (cadr pos8)) ))
              (command "_line" pos6 pos7 pos8 pos9 pos6 "")



         
       (setq xpt1 (+ xs (* T (sin gd))))
       (setq ypt1 (+ ys (* T (cos gd))))
       (setq tp1 (list xpt1 ypt1))

       (setq xpt2 (+ xs (* T (sin ga))))
       (setq ypt2 (+ ys (* T (cos ga))))
       (setq tp2 (list xpt2 ypt2))

        (setq r (/ 2 (* rac)))

;;        (command "_line" tp1 tp2  "")
         (command "_circle" tp1 r "")
         (command "_circle" tp2 r "")
         (command "_arc" tp1 "_e" tp2 "_r" rayon"")

       (command "_redraw")

;while
)
;--------fin du programme--------------------------------------------
)




 

http://pastebin.com/YWva5YML

 

Merci ! :)

Posté(e)

Coucou

 

j'ai supprimé tes deux autres messages en laissant celui-ci car il est dans "débuter".

 

encore une fois mais la première de 2017 :

si tu veux apprendre : ne pas copier-coller.

 

en regardant vite fait la routine soumise :

  • il ne faut pas mettre pi en nom de variable ou alors lui donner un autre nom
  • il ne faut pas mettre or en nom de variable ou alors lui donner un autre nom

et si tu veux vraiment copier-coller, ce genre de traitement des arcs a été évoqué (et résolu) par (giles) sur ce site et là tu ne joues plus dans la même cour...

 

amicalement

 

 

 

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é