Petits outils 3D (gadgets)

usegomme · le 12 décembre 2011

Bonjour,

j'ai fait quelques petits outils pour la 3D d'un intérêt limité, mais le fait de les faire fonctionner avec le SCU dynamique via la commande SCU ( dans les lisp ), me les a rendus sympathiques aussi je les met en lignes.

Edit: Finalement quelques uns me sont bien utiles et j'agrandie la liste quand j'ai du nouveau.

Rotation référence pour la 3D

Edit: Ajout option copie multiple

;; rotation angle reference
;; fonctionne avec SCU Dyn si actif
;; version 12/12/2011  
;;         27/06/2012
;; 31 07 2012 accepte "m2p" milieu entre 2 points.           
;; usegomme 
(defun c:Rar (/ cp p2 n cm rp p)
 (ssget)
(setvar "CMDECHO" 0)
 
 (prompt "\n Specifiez le Centre de Rotation")
 (command "_ucs" pause )

;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
 (while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

 (command "")
 (setq n 1)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*** FACULTATIF *** 1er option  demande axe X et Y scu 

   (if (= 0 (getvar "ucsdetect"))
    (progn
     (setq n 2)(setvar "CMDECHO" 1)
     (command "_ucs" "_non" '(0. 0. 0.))
     (while (not (zerop (getvar "cmdactive")))(command pause))
    )
   )
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*** FACULTATIF *** 2eme option demande axe Z scu 

;  (if (= 0 (getvar "ucsdetect"))
;   (progn 
;    (setq n 2 p (getpoint '(0. 0. 0.) "\nDirection axe Z ou <valider>: "))
;    (if p (command "_ucs" "_zaxis" "" "_non" p) (setq n 1)) 
;   )
;  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fin options  

(setvar "CMDECHO" 1)
(initget "Copier Multiple")
(setq p2 (getpoint '(0. 0. 0.) "\n Orientation de référence [Copier/Multiple]:"))
(cond
((= p2 "Copier")   (setq cp t cm nil)(setq p2 (getpoint '(0. 0. 0.) "\n Orientation de référence:")))
((= p2 "Multiple") (setq cm 0 cp nil)(setq p2 (getpoint '(0. 0. 0.) "\n Orientation de référence:")))
(t (setq cp nil cm nil))
)
(if (not cm)
(progn 
 (if  cp 
  (command "_rotate" "_p" "" "_non" '(0. 0. 0.) "_c" "_r" "_non" '(0. 0. 0.)) 
  (command "_rotate" "_p" "" "_non" '(0. 0. 0.) "_r" "_non" '(0. 0. 0.))
 )
 (command "_non" p2)
 (while (not (zerop (getvar "cmdactive")))(command pause))
)
)

(while cm
(command "_rotate" "_p" "" "_non" '(0. 0. 0.) "_c" "_r" "_non" '(0. 0. 0.) "_non" p2)
(while (not (zerop (getvar "cmdactive")))(command pause))
(setq cm (1+ cm))
(if (> cm 1)
 (progn
  (initget "Oui Non")
  (setq rp (getkword "\nCopie supplémentaire ?  [Non] <Oui> : "))
  (if (= rp "Non") (setq cm nil))
 )
)
)  

 (repeat n (command "_ucs" "_p"))

 (princ)
)

Un tube avec rayon int et ext ou vis versa.

Re edit, la direction est demandée si scu dyn est inactif

; "cylindre creux" en 3d 
;; fonctionne avec SCU Dyn si actif
;  12/04/12 
;; 31 07 2012 accepte "m2p" milieu entre 2 points.
;     usegomme
(defun c:cyc (/ c1 c2 cy1 cy2 r1 r2 n p)
(setq n 1)
(setvar "CMDECHO" 0)
(prompt "\n Specifiez le point d'insertion")
(command "_ucs" pause) 

;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
(while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

(command "")
(if (= 0 (getvar "ucsdetect"))
  (progn 
   (setq n 2 p (getpoint '(0. 0. 0.) "\nDirection ou <valider>: "))
   (if p (command "_ucs" "_zaxis" "" "_non" p) (setq n 1)) 
  )
)
(setvar "cmdecho" 1) 
(command "_circle" "_non" '(0. 0. 0.))
(while (not (zerop (getvar "cmdactive")))(command pause))
(setq c1 (entlast)  r1 (cdr (assoc 40 (entget c1))))
(command "_circle" "_non" '(0. 0. 0.))
(while (not (zerop (getvar "cmdactive")))(command pause))
(setq c2 (entlast) r2 (cdr (assoc 40 (entget c2))))
(command "_extrude" c2 "")
(while (not (zerop (getvar "cmdactive")))(command pause))
(setq cy2 (entlast))
(command "_extrude" c1 "" "")
(setq cy1 (entlast))
(if (> r1 r2)
 (command "_subtract" cy1 "" cy2 "")
 (command "_subtract" cy2 "" cy1 "")
)
(repeat n (command "_ucs" "_p"))

(princ)
)))

Edit : simplifier, les options de la commande cylindre sont utilisables

;; Percer un ou plusieurs solides
;; fonctionne avec SCU Dyn si actif
;;Usegomme
;; 27-02-2012
(defun c:percer (/ solides cyl n)
 (princ " Sélectionnez les solides à percer.")
 (setq solides (ssget '((0 . "3DSOLID"))))
 (cond
  (solides
   (setvar "cmdecho" 1)
   (command "_cylinder" )
   (while (not (zerop (getvar "cmdactive")))(command pause))
   (setq cyl (entlast))
   (repeat (setq n (sslength solides))
     (cond
((> n 1) (command "_copy" cyl "" "" "")
        (command "_subtract" (ssname solides (setq n (1- n))) "" "_last" "")
       )
(t  (command "_subtract" (ssname solides (1- n)) "" cyl ""))
     )
   )
   
   (princ)
 )
)  
)

usegomme · le 12 décembre 2011

Une version de XBOX.lsp pour crée des solides

Edit 31 07 2012, quelques modifications (améliorations) pour essayer d'en faire un peu plus qu'un gadget.

;; XBT  ;; XBoite 3D
;; fonctionne avec SCU Dyn si actif
;; Variante de XBOX.lsp  2D
;; dessine rectangle par diagonale et si a et b horiz ou vertical, rectangle,carré,triangle équilatéral,losange équil.
;; selon orientation et position du 3 eme point ou selon l'option choisie
;; la ligne de construction est une ligne normale pour pouvoir se raccrocher dessus .
;; Si point 3 = point 2 -> carré
;; Si point 3 = point 1 -> hexagone
;; si sur la même ligne ordre pts 1 2 3 -> rectangle 
;; si sur la même ligne ordre pts 1 3 2 -> triangle
;; si sur la même ligne ordre pts 3 1 2 -> losange

;; usegomme
;;  06 03 2012  parallèlogramme supprimé
;;  08 03 2012  ortho (shift) permet d'aligner le 2em point sur un point décalé sans tracé boite, svt le coté le plus long (correction 02 06)
;;              ortho et polaire désactivé -> commande "boite" standart pour diagonale 3D
;;  10 04 2012  démarrage avec mode polaire actif
;;  31 05 2012  SI touche shift maintenu lors du premier point -> commande "boite" standart pour diagonale 3D
;;  31 07 2012 accepte "m2p" milieu entre 2 points.

(defun c:XBt  (/ lp xa ya xb yb a b tolang angl_base long dg n ud boite er:xbt cvcp rectxbt)

(defun er:xbt (msg)
 (if n (repeat n (command "_ucs" "_p")))
 (if pw (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 rectxbt (a b / c d angl_base long angl_haut larg nc tpz)    
 (setvar "CMDECHO" 0) 
 (setq angl_base (angle a b ) long (distance a b ) tpz nil nc nil)
 (if (not hxbox) (setq hxbox long))
 (command "_line" "_none" a "_none" b "" )  ; ligne de construction remplace grdraw
 (initget "Polygone Carré tRiangle Losange Hexagone Trapèze")
 (setq c (getpoint (strcat "\nLargeur ou [Trapèze/Polygone/Hexagone/Carré/Losange/tRiangle] <"(rtos hxbox 2 4)"> :") b ))
 (cond
   ((= c "Carré") (setq c nil nc 4))
   ((= 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 "Polygone") (setq c nil)
     (if (not (setq nc (getint "\nNombre de cotés ou <5>]: "))) (setq nc 5))
   )
   ((= c "Trapèze") (setq c nil)
     (if (not (setq tpz (getpoint b "\n3eme sommet du trapèze ou <auto>]: " )))
       (setq tpz (polar b (+ angl_base (/ pi 1.5)) (* 0.5 long)))
     )
   )
   ((equal c a) (setq c nil nc 6))      ;;; Hexagone  pt c = pt a
 )
 (entdel (entlast))
 (if c
   (if (and (= (rtos (car b ) 2 2) (rtos (car c) 2 2))   ;;; carré  pt c = pt b
       (= (rtos (cadr b ) 2 2) (rtos (cadr c) 2 2))
     )
     (setq c nil nc 4)
   )
 )
 (cond  
   ((and (not c)(not nc)(not tpz) );;; -> 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 ))))
   )
   ((and (not c)(not nc) tpz );;; -> trapèze 
     (setq c tpz)
     (setq d (polar a (- (+ pi (* 2 (angle a b ))) (angle b c )) (distance b c )))
   )
   (c  ;; if c     
     (setq angl_haut (angle b c )) (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 pt nil)
           )
         )
       )
       (t ;; rectangle ou parallèlogr. depuis 3 pts

        ; (setq d (polar c (+ angl_base pi) long)) 
        ;  (setq hxbox (abs (- (cadr c)(cadr b ))))
 ;(if (or (= angl_haut 0.0) (= angl_haut pi)(= angl_haut (* 0.5 pi)) (= angl_haut (* 1.5 pi))) (setq dg c)) ;;  -> faire rectangle avec _box

               ; parallèlogramme changé en rectangle  ;; 06 03 12 
          (if (= (cadr a) (cadr B))       
             (progn (setq c (list (car b ) (cadr c ))) (setq d (list (car a ) (cadr c ))) (setq hxbox (abs (- (cadr c)(cadr b )))) )
             (progn (setq c (list (car c ) (cadr b ))) (setq d (list (car c ) (cadr a ))) (setq hxbox (abs (- (car c)(car b )))) )
           )
           (setq dg c ) ;;  -> faire rectangle avec _box ; 06 03 12
               ;;;;

       )
     ) 
   ) ; fin if c
 )
 (cond 
   ((and a b c d)
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_non" a "_non" b "_non" c "_non" d "_c")
     (setvar "plinewid" pw)
   )
   ((and a b c )
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_none" a "_non" b "_non" c  "_c")
     (setvar "plinewid" pw)
   )
   ((and a b nc ) (if (< nc 3) (setq nc 3)) (setq xnc nc)
     (if epaisseur_box (setvar "plinewid" epaisseur_box)(setvar "plinewid" 0))
     (command "_PLINE" "_non" a "_non" b ) 
     (repeat (- nc 2)
       (command "_non" (setq b (polar b (setq angl_base (+ angl_base (/ (* 2 pi) nc))) long)))
     )
     (command "_c")
     (setvar "plinewid" pw)
   )
 )
 (setvar "CMDECHO" 1)
) 
;;; fin defun rectxbt


;;;; *** début  defun c:XBt *** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (setq m:err *error* *error* er:xbt dg nil boite nil)
 (setvar "CMDECHO" 0)
 (cond
   ((<= (getvar "autosnap") 39) (setvar "autosnap" 47))
   ((=  55 (getvar "autosnap")) (setvar "autosnap" 63))
 )
 (prompt "\n Specifiez le Point de départ")
 (command "_ucs" pause )
 
;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
 (while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

 (command "")
 (setq n 1)
 (if (= 1 (getvar "orthomode"))(setq boite t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  1er option  demande axe X et Y scu *** FACULTATIVE ***

 (if (/= 1 (getvar "orthomode"))
   (if (= 0 (getvar "ucsdetect"))
    (progn
     (setq n 2)(setvar "CMDECHO" 1)
     (command "_ucs" "_non" '(0. 0. 0.))
     (while (not (zerop (getvar "cmdactive")))(command pause))
    )
   )
 )
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2eme option demande axe Z scu  *** FACULTATIVE ***
 
; (if (/= 1 (getvar "orthomode"))  
;  (if (= 0 (getvar "ucsdetect"))
;   (progn 
;    (setq n 2)
;    (prompt "\n Direction <>")
;    (command "_ucs" "_zaxis" "" pause)
;   )
;  )
; ) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fin options
 
(setvar "cmdecho" 1) 
(cond
 (boite (command "_BOX" "_non" '(0. 0. 0.))(while (not (zerop (getvar "cmdactive")))(command pause)))
 (t
;;;******
 (setq pw (getvar "plinewid")  ; svgd epais polylign
       lp (getvar "lastpoint") ;pour controle cde rectang
       ud (getvar "UCSDETECT")  
 )
 (setvar "UCSDETECT" 0)

 (setq a '(0. 0. 0.))
 
 (cond
   ((and (= (getvar "orthomode") 0 )
     (or (<= (getvar "autosnap") 39) (= (getvar "autosnap") 55 ))	  
    )	  
    (command "_box" "_non" '(0. 0. 0.))(while (not (zerop (getvar "cmdactive")))(command pause))	  
   )	
   (t
     (setvar "CMDECHO" 0)
     (command "_rectang" "_t" (getvar "thickness")"_c" "0" "0" "_f" "0" "_w" (if epaisseur_box epaisseur_box 0.0) "_non" a )
     (if (> (atof (substr (getvar "ACADVER")1 4)) 16.1)  ;; ok si supérieur à autocad 2005
       (command  "_r" "0" )   
     )
     (prompt "\n Specifiez le 2eme sommet")
     (while (not (zerop (getvar "cmdactive")))(command pause))
     (setq b (getvar "LASTPOINT"))
     (if (or (equal a b )(equal lp b )) (setq b nil))   
     (if b (entdel (entlast)))
     (setvar "CMDECHO" 1)
   )
 )
;;;;;*********
  )
 )
  
 (cond  
   (b  ;; if b
     (setq tolang 1.5)  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TOLERANCE ANGULAIRE  + ou - 1,5°
     (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))
         (rectxbt a b )
  (cond                 ;;;; la commande BOX crée un solide avec toutes les poignées mieux qu' EXTRUDE
    (dg (entdel (entlast))(command "_BOX" "_non" a  "_non" dg)(while (not (zerop (getvar "cmdactive")))(command pause)))
    (t (command "_.extrude" "_last" "") (while (not (zerop (getvar "cmdactive")))(command pause)))
  )  
       )              
       ((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 ))
         (rectxbt a b )
  (cond 
    (dg (entdel (entlast))(command "_BOX" "_non" a  "_non" dg)(while (not (zerop (getvar "cmdactive")))(command pause)))
    (t (command "_.extrude" "_last" "") (while (not (zerop (getvar "cmdactive")))(command pause)))
  )
       )
       ((= 1 (getvar "orthomode"))  ;; 08 03 12
         (setq b (if (> xb yb) (list xb ya ) (list xa yb ))) (rectxbt a b )
   
  (cond 
    (dg (entdel (entlast))(command "_BOX" "_non" a  "_non" dg)(while (not (zerop (getvar "cmdactive")))(command pause)))
    (t (command "_.extrude" "_last" "") (while (not (zerop (getvar "cmdactive")))(command pause)))
  )
       )
       (t  ;; rectangle par diagonale
        (setq hxbox (abs (- (cadr b )(cadr a))))
 (command "_BOX" "_non" a  "_non" b )(while (not (zerop (getvar "cmdactive")))(command pause))
       )
     )
   )
 )
 
 (repeat n (command "_ucs" "_p"))
 (if pw (setvar "plinewid" pw))
 (if ud (setvar "UCSDETECT" ud))
 (setq *error* m:err m:err nil)
 (princ)
)

usegomme · le 16 décembre 2011

Bonjour, je veux juste signaler que j'ai remplacé trou.lsp par percer.lsp qui peut percer plusieurs "solides" en une seule passe, pourvu que les perçages soient sur le même axe.

usegomme · le 30 janvier 2012

Un petit lisp qui est parfois bien pratique pour ajuster des solides entre eux, sans pour autant supprimer les éléments soustraits.

;; Soustraire, sans les effacer, des solides à d'autres solides
;; Usegomme
;; 30-01-2012

(defun c:as (/ saa ce sas csas n elast)   ;; -> as = "ajuster" solides

 
 (princ " Sélectionnez les solides à ajuster.")
 (setq saa (ssget '((0 . "3DSOLID"))))

 (princ " Sélectionnez les solides à soustraire :")
 (setq sas (ssget '((0 . "3DSOLID"))))


 (cond
  ((and saa sas) 
   (setq elast (entlast))
   (repeat (setq n (sslength saa))    
 (command "_copy" sas "" "" "")

        (setq  csas nil csas (ssadd))
        (while (entnext elast)
         (ssadd (entnext elast) csas)
         (setq elast (entnext elast))
        )

        (command "_subtract" (ssname saa (setq n (1- n))) "" csas "")       
   )
   (princ)
 )
)  
)

usegomme · le 2 février 2012

J'ai trouvé fastidieuse la cde chanfrein pour couper les coins des ailes d'un fer aussi je me suis essayé avec cette routine qui permet de couper les 2 ailes en même temps et également plusieurs fers ou solides en même temps quand ils sont dans le même alignement.

On peut laisser les écarts à 0 et donner la distance en même temps que la direction.

Si le 1er écart est défini, la coupe à 45° et les fers orientés orthogonalement, il n'est pas utile d'indiquer de quel coté.

;; chanfreiner des solides 
;; Usegomme
;; 02/02/2012
(defun c:cfr (/ p ph solides d s c px py ax ay )  

(if (not ec1) (setq ec1 0 ec2 0 hcfr 1000)) ;; valeurs par défaut 
(princ " Sélectionnez les solides à chanfreiner :")
(setq solides (ssget '((0 . "3DSOLID")))) 

(while (not p)
 (setq p (getpoint (strcat "\n Point de départ chanfrein " (rtos ec1 2 4)" x "(rtos ec2 2 4)" ou <Ecarts>:")))
 (if (not p)
  (progn
   (setq d (getdist (strcat "\n Ecart1 <"(rtos ec1 2 4)">:"))) (if d (setq ec1 d )) (if (= ec2 0) (setq ec2 ec1))
   (if (= ec1 0) (setq ec2 0) (progn (setq d (getdist (strcat "\n Ecart2 <"(rtos ec2 2 4)">:"))) (if d (setq ec2 d ))))
  )
 )
)
(if (> hcfr 0)
 (setq ph (getpoint p (strcat  "\n Direction et Hauteur du solide(s) à couper : <" (rtos hcfr 2 4) ">")))
 (setq ph (getpoint p "\n Direction et Hauteur du solide(s) à couper :"))
) 
(if ph (setq hcfr (distance p ph))) 
(cond
   ((and p ph) (command "_ucs" "_zaxis" "_non" p "_non" ph)(setq p '(0. 0. 0.)))
   ((and p (> hcfr 0)) (command "_ucs" "_non" p "")(setq p '(0. 0. 0.)))
   (t (setq p nil) (exit))
)

(if (and (> ec1 0) (> ec2 0))
(progn
 (setq px (getpoint p (strcat "\n Orient coté chanfrein = "(rtos ec1 2 4)" <égal & ortho>:")))
 (if px  (setq  ax (angle p px) py (getpoint p (strcat "\n orient 2eme coté chanfr = "(rtos ec2 2 4)" <ou  "(rtos ec1 2 4)">:"))))
 (if py (setq  ay (angle p py)))

(if (and ax ay)
  (command "_PLINE" "_non" p "_non" (polar p ax ec1) "_non" (polar p ay ec2) "_c")
  (progn
    (if (not ax)(setq ax 0))
    (command "_PLINE" "_non" (polar p ax ec1 ))
    (repeat 3
       (command "_non" (polar p (setq ax (+ ax (* 0.5 pi))) ec1 ))
    )
    (command "_c")
  )
)
)
(progn   ;;; dimensions non définies 0x0, la longueur à couper est redemandée chaque fois
  (setq px (getpoint p "\n 1er coté Direction et Longueur à couper :"))
  (setq py (getpoint p "\n 2eme coté Direction et Longueur à couper :"))
  (if (and px py) (command "_PLINE" "_non" p "_non" px "_non" py "_c")
    (progn (command "_ucs" "_p") (exit))
  )
)
)

(if (= 0 (getvar "delobj")) (setq c (entlast)) (setq c nil))
(command "_.extrude" "_last" "" hcfr )
(if c (entdel c))
 
(setq s (entlast))
  (repeat (setq n (sslength solides))
     (cond
((> n 1) (command "_copy" s "" "" "")
        (command "_subtract" (ssname solides (setq n (1- n ))) "" "_last" "")
       )
(t  (command "_subtract" (ssname solides (1- n )) "" s ""))
     )
   )
(if p (command "_ucs" "_p"))
(princ)
)

usegomme · le 27 février 2012

Cotation de niveau en 3D dans espace objet.

Edit: nouvelle version, n'est plus utilisable en mode coordonnée

mais redresse automatiquement l'axe Y est indique correctement en 3D

les niveaux + ou - , j'avais mal testé la version précédente.

;; Pour mettre des cotes de niveau dans l'ESPACE OBJET
;; le 06 04 2012 
;; Usegomme

(defun c:cotniv (/ p ydir yp lent n)
(setq ydir (getvar "ucsydir") n t)
;;; orientation axe y à la verticale si besoin
(cond
 ((= 1.0 (nth 2 ydir)) (setq n nil))
 ((= -1.0 (nth 2 ydir)) (command "_ucs" "_x" "180"))
 ((= -1.0 (nth 1 ydir)) (command "_ucs" "_x" "270"))
 ((or (= 1.0 (nth 1 ydir))(= 1.0 (nth 0 ydir))(= -1.0 (nth 0 ydir)))(command "_ucs" "_x" "90"))
)

(setq p (getpoint "\n point à coter :"))
(setq yp (nth 1 p))
(command "_ucs" (list 0 0 (nth 2 p)) "") 
(command "_dimordinate" "_non" (list (nth 0 p) (nth 1 p) 0))
(while (not (zerop (getvar "cmdactive")))(command pause))
(command "_ucs" "_p")
(setq lent  (entget (entlast)))     
 
(if (< yp 0)
  (entmod (setq lent (subst (cons 1 "EL -<>") (assoc 1 lent) lent )))   ; <-- Ici préfixe cotation modifiable
  (entmod (setq lent (subst (cons 1 "EL +<>") (assoc 1 lent) lent )))   ; <-- Ici préfixe cotation modifiable
)
(if n (command "_ucs" "_p"))

(princ)
)

usegomme · le 27 février 2012

Cotation linéaire 3d dans l'espace objet.

Edit: nouvelle version 11 04 2012

;; Pour mettre des cotes linéaires dans l'ESPACE OBJET
;; Pour la bonne orientation du texte la cotation se fait de gauche à droite (sauf cotes verticales)
;; si le SCU DYNAMIQUE est INACTIF
;;   l'axe Y est automatiquement orienté vers le haut (Z)
;;   les cotes pivotent autour de l'axe Y suivant l'orientation du 2eme point.
;;   les cotes verticales se placent selon l'axe X à régler manuellement avant de coter
;;
;, si le SCU DYNAMIQUE est ACTIF
;;   les cotes sont dans le plan XY ou dans le plan YZ

;; 11 04 2012
;; usegomme

(defun c:cot3d (/ n p2 p2_scg ydir) 
(setvar "CMDECHO" 0)
 (prompt "\n Specifiez le Point de départ")
 (command "_ucs" pause "")
 (setq n 1) ;; nombre chg scu
 (setvar "CMDECHO" 1)
 (if (= 0 (getvar "UCSDETECT"))
     (progn
      (setq ydir (getvar "ucsydir") n (1+ n))
       ;;; orientation axe y à la verticale si besoin
      (cond
       ((= 1.0 (nth 2 ydir)) (setq n (1- n)))
       ((= -1.0 (nth 2 ydir)) (command "_ucs" "_x" "180"))
       ((= -1.0 (nth 1 ydir)) (command "_ucs" "_x" "270"))
       ((or (= 1.0 (nth 1 ydir))(= 1.0 (nth 0 ydir))(= -1.0 (nth 0 ydir)))(command "_ucs" "_x" "90"))
      ) 
;;;;
      (setq p2 (getpoint '(0. 0. 0.) "\n 2eme point:"))
      (setq p2_scg (trans p2 1 0))
      (if (and (equal 0 (nth 0 p2) 0.001) (equal 0 (nth 2 p2) 0.001))  ;; vertical
() ;; pas de changement de scu
       (progn
        (command "_ucs" "_non" '(0. 0. 0.) "_non" (list (nth 0 p2) 0 (nth 2 p2)) "") (setq n (1+ n))
        (if (=  (nth 2 (getvar "ucsydir")) -1.0) (progn (command "_ucs" "_x" "180") (setq n (1+ n))))
       )
      )	  
     )
    ;;;;;;; scu dyn actif      
     (progn  
      (setq p2 (getpoint '(0. 0. 0.) "\n 2eme point:"))
      (setq p2_scg (trans p2 1 0))
      (cond 
        ((and (equal 0.0 (nth 0 p2) 0.01) (< 0 (nth 2 p2)))
          (command "_ucs" "_y" "90") (setq n (1+ n))
        )
        ((and (equal 0.0 (nth 0 p2) 0.01) (> 0 (nth 2 p2)))
          (command "_ucs" "_y" "270") (setq n (1+ n))
        )
      )
     )
 )
 
 (command "_dimlinear" "_non" '(0. 0. 0.) "_non" (trans p2_scg 0 1))
 (while (not (zerop (getvar "cmdactive")))(command pause))
 (repeat n (command "_ucs" "_p"))

(princ)
)

usegomme · le 27 février 2012

Arc 3D via accrochage 3 points

dans forum autocad 11 que je remet ici pour ceux qui l'auraient loupé.

;; Arc 3 D (atd) en 3 points
;;Usegomme
;;01 02 2012

(defun c:atd (/ p1 p2 p3 p2_SCG p3_SCG)
(setq p1 (getpoint "\n Point de départ de l'arc:"))
(setq p2 (getpoint p1 "\n 2eme point:"))
(setq p3 (getpoint p2 "\n 3eme point:"))
(setq p2_SCG (trans p2 1 0))
(setq p3_SCG (trans p3 1 0))
(command "_.ucs" "_non" p1 "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
(command "_.arc" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
;; (command "_.ucs" "_P")
(princ)
)

et

;; Cercle 3 D en 3 points
;;usegomme
;;01 02 2012
(defun c:ctd (/ p1 p2 p3 p2_SCG p3_SCG)
(setq p1 (getpoint "\n Cercle par 3 pts, 1er point:"))
(setq p2 (getpoint p1 "\n 2eme point:"))
(setq p3 (getpoint p2 "\n 3eme point:"))
(setq p2_SCG (trans p2 1 0))
(setq p3_SCG (trans p3 1 0))
(command "_.ucs" "_non" p1 "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
(command "_.circle" "_3p" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
;; (command "_.ucs" "_P")
(princ)
)

usegomme · le 4 avril 2012

Une petites routines pour connaitre le poids total, pour de l'acier, des solides sélectionnés et aussi leurs volumes en litres.

Le code en vlisp est d'origine cadxp.

;;;; Poids solide(s) 3 d en Kg d'acier
;;;  et volume en litre
;;;  version 04 04 2012
;;; Usegomme

(defun c:poids (/ js i ent vl_ent vol poids  )   
(vl-load-com)
(setq js (ssget) vol 0.0 i 0 )
 (repeat (sslength js)
  (setq ent (ssname js i) i (+ i 1))  
  (setq vl_ent (vlax-ename->vla-object ent))        
  (if (= (vla-get-ObjectName vl_ent) "AcDb3dSolid")
    (setq vol (+ vol (vla-get-Volume vl_ent)))	                
  )
 )
 
(setq	   
          vol ( * vol 0.000001)  ;;;  en dm3
   poids (* vol 7.85)     ;;; poids Acier
   poids (strcat "Si Acier Poids = " (rtos poids 2 3) " Kg")
          vol (strcat "Volume = " (rtos vol 2 3) " litres  ")
)
(princ vol) (princ poids)  
(alert poids) (prin1)
)

usegomme · le 12 avril 2012

Un gadget de plus que j'aime bien pour tracer et placer des platines rectangulaires.

On donne le point de base (au centre de la face inférieure) et la direction Z.

La modif des dimensions est optionnelle (faire Espace ou Entrée pour y accéder)

;;version 02 03 2012
;;        25 06 2012
;; Usegomme
(defun c:platine (/ p d n)  

(if (not (and lgx lgy lgz))  (setq lgx 400 lgy 400 lgz 20)) ;; valeur par défaut 

(while (not p)
 (setq p (getpoint (strcat "\n platine " (rtos lgx 2 4)"x"(rtos lgy 2 4)"x"(rtos lgz 2 4)",  Point de départ: <ou modifier dimensions>")))
 (if (not p)
  (progn
   (setq d (getdist (strcat "\n longueur <"(rtos lgx 2 4)">:"))) (if d (setq lgx d ))
   (setq d (getdist (strcat "\n largeur <"(rtos lgy 2 4)">:"))) (if d (setq lgy d ))
   (setq d (getdist (strcat "\n hauteur <"(rtos lgz 2 4)">:"))) (if d (setq lgz d ))
  )
 )
)

 (if p
  (progn
   (setvar "CMDECHO" 0) (setq n 2)
   (command "_ucs" "_non" p "")
   (setq p (getpoint '(0. 0. 0.) "\n Direction <>"))
   
   (if p (command "_ucs" "_zaxis" "" "_non" p) (setq n 1))

   (command "_box"  "_non" (list (* -1 (/ lgx 2)) (* -1 (/ lgy 2))) "_non" (list  (/ lgx 2)(/ lgy 2) lgz ))

   (repeat n (command "_ucs" "_p"))
   (setvar "CMDECHO" 1)

  )
 )    
  
(princ)
)

usegomme · le 15 avril 2012

Lisp supprimé

usegomme · le 10 mai 2012

J'ai remplacé le lisp au dessus qui n'était pas bien par celui ci-dessous.

C'est une commande rotation 3D qui me semble mieux que celle d'Autocad.

Comme point de départ de l'angle de rotation éviter de prendre la verticale sinon

il faudra donner un point supplémentaire pour indiquer de quel coté tourner.

;; rotation 3d
;; ok avec scu dynamique  
;; 10 05 2012      
;; usegomme
;; <rotation // XY> rotation classique parallèle au plan XY mais avec référence, accés par espace ou entrée
;; modif 11 05 2012 la verticale est relative à l'axe Z
;; 31 07 2012 accepte "m2p" milieu entre 2 points.
;; 23 11 2012 options copier et axe + gestion erreur selon (gile)

(defun c:rz (/ js n p2 p2_SCG p3 p3_SCG ud uf *error* c i)
(defun *error* (msg) 
 (if n (repeat n (command "_ucs" "_p")))
 (setvar "UCSDETECT" ud)
 (if (= 1 uf) (setvar "UCSFOLLOW" 1))
 (setvar "cmdecho" 1)
 (princ)
)

(setq js (ssget) n 1 i 0 ud (getvar "UCSDETECT") uf (getvar "UCSFOLLOW"))
(setvar "CMDECHO" 0)(if (= 1 uf) (setvar "UCSFOLLOW" 0))	   
(prompt "\n Centre de Rotation: ")	   
(command "_ucs" pause )

;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
(while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

(command "")
(setvar "UCSDETECT" 0)
(while (or (= p2 "Copier") (= p2 "Axe") (= i 0))
 (setq i 1)
 (initget "Copier Axe")
 (setq p2 (getpoint '(0. 0. 0.) "\nPoint de référence pour basculement [Copier/Axe] ou <rotation // XY>:"))
 (if (= p2 "Copier") (setq c t))
 (if (= p2 "Axe")(progn (setvar "CMDECHO" 1) (command "_ucs" "_zaxis" "" pause) (setvar "CMDECHO" 0) (setq n (1+ n)))) 
)

(cond 
 (p2 (setq p2_SCG (trans p2 1 0))
  (if (and (equal 0 (nth 0 p2) 0.001) (equal 0 (nth 1 p2) 0.001))
   (progn  
    (setq p3 (getpoint '(0. 0. 0.) "\n Rotation de quel coté hors axe Z ?:"))
     (while (and (equal 0  (nth 0 p3) 0.001) (equal 0  (nth 1 p3) 0.001))
       (setq p3 (getpoint '(0. 0. 0.) "\n***INCORRECT*** Rotation de quel coté hors axe Z ?:"))
     ) 
    (setq p3_SCG (trans p3 1 0))
    (command "_.ucs" "_non" '(0. 0. 0.) "_non" (list (nth 0 (trans p3_SCG 0 1 )) (nth 1 (trans p3_SCG 0 1 )) 0) "" )
    (command "_ucs" "_x" "90") (setq n (+ 2 n))
   )
   (progn 
    (command "_.ucs" "_non" '(0. 0. 0.) "_non" (list (nth 0 (trans p2_SCG 0 1 )) (nth 1 (trans p2_SCG 0 1 )) 0) "" )
    (command "_ucs" "_x" "90") (setq n (+ 2 n))
   )
  )  
 
  (setvar "CMDECHO" 1)
  (if c
   (command "_rotate" js "" "_non" '(0. 0. 0.) "_c" "_ref"  "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ))
   (command "_rotate" js "" "_non" '(0. 0. 0.) "_ref"  "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ))
  )
  (while (not (zerop (getvar "cmdactive")))(command pause))
 ) 

(t
  (setvar "CMDECHO" 1) 
  (if c
   (progn (command "_rotate" js "" "_non" '(0. 0. 0.)"_c"  "_ref" "_non" "@")(while (not (zerop (getvar "cmdactive")))(command pause)))
   (progn (command "_rotate" js "" "_non" '(0. 0. 0.) "_ref" "_non" "@")(while (not (zerop (getvar "cmdactive")))(command pause)))
  )
)
)
 (*error* nil)
)

usegomme · le 26 mai 2012

Un essai de commande aligner 3d, mais par 2 points + une rotation.

Il y a aussi une option "copier".

Chez moi ça marche bien sauf quand la mémoire "graphique" sature dans ce cas le point d'insertion est "out".

;; Alignement objets  sur 2 points 3D et rotation
;; 26 05 2012
;; 12 12 2012 amélioration gestion erreur
;; usegomme

(defun c:az (/ js ns elast p0 p n o_SCG p_SCG c eraz uf)
(defun eraz (msg)
 (if n (repeat n (command "_ucs" "_p")))
 (setvar "UCSFOLLOW" uf)
 (setvar "cmdecho" 1)
 (setq *error* m:err m:err nil)
 (princ)
)
(setq m:err *error* *error* eraz)
(setvar "CMDECHO" 0)
(setq js (ssget) n 0 elast (entlast) uf (getvar "UCSFOLLOW"))
(if (= 1 uf) (setvar "UCSFOLLOW" 0))
(command "_ucs" "") ;;; SCU général
(setq n (1+ n)) 
(initget "Copier")
(setq p0 (getpoint "\n Point de base [Copier]: "))
(if (= p0 "Copier") (progn (setq c t)(setq p0 (getpoint "\n Point de base: ")))(setq c nil))
(setq p (getpoint p0 "\n Orientation de référence :"))
(setq p_SCG (trans p 1 0))
(command "_ucs" "_non" p0 "_non" (trans p_SCG 0 1) "")
(setq n (1+ n))   
(command "_copybase" "_non" '(0. 0. 0.) js "")
(setq o_SCG (trans '(0. 0. 0.) 1 0))
(command "_ucs" "") ;;; SCU général
(setq n (1+ n))
(setq p (getpoint o_SCG "\nNouveau point d'origine <concerver>:"))
(if p (command "_ucs" "_non" p "")(command "_ucs" "_non" o_SCG ""))
(setq n (1+ n))
(setq p (getpoint '(0. 0. 0.) "\nNouvelle orientation <concerver>:"))
(if p (progn (command "_ucs" "_non" '(0. 0. 0.) "_non" p "")(setq n (1+ n))))
(command "_pasteclip" "_non"  '(0. 0. 0.))
(setq  ns nil ns (ssadd))
 (while (entnext elast)
   (ssadd (entnext elast) ns)
   (setq elast (entnext elast))
 )
(command "_ucs" "_x" "90") (setq n (1+ n))
(command "_ucs" "_y" "90") (setq n (1+ n))

(setvar "CMDECHO" 1)
(command "_rotate" ns "" "_non" '(0. 0. 0.))(while (not (zerop (getvar "cmdactive")))(command pause))
(setvar "CMDECHO" 0)
(if (not c)(command "_erase" js ""))
(command "_select" ns "") ;; pour mémoriser la dernière sélection
(repeat n (command "_ucs" "_p"))
(setq *error* m:err m:err nil)
(if (= 1 uf) (setvar "UCSFOLLOW" 1))
(setvar "CMDECHO" 1)
(princ) 
)

usegomme · le 6 juin 2012

Un petit gadget de + pour couper depuis un point de référence et avec un angle, on fait pareil avec les accrochages temporaires mais j'ai souvent des difficultés avec mon autocad en 3d, et d'autre part la routine redéfinie un plan scu ce qui donne un petit avantage.

;; section de solides 3d par deux points depuis un point de référence
;; définissant un plan xy et un angle de coupe sur ce plan.
;; les 3 points ne doivent pas être alignés
;; SCU dynamique utilisable
;; SEA -> SEction Angle (prononcer "scie")
;; section objet(s) suivant angle p2 p3
;; usegomme
;; 10 04 2012
;; 18 06 2012 coupe sans le pt de référence
;; 31 07 2012 accepte "m2p" milieu entre 2 points.

(defun c:SEA (/ js p2 p3 p2_SCG p3_SCG)
 (prompt "\n Sélectionner les Objets à Couper")
 (setq js (ssget))
 (if js (progn
  (setvar "CMDECHO" 0)	   
  (prompt "\n Point de référence HORS AXE DE COUPE ou 1er pt de C: ")	   
  (command "_ucs" pause )
 
;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
  (while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

  (command "")
  (setq p2 (getpoint '(0. 0. 0.) "\n Point sur l'axe de coupe :"))  
  (setq p3 (getpoint p2 "\n Point suivant sur l'axe de coupe <Terminer>:"))
  (if p3 (progn
    (setq p2_SCG (trans p2 1 0))
    (setq p3_SCG (trans p3 1 0))
    (grdraw p2 p3 -1)
    (command "_.ucs" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
    (setvar "CMDECHO" 1)
    (command "_.slice"  js "" "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 ))
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (setvar "CMDECHO" 0)
    (command "_.ucs" "_P")
    (grdraw p2 p3 -1)
   )
   (progn
    (setvar "CMDECHO" 1)
    (grdraw '(0. 0. 0.) p2 -1)
    (command "_.slice"  js "" "_non" '(0. 0. 0.) "_non" p2)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (grdraw '(0. 0. 0.) p2 -1)
    (setvar "CMDECHO" 0)
   )
  )
  (command "_.ucs" "_P")
  (setvar "CMDECHO" 1)
 ))  
 (princ)
)

usegomme · le 7 juin 2012

Un autre petit lisp pour couper les solides 3D, mais pas gadget cette fois,

pour les coupures de ce genre : avant _______________

.................................................: aprés _____.........._____

C'est un bricolage à utiliser suivant la bonne méthode pour ne pas retrouver des solides superposés.

Comme j'aime les raccourcis clavier, il s'appelle CS (coupure solide).

;; Coupe une partie "centrale" des solides sélectionnés
;; ou au choix un coté, et cela pour toute la sélection.
;; il ne peut pas y avoir de mix dans la même opération.
;; IMPORTANT: Le ou les points de COUPURE finaux ne doivent pas se situer aux extrémités
;; ou en dehors des solides à couper en coordonnée X du scu défini par les deux premiers points,
;; les positions en Y ou Z non pas d'importances.
;; UNE MAUVAISE EXECUTION LAISSE DES DOUBLONS DES SOLIDES.

;; le deuxième point est demandé 2 fois, la 2eme fois est pour valider (par espace ou entrée) ou
;; pour le redéfinir (mais pas la direction) et permet aussi de redéfinir le premier point.
;; si la valeur X de p2 (2eme définitions) est inférieure à la valeur X de p1 alors la partie du solide
;; située coté p1 est supprimée comme avec l'usage classique de la commande SECTION.

;; En pratique on coupe directement avec les deux premiers points
;; ou bien on indique une direction et on coupe avec 1 ou 2 points supplémentaires pris sur des repères.
;; La ou les coupes étant toujours perpendiculaire à la direction de l'axe des X.

;; usegomme
;; 24 05 2012
;; 31 07 2012 accepte "m2p" milieu entre 2 points.

(defun c:CS (/ elast ud sac csac p1 p2 p2_SCG p3 ercs u:g u:f uf)
(defun ercs (msg)
 (eval(read U:F))
 (command "_u")
 (setvar "cmdecho" 1)
 (setq *error* m:err m:err nil)
 (princ)
)

(setq m:err *error* *error* ercs)
(setvar "CMDECHO" 0)
 ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:F))
(setq U:G "(command \"_UNDO\" \"_G\")"
 U:F "(command \"_UNDO\" \"_E\")"
)
(eval(read U:G))
(setq elast (entlast))
(princ " Sélectionnez les solides à couper.")
(setq sac (ssget '((0 . "3DSOLID"))) ud (getvar "UCSDETECT") uf (getvar "UCSFOLLOW"))
(if (= 1 uf) (setvar "UCSFOLLOW" 0))	   
(prompt "\n 1er point de coupure ou de base: ")	   
(command "_ucs" pause )
 
;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
(while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))

(command "")
(setvar "UCSDETECT" 0)
(setq p2 (getpoint '(0. 0. 0.) "\n2eme point de coupure ou Direction de la coupe:"))
(setq p2_SCG (trans p2 1 0) p3 "Premier" p1 '(0. 0. 0.))
(command "_.ucs" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "" )
(while (= p3 "Premier") 
 (initget "Premier")
 (prompt "\n Si point vers axe -X seul ce coté est concerver") 
 (setq p3 (getpoint p1 "\n 2 eme point de coupure,[Premier] ou <valider>:"))
 (cond
   ((= p3 "Premier")
    (setq p3 (getpoint p1 "\n 1er point de coupure ou <valider>:"))
    (if p3 (setq p1 p3 p3 "Premier"))
   )
 )   
)

(if (not p3) (setq p3 (trans p2_SCG 0 1 )))
(if (not p1) (setq p1 '(0. 0. 0.))) 
(if (> (nth 0 p1) (nth 0 p3))
 (command "_.slice"  sac "" "_non" p1 "_non" (list (nth 0 p1) (+ 10 (nth 1 p1)) (nth 2 p1))
                     "_non" (list (- (nth 0 p1) 10) (nth 1 p1) (nth 2 p1))) 
 (progn
   (command "_copy" sac "" "" "")
    (setq  csac nil csac (ssadd))
        (while (entnext elast)
         (ssadd (entnext elast) csac)
         (setq elast (entnext elast))
    )
   
   (command "_.slice"  sac "" "_non" p1 "_non" (list (nth 0 p1) (+ 10 (nth 1 p1)) (nth 2 p1))
                              "_non" (list (- (nth 0 p1) 10) (nth 1 p1) (nth 2 p1)))
   (command "_.slice"  csac "" "_non" p3 
     "_non" (list (nth 0 p3) (+ 10 (nth 1 p3)) (nth 2 p3))  
     "_non" (list (+ 10 (nth 0 p3)) (nth 1 p3) (nth 2 p3))
   )
 )
)

(repeat 2 (command "_ucs" "_p"))
(if (= 1 uf) (setvar "UCSFOLLOW" 1))
(setvar "UCSDETECT" ud)
(eval(read U:F))
(setq *error* m:err m:err nil)
(setvar "CMDECHO" 1)
(princ)

)

zapou78 · le 15 juillet 2012

Merci usegomme pour tous ces lisp, ils sont très pratiques!

Je voulais savoir si tu avais un lisp permettant d'aplanir une tôle formée et ainsi de trouver sa forme "d'origine"?

Certains programmes tels que TurboCad ou Rinho permettent de le faire sans soucis, mais sur autocad il n'y a pas cette fonction.

Tramber · le 15 juillet 2012

Maintenant il y a APLANIRGEOM...

Faut aimer. Outil complet cependant.

Mais il ne s'agit pas d'un historique de solide.

usegomme · le 29 juillet 2012

tous ces lisp, ils sont très pratiques

Tant mieux, ça m'ennuie de ne bricoler que pour moi.

Je voulais savoir si tu avais un lisp permettant d'aplanir une tôle formée et ainsi de trouver sa forme "d'origine"?

Et non, aucune chance, et la réponse de (gile) est sans équivoque sur la difficulté du problème.

Ci-dessous PLA.lsp un dérivé de TR.lsp (tube Rectangulaire) que je viens de mettre en ligne.

Quand on veut du plat c'est plus direct, et par rapport à la commande POLYSOLIDE (autocad 2009 je ne connais pas les autres), le lisp permet d'aller dans les 3 axes pour rajouter des tronçons, ça peut servir.

;; pour tracer en 3d des profils rectangulaires pleins

(defun c:PLA (/ pt_i_fer ftd:clore ftd:ps ftd:sommets ftd:profmet ftd:point
                ftd:fer ftd:pp ftd:axefer  i pt_i_fer_SCG ftd:ps_SCG 
	   unit_draw    
         
         tubext tubint    dynm  CFOLLOW 
         ep la ha r typar   
	)

;; 16/04/2010    usegomme 
;; 25/5/2010  option nouveau point de base  

 (setvar "USERS5" "qz1")  ;; FORCE unité mm  choix désactivé 

;; definition de l'unité de dessin , en cas d'erreur de choix réinitialisé "users5" via la ligne de commande
 
 (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
   (progn
     (setq sv_dm (getvar "DYNMODE"))
     (cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm))
           (t (setq sv_dm nil dm nil))
     )
  
     (initget "ME CM MM")
     (if (not (setq unit_key (getkword "\nDessin réalisé en [MM/CM/ME] <MM>: ")))
       (setq unit_key "MM")
     )
     (cond
       ((eq unit_key "ME")
 (setq unit_draw 1000)
       )
       ((eq unit_key "CM")
 (setq unit_draw 10)
       )
       ((eq unit_key "MM")
         (setq unit_draw 1)
       )
     )
    
     (setvar "USERS5" (strcat "qz" (itoa unit_draw)))
     (setq unit_draw (/ 1.0 unit_draw))
     
     (if sv_dm (setvar "DYNMODE" sv_dm))
   )
   
   (setq unit_draw (/ 1.0 (atoi (substr (getvar "USERS5") 3))))
   
 )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 
 (setq CFOLLOW (getvar "UCSFOLLOW") 
       pw (getvar "plinewid") tubint nil
 )

 
 (setq pt_i_fer (getpoint "\n  Point de départ  du FER PLAT: "))
 (if pt_i_fer (setq ftd:clore nil  ftd:ps (getpoint pt_i_fer "\n point suivant DIRECTION et LONGUEUR  : ")))
 (cond
   ((and pt_i_fer ftd:ps)
     (setvar "CMDECHO" 0)
     (command "_undo" "_be")    
     ; sauve scu courant
     (command "_ucs" "_s" "tempftd") 
     (if (not (zerop (getvar "cmdactive")))(command "_y"))
     
     (command "_line" "_none" pt_i_fer "_none" ftd:ps "")
     (setq ftd:axefer (entlast))
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))
     (command "_ucs" "_zaxis" "_none" pt_i_fer "_none" ftd:ps)
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))

     
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    

     (if (not plat:la) (setq plat:la 100.0)) ; par défaut	   
     (setq la (getdist (strcat "\nLARGEUR PLAT <" (rtos plat:la 2 4) ">: ")))
     (if la (setq plat:la la) (setq la plat:la))
 
     (if (not plat:ha) (setq plat:ha 20.0))	   
     (setq ha (getdist (strcat "\nEPAISSEUR DU PLAT <" (rtos plat:ha 2 4) ">: ")))
     (if ha (setq  plat:ha ha) (setq ha plat:ha)) 

     (setq ep0 0)  ;; fer plat et barre
     (setq typar "Vives")
     
     (setq la (* 0.5 la) ha (* 0.5 ha))
     

      (setq P1 '(0. 0. 0.))
     (cond
      ((and (> ep0 0)(<= 3)) (setq r (+ ep0 1)))
      ((> ep0 3) (setq r (+ ep0 2))) 
      (t (setq r 3))
     )

    
     (setq i 1)
     (repeat 2
      (if (= i 2)
       (cond
        ((> ep0 0.0)
         (setq tubext (entlast))
         
          (cond
           ((and (> ep0 0)(<= 3)) (setq r  1))
           ((> ep0 3) (setq r 2)) 
          )
          (setq la (- la ep0) ha (- ha ep0))
          (setq i 3)
         ) 
        )
       )

     (cond ((/= i 2)
      (cond	  
       ((= typar "Arrondies")	  
        (command "_PLINE" 
  "_non" (list (- la r) (* ha -1)) 
  "_A" "_CE" "_non" (list (- la r) (* (- ha r) -1)) 
         "_non" (list la  (* (- ha r) -1)) 
  "_L"  "_non" (list la (- ha r)) 
         "_A" "_CE" "_non" (list (- la r) (- ha r)) 
  "_non" (list (- la r) ha)  
         "_L" "_non" (list (* (- la r) -1) ha)
         "_A" "_CE" "_non" (list (* (- la r) -1) (- ha r))
  "_non" (list (* la -1) (- ha r)) 
         "_L" "_non" (list (* la -1) (* (- ha r) -1))
         "_A" "_CE" "_non" (list (* (- la r) -1) (* (- ha r) -1))
  "_non" (list (* (- la r) -1) (* ha -1))
   "_L" "_c"
       )
      )
      ((= typar "Vives")	  
       (command "_PLINE" 
                 "_non" (list (*  la  -1) (* ha -1))
          "_non" (list la (* ha -1))
          "_non" (list la ha)
          "_non" (list (* la -1) ha)
                 "_c"
       )
      )
     )	  
   )) ; cond 
   
   (if (= i 1)(setq i 2)) 
  ) ; repeat
    
   (setvar "plinewid" pw)
   (setvar "CMDECHO" 1)     ;;; pour commande rotation ci-dessous
    
  (cond
   ((= i 2)
    (setq tubext (entlast))
    (command "_rotate" tubext "" "_non" p1)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (setq pc (getpoint p1 "\n nouveau point de référence <>:"))
    (if pc (command "_move" tubext "" "_non" pc "_non" p1))
   ) 
   ((= i 3)
    (setq la (+ la ep) ha (+ ha ep))
    (setq tubint (entlast))
    (command "_rotate" tubint tubext "" "_non" p1)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (setq pc (getpoint p1 "\n nouveau point de référence <>:"))
    (if pc (command "_move" tubint tubext "" "_non" pc "_non" p1))
   )
 )

   
    
     ; pivotements scu
     (setvar "CMDECHO" 0)
    
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))     
     (command "_ucs" "_x" "-90")
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))     
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))     
     (command "_ucs" "_Z" "-90")
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))      
     
     (setq ftd:sommets (list ftd:ps))

     ;; extrusion suivant chemin (path)
     (command "_extrude" tubext "" "_p" ftd:axefer)
     (setq ftd:fer (entlast))
     (if tubint
(progn
  (if (= (getvar "delobj") 2) (entdel ftd:axefer))
 	  (command "_extrude" tubint "" "_p" ftd:axefer)
         (command "_subtract" ftd:fer "" "_L" "")
         (setq ftd:fer (entlast))
)  
     )
      
     
     (while ftd:ps
       (setq ftd:pp ftd:ps)
       (if (< i 2)
         (setq ftd:ps (getpoint ftd:pp "\n point suivant :"))
         (progn
           (initget "Clore")
           (setq ftd:ps (getpoint ftd:pp "\n point suivant [Clore] :"))
           (if (= ftd:ps "Clore")
             (setq ftd:clore t)
           )
         )
       )
       (if ftd:ps
         (progn
           (if ftd:clore
             (setq ftd:ps nil)
             (setq ftd:sommets (append ftd:sommets (list ftd:ps)))
           )
           (entdel ftd:fer); efface fer 3d
       ;;efface AXE précédent
           (if (or (= 0 (getvar "delobj"))(= 1 (getvar "delobj")))
             (entdel ftd:axefer)
           )
           (command "_3dpoly" "_none" pt_i_fer)
           (setq i 0)
           (repeat (length ftd:sommets)
             (setq ftd:point (nth i ftd:sommets))
             (command "_none" ftd:point)
             (setq i (1+ i))
           )
           (if (not ftd:clore)
             (command "")
             (command "_c")
           )
           (setq ftd:axefer (entlast))
           (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj")))
      (progn
              (entdel tubext) ; restaure profil 2d
       (if tubint (entdel tubint))
      )
           )

           (command "_extrude" tubext "" "_p" ftd:axefer)
           (setq ftd:fer (entlast))
           (if tubint
            (progn
      (if (= (getvar "delobj") 2) (entdel ftd:axefer)) 
 	      (command "_extrude" tubint "" "_p" ftd:axefer)
             (command "_subtract" ftd:fer "" "_L" "")
             (setq ftd:fer (entlast))
            )  
           )
           
         )
       )
     )


 ;; AXE présent ou pas suivant variable delobj en désactivant les 2 options ci-dessous
 ;;   ou bien 
 ;  AXE TOUJOURS EFFACé  (oter les ;)
      (if (= 1 (getvar "delobj"))
       (entdel ftd:axefer) ;efface AXE
      )
   ;; ou AXE TOUJOURS PRESENT (oter les ;)
    ;    (if (= 2 (getvar "delobj"))
     ;    (entdel ftd:axefer) ;restaure AXE
     ;  )


 (setvar "UCSFOLLOW" CFOLLOW)   
 
 ; restoration scu
   (command "_ucs" "_r" "tempftd")
   (command "_undo" "_e")
   (setvar "CMDECHO" 1)
   )
 )
 (princ)
)

usegomme · le 26 novembre 2012

Un autre version de "percer.lsp".

J'ai fait aussi quelques petites mises à jour dans les lisps précédents

;; perçages multiples de un ou plusieurs solides
;; fonctionne avec SCU Dyn si actif
;; les centres de perçage doivent être validés au fur et à mesure
;; sinon ils sont pris pour des points de repèrage temporaires
;; usegomme
;; 02-10-2012

(defun c:PRC (/ solides cyl n nb i p ce erprc)

(defun erprc (msg)
 (if n (repeat n (command "_ucs" "_p")))
 (setvar "cmdecho" 1)
 (setq *error* m:err m:err nil)
 (princ)
)

(setq m:err *error* *error* erprc)

 (princ " Sélectionnez les solides à percer.")
 (setq solides (ssget '((0 . "3DSOLID"))))
 (cond
  (solides
    (setvar "CMDECHO" 0)
    (prompt "\n Specifiez le point de départ:")
    (command "_ucs" pause) 

;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. 
    (while (not (equal  (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause))
    (command "")
    (setq n 1)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*** FACULTATIF *** 1er option  demande axe X et Y scu 

 ;  (if (= 0 (getvar "ucsdetect"))
 ;   (progn
 ;    (setq n 2)(setvar "CMDECHO" 1)
 ;    (command "_ucs" "_non" '(0. 0. 0.))
  ;   (while (not (zerop (getvar "cmdactive")))(command pause))
  ;  )
 ;  )
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*** FACULTATIF *** 2eme option demande axe Z scu 

 (if (= 0 (getvar "ucsdetect"))
  (progn 
   (setq n 2 p (getpoint '(0. 0. 0.) "\nDirection perçage(s) ou <Valider axe Z>: "))
   (if p (command "_ucs" "_zaxis" "" "_non" p) (setq n 1)) 
  )
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fin options 
   
     
  (setq ce '(0. 0. 0.) i 1)

  (while ce 
    (while (setq p (getpoint ce "\n Nouveau point ou <valider centre>:"))
      (if p (progn (grdraw p ce -1) (setq ce p)))
    )
    (setvar "cmdecho" 1)
    (command "_cylinder" "_non" ce)
    (if (= i 1)
     (while (not (zerop (getvar "cmdactive")))(command pause))
     (command "" "")
    )

    (setq i (1+ i)) 

    (setvar "cmdecho" 0)
    (setq cyl (entlast))
    (repeat (setq nb (sslength solides))
     (cond
((> nb 1) (command "_copy" cyl "" "" "")
        (command "_subtract" (ssname solides (setq nb (1- nb))) "" "_last" "")
       )
(t  (command "_subtract" (ssname solides (1- nb)) "" cyl ""))
     )
    )
    (setq p (getpoint ce "\n Nouveau point ou <Arret>:"))
    (if p (progn (grdraw p ce -1) (setq ce p))(setq ce nil))
   
  );; while ce 
   (repeat n (command "_ucs" "_p"))
 )
)
(setq *error* m:err m:err nil)
(setvar "cmdecho" 1)
(princ) 
)

Connexion

Petits outils 3D (gadgets)

Messages recommandés

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

usegomme

zapou78

Tramber

usegomme

usegomme

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante