Cde Rectangle couteau suisse

usegomme · le 20 février 2009

Bonjour

J'ai creusé l'idée de tramber , voici que ça a donné.

 ; usegomme 20-02-2009 modif 25-02-09 intégration ex ECR.lsp
;; dessine rectangle par diagonale
;;et si a et b horiz ou vertical, parallélogramme,carré,rect,triangle équilatéral,losange équil.
;; selon orientation 3 eme point
(defun er:xbox (msg) 
 (setvar "plinewid" pw)(setvar "CMDECHO" 1) 
 (setq *error* m:err m:err nil)
 (princ)
)

(defun cvcp (coord1 coord2) (= (rtos coord1 2 4) (rtos coord2 2 4)))

(defun modif:sommet ( ent lent typent pd pf / l1 s xs ys xp yp i )  
 (setq pd (trans pd 1 0) ok nil xp (car pd) yp (cadr pd)) 
 (if (= typent "POLYLINE")
   (progn
     (setq l1 (entget (entnext (cdr (assoc -1 lent)))))
     ;analyse sommets
     (while (and (= ok nil) (/= "SEQEND" (cdr (assoc 0 l1))))
       (setq s (cdr (assoc 10 l1))  xs (car s) ys (cadr s))
       (if (and (cvcp xs xp)(cvcp ys yp))
         ;modif sommet
         (progn
           (setq ok T pf (trans pf 1 0) l1 (subst (cons 10 pf) (assoc 10 l1) l1))
           (entmod l1)   (entupd ent)
         )
         (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
       )
     )  ;fin while
   ) ;fin progn
   (progn       ;; pour LWPOLYLINE
     (setq i 9)     
     (while (and (= ok nil) (nth (setq i (+ i 1)) lent))
       (if (= 10 (car (nth i lent)))
         (progn 
           (setq s (cdr (nth i lent)) xs (car s) ys (cadr s))
           (if (and (cvcp xs xp)(cvcp ys yp))
             ;modif sommet
             (progn
               (setq ok T pf (trans pf 1 0) lent (subst (cons 10 pf) (nth i lent) lent))
               (entmod lent)  (entupd ent)
             ) ;fin progn       
           ) ; fin if
         ) ;fin progn     
       ) ; fin if
     )  ;fin while
   ) ;fin progn
 )
)

(defun c:EtirCotRect (/ sel  lent typent p0 p1 p2 p3 p4 p5 p6 M F disetir angetir rect-ok) 
 (setq m:err-ecr *error* *error* err-ecr)
 (setq rect-ok nil)
 (setq sel (entsel "\n  Choix du rectangle  à Modifier :"))
 (setq ent (car sel) lent (entget ent) typent (cdr (assoc 0 lent)))
 (cond
   ((or (= typent "POLYLINE")(= typent "LWPOLYLINE"))
     (redraw ent 3)  
     (setq p0 (cadr sel) p1 (osnap p0 "_endp") p2 (osnap p0 "_mid") ang (angle p1 p2)
       dis (distance p1 p2)  p3 (polar p2 ang dis) 
     )
     (setq x1 (car p1)  y1 (cadr p1)  x3 (car p3)  y3 (cadr p3))    
     ;; trouver 2 autres sommets
     (if (= typent "LWPOLYLINE")
       (progn       
         (setq i 9 ok 0)     
         (while (and (/= ok 3) (nth (setq i (+ i 1)) lent))
           (if (= 10 (car (nth i lent)))
             (progn 
               (setq s (cdr (nth i lent))  xs (car s)  ys  (cadr s))
               (cond 
                 ((and (not (cvcp xs x1)) (not (cvcp ys y1))) (setq F s xF (car s) yF (cadr s) ok (+ ok 1)))                
                 ((and (not (cvcp xs x3)) (not (cvcp ys y3))) (setq M s xM (car s) yM (cadr s) ok (+ ok 1)))      
               )       
             ) ;fin progn     
           ) ; fin if
         )  ;fin while
         ; verification
         (if (and (= ok 2)(or (and (cvcp xF x3) (cvcp yF yM) (cvcp xM x1) (cvcp y1 y3))
           (and (cvcp yF y3) (cvcp xF xM) (cvcp yM y1) (cvcp x1 x3))))
           (setq rect-ok T)
         )
       );fin progn 
     ) 
     (if rect-ok
       (progn         
         (setq p4 (getcorner "\n nouveau sommet :" F)) 
         (if (not p4) (setq p4 (getpoint "\n nouveau sommet:" p1)) )     
         (setq x4 (car p4)   y4  (cadr p4))
         (modif:sommet ent lent typent p1 p4) ;modif 1 er sommet
         ; mise a jour de la liste necessaire pour LWPOLYLIGNE avant modif 2 eme sommet
         (setq lent (entget ent))
         (cond  ((cvcp x3 xF) (setq p6 (list xF y4)))  ((cvcp y3 yF) (setq p6 (list x4 yF))))
         (modif:sommet ent lent typent p3 p6)  ; modif 2 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (cond  ((cvcp xM xF) (setq p5 (list xF y4)))  ((cvcp yM yF) (setq p5 (list x4 yF))))
         (modif:sommet ent lent typent M p5)  ; modif 3 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (setq ent nil)
       )
       (progn
         (setq d1 (distance p0 p1)  d2 (distance p0 p2)) (if (< d1 d2)(setq p2 p1))
         (setq p4 (getpoint "\n nouvelle position du segment:" p2))     
         (setq angetir (angle p2 p4) disetir (distance p2 p4))
         (setq p5 (polar p1 angetir disetir)  p6 (polar p3 angetir disetir))
         (modif:sommet ent lent typent p1 p5) ;modif 1 er sommet
         (setq lent (entget ent)); mise a jour
         (modif:sommet ent lent typent p3 p6) ;modif 2 eme sommet
         (setq ent nil)
       )
     )
   )
   (T (setq ent nil) (prompt "\n * CE N'EST PAS UNE POLYLIGNE * ") (princ))           
 ) 
 (gc)
 (setq *error* m:err-ecr m:err-ecr nil)
 (princ)       
)


(defun recartrilo (a b / c d angl_base long angl_haut larg pt)
 (setq m:err *error* *error* er:xbox)
 (setvar "CMDECHO" 0) 
 (setq angl_base (angle a b) long (distance a b))
 (setq pt nil) ; pour losange
 (grdraw a b -1)
 (initget "Carré")
 (setq c (getpoint b "\nPoint suivant ou [] : "))
 (if (= c "Carré")(setq c nil))      
 (cond  
   (c  ;; if c     
     (setq angl_haut (angle b c)) (setq ah angl_haut)(setq ab (angle a b)) 
     (cond
       ((= (angtos angl_haut 0 1) (angtos angl_base 0 1))
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c))
         (setq c (polar b (+ angl_base (* 0.5 pi)) larg)) ; replacé à 90°
         (setq d (polar c (+ angl_base pi) long))
       )
       ((or 
           (= (angtos (+ angl_haut pi) 0 1) (angtos angl_base 0 1)) 
           (= (angtos (- angl_haut pi) 0 1) (angtos angl_base 0 1))       
         )
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c) ) 
         (setq c (polar a (+ angl_base (/ pi 3)) long));;; ->triangle équilatéral
         (cond 
           ((> larg long)
             (setq d (polar a (+ angl_base (* 5 (/ pi 3))) long)) ;;-> losange
             ;;permutation des points
             (setq pt c c b b pt)
           )
         )
       )
       (t (setq d (polar c (+ angl_base pi) long))
       )
     ) 
   ) ; if c
   (t  ;; not c -> CARRE   
     (setq c (polar b (+ angl_base (* 0.5 pi)) long))
     (setq d (polar a (+ angl_base (* 0.5 pi)) long))
   )     
 )
 (if pt (grdraw a c -1)(grdraw a b -1))     
 (cond 
   ((and a b c d)
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c "_none" d "_c")
     (setvar "plinewid" pw)
   )
   ((and a b c )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c  "_c")
     (setvar "plinewid" pw)
   )
 )
 (er:xbox)
)

(defun c:xbox (/ xa ya xb yb a b tolang angl_base )  
 (setvar "CMDECHO" 1) 
 (setq pw (getvar "plinewid")) ; svgd epais polylign
 (setq xa (getvar "lastpoint")) ;pour controle cde rectang
 (setq a "Epaisseur" b nil)
 (while (= a "Epaisseur")
   (initget "Epaisseur éTirer.cotés")
   (setq a (getpoint "\nPremier coin ou [Epaisseur/<éTirer.cotés>]: "))
   (if (= a "éTirer.cotés")(setq a nil))
   (cond
     ((not a) (c:EtirCotRect))
     ((= a "Epaisseur") 
       (if epaisseur_box
         (if (setq b (getdist (strcat "\n Epaisseur du trait <" (rtos epaisseur_box 2 4) ">:")))(setq epaisseur_box b))
         (setq epaisseur_box (getdist "\n Epaisseur du trait:"))
       )
     )
   ) ;cond
 )
 (cond 
   (a
     (command "_rectang" "_t" (getvar "thickness")"_c" "0" "0" "_f" "0" "_w" (if epaisseur_box epaisseur_box 0.0)
     "_none" a "_r" "0" pause)
     (setq b (getvar "LASTPOINT"))
     (if (or (equal a b)(equal xa b)) (setq b nil))
     (if b (entdel (entlast)))
   )
 )
 (cond  
   (b  ;; if b
     (setq tolang 1.0)  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TOLERANCE ANGULAIRE  + ou - 1°
     (setq xa (car a) ya (cadr a) xb (car b) yb (cadr b))
     (setq angl_base (* (angle a b) (/ 180 pi)))
     (cond      
       ((or
           (= angl_base 0.0)
           (or (= angl_base 0.0)(and (< angl_base (+ 0.0 tolang))(> angl_base (- 0.0 tolang)))(> angl_base (- 360.0 tolang)))
           (or (= angl_base 180.0)(and (< angl_base (+ 180.0 tolang))(> angl_base (- 180.0 tolang))))
         )
         (setq b (list xb ya))
         (recartrilo a b)
       )              
       ((or
           (or (= angl_base 90.0)(and (< angl_base (+ 90.0 tolang))(> angl_base (- 90.0 tolang))))
           (or (= angl_base 270.0)(and (< angl_base (+ 270.0 tolang))(> angl_base (- 270.0 tolang))))
         )
         (setq b (list xa yb))
         (recartrilo a b)
       )
       (t  ;; rectangle par diagonale
         (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
         (command "_PLINE" "_none" a "_none" (list xa yb) "_none" b "_none" (list xb ya) "_c")
         (setvar "plinewid" pw)
       )
     ) 
   )
 )  
 (princ)
)

[Edité le 20/2/2009 par usegomme][Edité le 20/2/2009 par usegomme][Edité le 25/2/2009 par usegomme][Edité le 25/2/2009 par usegomme]

[Edité le 26/2/2009 par usegomme]

Tramber · le 20 février 2009

Sympa le nom de la commande !

C'est quoi ECR ?! et le load ?

D'autre part [Epaisseur/] n'est pas correct, il y a 2 E majuscule.

marche pas....

Tramber · le 20 février 2009

Impitoyable le Tramber !

pas le temps de débugger surtout, juste de papoter entre 2 clics

usegomme · le 20 février 2009

C'est vrai je ne m'en suis pas aperçu car je répond par entrée. Je vais corriger.

ECR est dans ce post .

usegomme · le 20 février 2009

C'est corrigé , merci impitoyable Tramber.

Petites explications :

Quand les 2 premiers points sont alignés orthogonalement , un 3 eme est demandé.

Si on répond par entrée un carré est dessiné ,

si on clique encore dans le même prolongement un rectangle est dessiné , ceci permettant

de donner une direction (axe ortho) est de taper la longueur , puis la largeur sans retoucher la souris.

Si on revient en sens inverse, et clique entre les 2 premiers pts, un triangle équilatéral est dessiné et si on clique plus loin que le premier point un losange est dessiné.

Et évidemment si le 3 pt est selon un axe perpendiculaire c'est un rectangle sinon un parallélogramme.

[Edité le 20/2/2009 par usegomme]

usegomme · le 20 février 2009

Je viens de mettre l'option "Carré" accessible depuis clavier et souris pour ne pas me faire tirer les oreilles une seconde fois.

lili2006 · le 20 février 2009

Bonsoir à toutes et tous,

Super usegomme ! :D

Mais, lorsque je lance xbox, je me retrouve avec la commande du rectangle AutoCAD ! :mad:

Ou j'ai pas tout compris (en même tps, j'ai testé rapidement, faute de tps,...)

Je reverrai ça demain à tête reposé,...

usegomme · le 20 février 2009

Salut Lilian, effectivement on démarre bien avec la cde autocad.

J'ai d'abord crée ce lisp avec la fonction getcorner pour faire la boite dynamique , mais getcorner n'est pas satisfaisant ,la boite dyn ne pivote pas avec le scu et ne suit pas le mode polaire ,et ce n' était pas facile de faire la base ortho .

Du coup j'ai utilisé la cde rectang pour faire la boite dynamique, et les options visibles de cette cde sont utilisables dans le lisp.

lili2006 · le 21 février 2009

Bonjour à toutes et tous,

Ok !!!

C'était donc moi qui avait testé trop rapidement,....

Toutes les options fonctionnent nickel !! :D

Et un coup d'ECR, pour les modifs éventuelles,...

;)

Merci encore usegomme,

Tramber · le 23 février 2009

Mouais....

Je ne comprends toujours pas le [Epaisseur/], un entre 2 crochets, j'ai jamais vu.

D'ailleurs si je réponds tout de suite pas ENTREE, le choix entre crochets ne fonctionne pas j'ai l'erreur avec ECR dont le chargement n'a pas abouti. Idem si je tape T.

Ou alors il faut que je fasse un fichier ECR ? Zut. Moi j'ai juste copié la routine à la suite.

Sinon, au point suivant (quand j'en arrive à cette étape après 2 clics dans un aligement, j'aurais aimé non pas seulement un clic mais aussi une valeur. Je tape 50 et mon rectangle fera 50 de haut). Et au rectangle suivant il me proposera même 50 par défaut.

Ca commencera à être pas mal ! :cool: quand on aura une "hauteur" de rectangle à la volée (souris, valeur numérique ou Entrée pour ladernière valeur numérque....).

:calim:

usegomme · le 23 février 2009

Bonjour à tous,

A l'intention de Mr Tramber , ECR est un lisp qui ce trouve à cette adresse dans ce post ,

comme indiqué précédemment dans le post n° 3 , c'est pas top mais je ne sais

pas faire du "PowerClic" .

Entre crochet signifie que c'est ce qu'on obtient si on répond par "entrée" ,

c'est pas nouveau du tout ???

Je vais voir pour ta hauteur par défaut , il va falloir pour cela que je vire mon carré par défaut,

mais comme il n'a guère d'utilité je ne vais pas le pleurer.

Ceci dit , on PEUT taper "longueur" "entrée" "largeur" "entrée" à la volée aprés avoir donné le 1er point et indiqué une direction orthogonale (sans cliquer) avec la souris .

(comme déjà indiqué plus haut).

Cela ce fait trés bien en mode polaire , sans aucun mode c'est plus difficile mais on peut toujours modifier le lisp et augmenter la tolérance angulaire qui est de + ou - 1 degré actuellement.

Il faut juste pousser le curseur suffisamment loin pour ne pas se retrouver avec un triangle à la place du rectangle.

a+

Tramber · le 23 février 2009

ECR est un lisp qui ce trouve à cette adresse dans ce post ,

Je sais.

Entre crochet signifie que c'est ce qu'on obtient si on répond par "entrée" ,
c'est pas nouveau du tout ???

Tu comprends pas, lalallère, ta syntaxe n'est pas correcte, l'entre crochet n'est pas jamais entre 2 parenthèses droites !! :cool:

Je vais voir pour ta hauteur par défaut , il va falloir pour cela que je vire mon carré par défaut,
mais comme il n'a guère d'utilité je ne vais pas le pleurer.

Petite leçon :

Point suivant ou [Carré] :

C'est pas beau ça ?

Ceci dit , on PEUT taper "longueur" "entrée" "largeur" "entrée" à la volée aprés avoir donné le 1er point et indiqué une direction orthogonale (sans cliquer) avec la souris .
(comme déjà indiqué plus haut).
Cela ce fait trés bien en mode polaire , sans aucun mode c'est plus difficile mais on peut toujours modifier le lisp et augmenter la tolérance angulaire qui est de + ou - 1 degré actuellement.
Il faut juste pousser le curseur suffisamment loin pour ne pas se retrouver avec un triangle à la place du rectangle.
a+

Oui ok, bon d'accord.....

J'ai moi-même essayé avec des @, que j'utilise plus volontiers que tous ces gadgets genre extension, polaire et tout le toutim....

Hop, je te mets 14/20 mais tu peux encore persévérer. Moi je vais boire un petit café !

usegomme · le 23 février 2009

Hop, je te mets 14/20 mais tu peux encore persévérer. Moi je vais boire un petit café !

Ben, moi je suis allé boire un chocolat car tu m'as épuisé , mais tu es un gentil impitoyable , 14/20 , je n' espérais pas tant.

Point suivant ou [Carré] <65> :

Ouais c'est beau, mais mon carré n'est plus l'option par défaut.

Je trouvais amusant d' essayer d'avoir différentes figures géométriques sans se servir d'options.

ta syntaxe n'est pas correcte, l'entre crochet n'est pas jamais entre 2 parenthèses droites

Non, mais alors et si j'ai envie , et puis ça fonctionne !

J'ai moi-même essayé avec des @, que j'utilise plus volontiers que tous ces gadgets genre extension, polaire et tout le toutim....

Dis-donc , c'est la méthode à papy autocad14 ! Je trouve que le mode polaire est un grand progrés , je serais fâché de devoir m'en passer maintenant.

Je sais.

J'ai pas rêvé là dis donc ! Tu me cherches ! T'ar ta gueule à la récré !

Tramber · le 24 février 2009

D'abord, je suis papy V2000 même si j'ai découvert avec la V12 à l'université.

Mais

Point suivant ou [Carré] :

est à mon gout le point le plus important (et productif). Genre tu tapes 65 ca va vers le haut et -65 vers le bas. Le carré, tu tapes C ENTREE ça gaze aussi pas mal niveau vitesse.

J'attends de pouvoir te mettre le 16/20.

usegomme · le 24 février 2009

Bonsoir , voici une version spéciale pour Tramper et ses adeptes, j'espère que je suis sur la bonne voie.

; XBOXT de usegomme le 24-02-2009
;; version Tramber 1ER  indice C  03-03-2009 compatible 2004
;; dessine rectangle par diagonale
;;et si a et b horiz ou vertical, options parallélogramme,carré,rect,triangle équilatéral,losange équil.
(defun er:xbox (msg) 
 (setvar "plinewid" pw)(setvar "CMDECHO" 1) 
 (setq *error* m:err m:err nil)
 (princ)
)
(defun err-ecr (msg) 
 (if ent (progn (redraw ent 4) (setq ent nil)))
 (setq *error* m:err-ecr m:err-ecr nil)
 (princ )
)

(defun cvcp (coord1 coord2) (= (rtos coord1 2 4) (rtos coord2 2 4)))

(defun modif:sommet ( ent lent typent pd pf / l1 s xs ys xp yp i )  
 (setq pd (trans pd 1 0) ok nil xp (car pd) yp (cadr pd)) 
 (if (= typent "POLYLINE")
   (progn
     (setq l1 (entget (entnext (cdr (assoc -1 lent)))))
     ;analyse sommets
     (while (and (= ok nil) (/= "SEQEND" (cdr (assoc 0 l1))))
       (setq s (cdr (assoc 10 l1))  xs (car s) ys (cadr s))
       (if (and (cvcp xs xp)(cvcp ys yp))
         ;modif sommet
         (progn
           (setq ok T pf (trans pf 1 0) l1 (subst (cons 10 pf) (assoc 10 l1) l1))
           (entmod l1)   (entupd ent)
         )
         (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
       )
     )  ;fin while
   ) ;fin progn
   (progn       ;; pour LWPOLYLINE
     (setq i 9)     
     (while (and (= ok nil) (nth (setq i (+ i 1)) lent))
       (if (= 10 (car (nth i lent)))
         (progn 
           (setq s (cdr (nth i lent)) xs (car s) ys (cadr s))
           (if (and (cvcp xs xp)(cvcp ys yp))
             ;modif sommet
             (progn
               (setq ok T pf (trans pf 1 0) lent (subst (cons 10 pf) (nth i lent) lent))
               (entmod lent)  (entupd ent)
             ) ;fin progn       
           ) ; fin if
         ) ;fin progn     
       ) ; fin if
     )  ;fin while
   ) ;fin progn
 )
)

(defun c:EtirCotRect (/ sel  lent typent p0 p1 p2 p3 p4 p5 p6 M F disetir angetir rect-ok) 
 (setq m:err-ecr *error* *error* err-ecr)
 (setq rect-ok nil)
 (setq sel (entsel "\n  Choix du rectangle  à Modifier :"))
 (setq ent (car sel) lent (entget ent) typent (cdr (assoc 0 lent)))
 (cond
   ((or (= typent "POLYLINE")(= typent "LWPOLYLINE"))
     (redraw ent 3)  
     (setq p0 (cadr sel) p1 (osnap p0 "_endp") p2 (osnap p0 "_mid") ang (angle p1 p2)
       dis (distance p1 p2)  p3 (polar p2 ang dis) 
     )
     (setq x1 (car p1)  y1 (cadr p1)  x3 (car p3)  y3 (cadr p3))    
     ;; trouver 2 autres sommets
     (if (= typent "LWPOLYLINE")
       (progn       
         (setq i 9 ok 0)     
         (while (and (/= ok 3) (nth (setq i (+ i 1)) lent))
           (if (= 10 (car (nth i lent)))
             (progn 
               (setq s (cdr (nth i lent))  xs (car s)  ys  (cadr s))
               (cond 
                 ((and (not (cvcp xs x1)) (not (cvcp ys y1))) (setq F s xF (car s) yF (cadr s) ok (+ ok 1)))                
                 ((and (not (cvcp xs x3)) (not (cvcp ys y3))) (setq M s xM (car s) yM (cadr s) ok (+ ok 1)))      
               )       
             ) ;fin progn     
           ) ; fin if
         )  ;fin while
         ; verification
         (if (and (= ok 2)(or (and (cvcp xF x3) (cvcp yF yM) (cvcp xM x1) (cvcp y1 y3))
           (and (cvcp yF y3) (cvcp xF xM) (cvcp yM y1) (cvcp x1 x3))))
           (setq rect-ok T)
         )
       );fin progn 
     ) 
     (if rect-ok
       (progn         
         (setq p4 (getcorner "\n nouveau sommet :" F)) 
         (if (not p4) (setq p4 (getpoint "\n nouveau sommet:" p1)) )     
         (setq x4 (car p4)   y4  (cadr p4))
         (modif:sommet ent lent typent p1 p4) ;modif 1 er sommet
         ; mise a jour de la liste necessaire pour LWPOLYLIGNE avant modif 2 eme sommet
         (setq lent (entget ent))
         (cond  ((cvcp x3 xF) (setq p6 (list xF y4)))  ((cvcp y3 yF) (setq p6 (list x4 yF))))
         (modif:sommet ent lent typent p3 p6)  ; modif 2 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (cond  ((cvcp xM xF) (setq p5 (list xF y4)))  ((cvcp yM yF) (setq p5 (list x4 yF))))
         (modif:sommet ent lent typent M p5)  ; modif 3 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (setq ent nil)
       )
       (progn
         (setq d1 (distance p0 p1)  d2 (distance p0 p2)) (if (< d1 d2)(setq p2 p1))
         (setq p4 (getpoint "\n nouvelle position du segment:" p2))     
         (setq angetir (angle p2 p4) disetir (distance p2 p4))
         (setq p5 (polar p1 angetir disetir)  p6 (polar p3 angetir disetir))
         (modif:sommet ent lent typent p1 p5) ;modif 1 er sommet
         (setq lent (entget ent)); mise a jour
         (modif:sommet ent lent typent p3 p6) ;modif 2 eme sommet
         (setq ent nil)
       )
     )
   )
   (T (setq ent nil) (prompt "\n * CE N'EST PAS UNE POLYLIGNE * ") (princ))           
 ) 
 (gc)
 (setq *error* m:err-ecr m:err-ecr nil)
 (princ)       
)


(defun rectramber (a b / c d angl_base long angl_haut larg pt h nc)
 (setq m:err *error* *error* er:xbox)
 (setvar "CMDECHO" 0) 
 (setq angl_base (angle a b) long (distance a b) h nil nc nil)
 (if (not hxbox) (setq hxbox long))
 (setq pt nil) ; pour losange
 (grdraw a b -1)
 (initget "Parallelogr Carré Triangle Losange Hexagone")
 (if 
   (setq c (getdist (strcat "\nLargeur ou [Carré/Hexagone/Losange/Parallelogr/Triangle]<"(rtos hxbox 2 4)">:") b))
   (if (and (/= c "Carré")(/= c "Parallelogr")(/= c "Triangle")(/= c "Losange")(/= c "Hexagone"))
     (setq h c hxbox c c nil)
   )
   (setq h hxbox)
 )
 (cond 
   ((= c "Hexagone") (setq c nil nc 6))
   ((= c "Triangle")(setq c (polar b (+ angl_base  pi)(* 0.5 long))))
   ((= c "Losange")(setq c (polar b (+ angl_base  pi)(* 1.5 long))))
   ((= c "Parallelogr")
     (if (not (setq c (getpoint b "\nPoint suivant ou []: ")))(setq c "Carré"))
   )
   
 )
 (cond  
   ((= c "Carré")
     (setq c (polar b (+ angl_base (* 0.5 pi)) long))
     (setq d (polar a (+ angl_base (* 0.5 pi)) long))
     ;(setq hxbox (abs (- (cadr c)(cadr b))))
   )
   (c  ;; if c     
     (setq angl_haut (angle b c)) (setq ah angl_haut)(setq ab (angle a b)) 
     (cond
       ((= (angtos angl_haut 0 1) (angtos angl_base 0 1))
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c))
         (setq c (polar b (+ angl_base (* 0.5 pi)) larg)) ; replacé à 90°
         (setq d (polar c (+ angl_base pi) long))
       )
       ((or 
           (= (angtos (+ angl_haut pi) 0 1) (angtos angl_base 0 1)) 
           (= (angtos (- angl_haut pi) 0 1) (angtos angl_base 0 1))       
         )
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c) ) 
         (setq c (polar a (+ angl_base (/ pi 3)) long));;; ->triangle équilatéral
         (cond 
           ((> larg long)
             (setq d (polar a (+ angl_base (* 5 (/ pi 3))) long)) ;;-> losange
             ;;permutation des points
             (setq pt c c b b pt)
           )
         )
       )
       (t (setq d (polar c (+ angl_base pi) long))
         (setq hxbox (abs (- (cadr c)(cadr b))))
       )
     ) 
   ) ; if c
   ((and (not c)(not nc) );;; -> rectangle hauteur= hxbox   
     (setq c (polar b (+ angl_base (* 0.5 pi)) hxbox))
     (setq d (polar a (+ angl_base (* 0.5 pi)) hxbox))
     ;(setq hxbox (abs (- (cadr c)(cadr b))))
     
   )     
 )
 (if pt (grdraw a c -1)(grdraw a b -1))     
 (cond 
   ((and a b c d)
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c "_none" d "_c")
     (setvar "plinewid" pw)
   )
   ((and a b c )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c  "_c")
     (setvar "plinewid" pw)
   )
   ((and a b nc )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b)
     (repeat (- nc 2)
       (command "_none" (setq b (polar b (setq angl_base (+ angl_base (/ pi (/ nc 2))))long)))
     )
     (command "_c")
     (setvar "plinewid" pw)
   )
 )
 (er:xbox)
)

(defun c:xboxT (/ xa ya xb yb a b tolang angl_base )  
 (setvar "CMDECHO" 1) 
 (setq pw (getvar "plinewid")) ; svgd epais polylign
 (setq xa (getvar "lastpoint")) ;pour controle cde rectang
 (setq a "Epaisseur" b nil)
 (while (= a "Epaisseur")
   (initget "Epaisseur éTirer.cotés")
   (setq a (getpoint "\nPremier coin ou [Epaisseur/<éTirer.cotés>]: "))
   (if (= a "éTirer.cotés")(setq a nil))
   (cond
     ((not a)(c:EtirCotRect))
     ((= a "Epaisseur") 
       (if epaisseur_box
         (if (setq b (getdist (strcat "\n Epaisseur du trait <"(rtos epaisseur_box 2 4)">:")))(setq epaisseur_box b))
         (setq epaisseur_box (getdist "\n Epaisseur du trait:"))
       )
     )
   ) ;cond
 )
 (cond 
   (a
     (command "_rectang" "_t" (getvar "thickness")"_c" "0" "0" "_f" "0" "_w" (if epaisseur_box epaisseur_box 0.0) "_none" a )
     (if (> (atof (substr (getvar "ACADVER")1 4)) 16.1)  ;; ok si supérieur à autocad 2005
       (command  "_r" "0" )   
     )
     (command pause)
     (setq b (getvar "LASTPOINT"))
     (if (or (equal a b)(equal xa b)) (setq b nil))
     (if b (entdel (entlast)))
   )
 )
 (cond  
   (b  ;; if b
     (setq tolang 1.0)  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TOLERANCE ANGULAIRE  + ou - 1°
     (setq xa (car a) ya (cadr a) xb (car b) yb (cadr b))
     (setq angl_base (* (angle a b) (/ 180 pi)))
     (cond      
       ((or
           (= angl_base 0.0)
           (or (= angl_base 0.0)(and (< angl_base (+ 0.0 tolang))(> angl_base (- 0.0 tolang)))(> angl_base (- 360.0 tolang)))
           (or (= angl_base 180.0)(and (< angl_base (+ 180.0 tolang))(> angl_base (- 180.0 tolang))))
         )
         (setq b (list xb ya))
         (rectramber a b)
       )              
       ((or
           (or (= angl_base 90.0)(and (< angl_base (+ 90.0 tolang))(> angl_base (- 90.0 tolang))))
           (or (= angl_base 270.0)(and (< angl_base (+ 270.0 tolang))(> angl_base (- 270.0 tolang))))
         )
         (setq b (list xa yb))
         (rectramber a b)
       )
       (t  ;; rectangle par diagonale
         (setq hxbox (abs (- (cadr b)(cadr a))))
         (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
         (command "_PLINE" "_none" a "_none" (list xa yb) "_none" b "_none" (list xb ya) "_c")
         (setvar "plinewid" pw)
       )
     ) 
   )
 )  
 (princ)
)

25-02-09 intégré ex ECR.lsp , rajouté option hexagone

[Edité le 25/2/2009 par usegomme][Edité le 25/2/2009 par usegomme][Edité le 25/2/2009 par usegomme][Edité le 26/2/2009 par usegomme]

[Edité le 3/3/2009 par usegomme]

Tramber · le 24 février 2009

Toujours ton acharnement à mal écrire ta syntaxe !

Bon, c'est pas mal mais je t'enlève un point pour les espaces entre tes crochets et (rtos hxbox 2 4) !

Je suis sans pitié ! Ca fait 17/20 ce qui est déjà bien généreux.

Sinon, le ECR, je l'ai collé dans le lisp alors ca ne marche pas pour étirer car il me dit problème de chargement. Ca m'embete juste de mettre ton lisp dans mes chemins de recherche, j'ai pas le temps. Je pense que tu devrais l'intégrer.

Je suis tuant, hein ?!

Mais il est bien ton ECR, je l'ai testé aussi, c'est pas con.

usegomme · le 25 février 2009

Bonjour

Toujours ton acharnement à mal écrire ta syntaxe !

et oui , misère je suis bien imparfait.

(rtos hxbox 2 4)

et toujours bricoleur ,je n'arrive pas à faire différemment.

Sinon, le ECR, ............. Je pense que tu devrais l'intégrer

C' est fait .

Je suis tuant, hein ?!

Mais non, mais non , c'est avec plaisir.

(murmure) eh, les gars , toujours comme ça Tramber ?.... Fichtre !

lili2006 · le 25 février 2009

Bonjour à toutes et tous,

usegomme, c'est dans XBOXT que tu as inséré ECR ?

ça m'allait très bien moi déjà la première version,...

Pour un "bricoleur" (comme tu te nommes toi même), tu te débrouilles plutôt bien,...

Un peu d'encouragements tout de même dans ce monde de brutes,... :P :P :P ;)

usegomme · le 25 février 2009

c'est dans XBOXT que tu as inséré ECR ?

Oui , je mettrai l'autre version à jour après .

Un peu d'encouragements .......dans ce monde de brutes

Merci lili2006 , heureusement que tu es là !

lili2006 · le 25 février 2009

Re,

Je pense que c'est la façon de Tramber de t'encourager,...

Il n'a pas l'air mauvais bougre vu son implication sur ce site,... ;)

Oui , je mettrai l'autre version à jour après

J'attend alors,.. :D

Tramber · le 25 février 2009

Hohohihi, je me marre bien ici !

Je disais juste qu'il y a des espaces inutiles autour de ton RTOS (il est très bien sinon).

Bon c'est bien. C'est donc l'indice B :cool:

Sincérement, je travaille en métallerie et je fias souvent des vues de côté de platines qui ont toujours la même hauteur. Je vais en profiter. ;)

Bugge sur 2004, je pense sur le "_non", ca veut dire "_none"... a voir.

Sur 2006, ça gaze !

Hop, bravo.

[Edité le 25/2/2009 par Tramber]

usegomme · le 25 février 2009

Hohohihi, je me marre bien ici !
Je disais juste qu'il y a des espaces inutiles autour de ton RTOS (il est très bien sinon).

Raaaa! tu te marres alors que j'ai passé des heuuuuuuuuures à essayer de remplacer rtos.

Je suis tuant, hein ?!

A que oui !

Bugge sur 2004, je pense sur le "_non", ca veut dire "_none"... a voir

J'ai mis le e mais je ne suis pas convaincu et je n'ai plus de version antérieure à 2008.

Est-ce que la cde rectangle était identique ?

S'il y en a qui peuvent et qui ont le temps de tester, à votre bon coeur.

A+ Tramber l' impitoyable.

Tramber · le 25 février 2009

T'as pas compris pour le RTOS, c'est dans "

J'ai pas trop le temps de comprendre pourquoi ca plante sur 2004. Schouf :

Commande: xboxt

Premier coin ou [Epaisseur/]: _rectang

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: _t

Spécifiez la hauteur des rectangles : 0.000000000000000

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: _c

Spécifiez l'écart du premier chanfrein des rectangles : 0

Spécifiez l'écart du deuxième chanfrein des rectangles : 0

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: _f

Spécifiez le rayon du raccord des rectangles : 0

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: _w

Spécifiez la largeur de ligne des rectangles : 0.000000000000000

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: _non

Spécifiez un autre coin ou [Cotes]: _r

Point 2D ou une entrée clavier.

; erreur: Fonction annulée

Spécifiez un autre coin ou [Cotes]:

usegomme · le 26 février 2009

Salut

La cde rectangle 2004 n'a pas l'option rotation d'aprés ce que je vois sur ce que tu as posté.

Je l'ai donc supprimé dans la routine. Je pense que ça devrait aller.

;;;; XBOXT2004  usegomme le 26-02-09
;; version Tramber 2004  
;; dessine rectangle par diagonale
;;et si a et b horiz ou vertical, options parallélogramme,carré,rect,triangle équilatéral,losange équil
(defun er:xbox (msg) 
 (setvar "plinewid" pw)(setvar "CMDECHO" 1) 
 (setq *error* m:err m:err nil)
 (princ)
)
(defun err-ecr (msg) 
 (if ent (progn (redraw ent 4) (setq ent nil)))
 (setq *error* m:err-ecr m:err-ecr nil)
 (princ )
)

(defun cvcp (coord1 coord2) (= (rtos coord1 2 4) (rtos coord2 2 4)))

(defun modif:sommet ( ent lent typent pd pf / l1 s xs ys xp yp i )  
 (setq pd (trans pd 1 0) ok nil xp (car pd) yp (cadr pd)) 
 (if (= typent "POLYLINE")
   (progn
     (setq l1 (entget (entnext (cdr (assoc -1 lent)))))
     ;analyse sommets
     (while (and (= ok nil) (/= "SEQEND" (cdr (assoc 0 l1))))
       (setq s (cdr (assoc 10 l1))  xs (car s) ys (cadr s))
       (if (and (cvcp xs xp)(cvcp ys yp))
         ;modif sommet
         (progn
           (setq ok T pf (trans pf 1 0) l1 (subst (cons 10 pf) (assoc 10 l1) l1))
           (entmod l1)   (entupd ent)
         )
         (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
       )
     )  ;fin while
   ) ;fin progn
   (progn       ;; pour LWPOLYLINE
     (setq i 9)     
     (while (and (= ok nil) (nth (setq i (+ i 1)) lent))
       (if (= 10 (car (nth i lent)))
         (progn 
           (setq s (cdr (nth i lent)) xs (car s) ys (cadr s))
           (if (and (cvcp xs xp)(cvcp ys yp))
             ;modif sommet
             (progn
               (setq ok T pf (trans pf 1 0) lent (subst (cons 10 pf) (nth i lent) lent))
               (entmod lent)  (entupd ent)
             ) ;fin progn       
           ) ; fin if
         ) ;fin progn     
       ) ; fin if
     )  ;fin while
   ) ;fin progn
 )
)

(defun c:EtirCotRect (/ sel  lent typent p0 p1 p2 p3 p4 p5 p6 M F disetir angetir rect-ok) 
 (setq m:err-ecr *error* *error* err-ecr)
 (setq rect-ok nil)
 (setq sel (entsel "\n  Choix du rectangle  à Modifier :"))
 (setq ent (car sel) lent (entget ent) typent (cdr (assoc 0 lent)))
 (cond
   ((or (= typent "POLYLINE")(= typent "LWPOLYLINE"))
     (redraw ent 3)  
     (setq p0 (cadr sel) p1 (osnap p0 "_endp") p2 (osnap p0 "_mid") ang (angle p1 p2)
       dis (distance p1 p2)  p3 (polar p2 ang dis) 
     )
     (setq x1 (car p1)  y1 (cadr p1)  x3 (car p3)  y3 (cadr p3))    
     ;; trouver 2 autres sommets
     (if (= typent "LWPOLYLINE")
       (progn       
         (setq i 9 ok 0)     
         (while (and (/= ok 3) (nth (setq i (+ i 1)) lent))
           (if (= 10 (car (nth i lent)))
             (progn 
               (setq s (cdr (nth i lent))  xs (car s)  ys  (cadr s))
               (cond 
                 ((and (not (cvcp xs x1)) (not (cvcp ys y1))) (setq F s xF (car s) yF (cadr s) ok (+ ok 1)))                
                 ((and (not (cvcp xs x3)) (not (cvcp ys y3))) (setq M s xM (car s) yM (cadr s) ok (+ ok 1)))      
               )       
             ) ;fin progn     
           ) ; fin if
         )  ;fin while
         ; verification
         (if (and (= ok 2)(or (and (cvcp xF x3) (cvcp yF yM) (cvcp xM x1) (cvcp y1 y3))
           (and (cvcp yF y3) (cvcp xF xM) (cvcp yM y1) (cvcp x1 x3))))
           (setq rect-ok T)
         )
       );fin progn 
     ) 
     (if rect-ok
       (progn         
         (setq p4 (getcorner "\n nouveau sommet :" F)) 
         (if (not p4) (setq p4 (getpoint "\n nouveau sommet:" p1)) )     
         (setq x4 (car p4)   y4  (cadr p4))
         (modif:sommet ent lent typent p1 p4) ;modif 1 er sommet
         ; mise a jour de la liste necessaire pour LWPOLYLIGNE avant modif 2 eme sommet
         (setq lent (entget ent))
         (cond  ((cvcp x3 xF) (setq p6 (list xF y4)))  ((cvcp y3 yF) (setq p6 (list x4 yF))))
         (modif:sommet ent lent typent p3 p6)  ; modif 2 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (cond  ((cvcp xM xF) (setq p5 (list xF y4)))  ((cvcp yM yF) (setq p5 (list x4 yF))))
         (modif:sommet ent lent typent M p5)  ; modif 3 eme sommet
         (setq lent (entget ent)) ; mise a jour
         (setq ent nil)
       )
       (progn
         (setq d1 (distance p0 p1)  d2 (distance p0 p2)) (if (< d1 d2)(setq p2 p1))
         (setq p4 (getpoint "\n nouvelle position du segment:" p2))     
         (setq angetir (angle p2 p4) disetir (distance p2 p4))
         (setq p5 (polar p1 angetir disetir)  p6 (polar p3 angetir disetir))
         (modif:sommet ent lent typent p1 p5) ;modif 1 er sommet
         (setq lent (entget ent)); mise a jour
         (modif:sommet ent lent typent p3 p6) ;modif 2 eme sommet
         (setq ent nil)
       )
     )
   )
   (T (setq ent nil) (prompt "\n * CE N'EST PAS UNE POLYLIGNE * ") (princ))           
 ) 
 (gc)
 (setq *error* m:err-ecr m:err-ecr nil)
 (princ)       
)


(defun rectramber (a b / c d angl_base long angl_haut larg pt h nc)
 (setq m:err *error* *error* er:xbox)
 (setvar "CMDECHO" 0) 
 (setq angl_base (angle a b) long (distance a b) h nil nc nil)
 (if (not hxbox) (setq hxbox long))
 (setq pt nil) ; pour losange
 (grdraw a b -1)
 (initget "Parallelogr Carré Triangle Losange Hexagone")
 (if 
   (setq c (getdist (strcat "\nLargeur ou [Carré/Hexagone/Losange/Parallelogr/Triangle]<"(rtos hxbox 2 4)">:") b))
   (if (and (/= c "Carré")(/= c "Parallelogr")(/= c "Triangle")(/= c "Losange")(/= c "Hexagone"))
     (setq h c hxbox c c nil)
   )
   (setq h hxbox)
 )
 (cond 
   ((= c "Hexagone") (setq c nil nc 6))
   ((= c "Triangle")(setq c (polar b (+ angl_base  pi)(* 0.5 long))))
   ((= c "Losange")(setq c (polar b (+ angl_base  pi)(* 1.5 long))))
   ((= c "Parallelogr")
     (if (not (setq c (getpoint b "\nPoint suivant ou [] : ")))(setq c "Carré"))
   )
   
 )
 (cond  
   ((= c "Carré")
     (setq c (polar b (+ angl_base (* 0.5 pi)) long))
     (setq d (polar a (+ angl_base (* 0.5 pi)) long))
     ;(setq hxbox (abs (- (cadr c)(cadr b))))
   )
   (c  ;; if c     
     (setq angl_haut (angle b c)) (setq ah angl_haut)(setq ab (angle a b)) 
     (cond
       ((= (angtos angl_haut 0 1) (angtos angl_base 0 1))
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c))
         (setq c (polar b (+ angl_base (* 0.5 pi)) larg)) ; replacé à 90°
         (setq d (polar c (+ angl_base pi) long))
       )
       ((or 
           (= (angtos (+ angl_haut pi) 0 1) (angtos angl_base 0 1)) 
           (= (angtos (- angl_haut pi) 0 1) (angtos angl_base 0 1))       
         )
         ;;; orientation incorrecte pour rectangle ou parallèlogr.   
         (setq larg (distance b c) ) 
         (setq c (polar a (+ angl_base (/ pi 3)) long));;; ->triangle équilatéral
         (cond 
           ((> larg long)
             (setq d (polar a (+ angl_base (* 5 (/ pi 3))) long)) ;;-> losange
             ;;permutation des points
             (setq pt c c b b pt)
           )
         )
       )
       (t (setq d (polar c (+ angl_base pi) long))
         (setq hxbox (abs (- (cadr c)(cadr b))))
       )
     ) 
   ) ; if c
   ((and (not c)(not nc) );;; -> rectangle hauteur= hxbox   
     (setq c (polar b (+ angl_base (* 0.5 pi)) hxbox))
     (setq d (polar a (+ angl_base (* 0.5 pi)) hxbox))
     ;(setq hxbox (abs (- (cadr c)(cadr b))))
     
   )     
 )
 (if pt (grdraw a c -1)(grdraw a b -1))     
 (cond 
   ((and a b c d)
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c "_none" d "_c")
     (setvar "plinewid" pw)
   )
   ((and a b c )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b "_none" c  "_c")
     (setvar "plinewid" pw)
   )
   ((and a b nc )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_none" b)
     (repeat (- nc 2)
       (command "_none" (setq b (polar b (setq angl_base (+ angl_base (/ pi (/ nc 2))))long)))
     )
     (command "_c")
     (setvar "plinewid" pw)
   )
 )
 (er:xbox)
)

(defun c:xboxT (/ xa ya xb yb a b tolang angl_base )  
(setvar "CMDECHO" 1) 
 (setq pw (getvar "plinewid")) ; svgd epais polylign
 (setq xa (getvar "lastpoint")) ;pour controle cde rectang
 (setq a "Epaisseur" b nil)
 (while (= a "Epaisseur")
   (initget "Epaisseur éTirer.cotés")
   (setq a (getpoint "\nPremier coin ou [Epaisseur/<éTirer.cotés>]: "))
   (if (= a "éTirer.cotés")(setq a nil))
   (cond
     ((not a)(c:EtirCotRect))
     ((= a "Epaisseur") 
       (if epaisseur_box
         (if (setq b (getdist (strcat "\n Epaisseur du trait <" (rtos epaisseur_box 2 4) ">:")))(setq epaisseur_box b))
         (setq epaisseur_box (getdist "\n Epaisseur du trait:"))
       )
     )
   ) ;cond
 )
 (cond 
   (a
     (command "_rectang" "_t" (getvar "thickness")"_c" "0" "0" "_f" "0" "_w" (if epaisseur_box epaisseur_box 0.0)
     "_none" a  pause)
     (setq b (getvar "LASTPOINT"))
     (if (or (equal a b)(equal xa b)) (setq b nil))
     (if b (entdel (entlast)))
   )
 )
 (cond  
   (b  ;; if b
     (setq tolang 1.0)  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TOLERANCE ANGULAIRE  + ou - 1°
     (setq xa (car a) ya (cadr a) xb (car b) yb (cadr b))
     (setq angl_base (* (angle a b) (/ 180 pi)))
     (cond      
       ((or
           (= angl_base 0.0)
           (or (= angl_base 0.0)(and (< angl_base (+ 0.0 tolang))(> angl_base (- 0.0 tolang)))(> angl_base (- 360.0 tolang)))
           (or (= angl_base 180.0)(and (< angl_base (+ 180.0 tolang))(> angl_base (- 180.0 tolang))))
         )
         (setq b (list xb ya))
         (rectramber a b)
       )              
       ((or
           (or (= angl_base 90.0)(and (< angl_base (+ 90.0 tolang))(> angl_base (- 90.0 tolang))))
           (or (= angl_base 270.0)(and (< angl_base (+ 270.0 tolang))(> angl_base (- 270.0 tolang))))
         )
         (setq b (list xa yb))
         (rectramber a b)
       )
       (t  ;; rectangle par diagonale
         (setq hxbox (abs (- (cadr b)(cadr a))))
         (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
         (command "_PLINE" "_none" a "_none" (list xa yb) "_none" b "_none" (list xb ya) "_c")
         (setvar "plinewid" pw)
       )
     ) 
   )
 )  
 (princ)
)

[Edité le 26/2/2009 par usegomme]

usegomme · le 26 février 2009

Pour Lilian , j'ai intégré ecr.lsp dans xbox et je compte le Tramberiser un peu.

Cde Rectangle couteau suisse

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante