Examples Lisp for Autocad Arbre

AutoLisp

Ce programme permet de paramétrer le tracé d'un arbre.

;*********************************************************************
;************* PROGRAMME DE TRACE AUTOMATIQUE D'ARBRE. *****************
;***************** Copyright (C) 1987... Jean-Paul MOLINA *******************
;*********************************************************************
(defun Question (mess def / x)
       (Affiche (list "\n" mess "<" def ">: "))
       (setq x (getreal))
       (if (not (null x))
                (setq def x)
                (setq def def)
       )
)
;***********************************************************************
(defun Affiche (args / A)
       (ForEach A args (princ A))
)
;***********************************************************************
(defun Message()
       (setq da (Question "Diametre d'arrivee : " dd) )
       (setq dist (Question "Longueur: " dist) )
)
;**********************************************************************
(defun Volume(/ x y zi vr vi)
   (setq x (/ dd 2.0) )
   (setq y (/ da 2.0) )
   (setq vr (+ (* x x) (* x y) (* y y) ))
   (setq vi (/ (* pi dist vr) 3.0) )
   (IF (= x y) (setq zi (/ dist 2.0))
               (setq zi (/ (* dist (+ (/ (* y y) 2.0)
                                      (/ (* x y) 3.0)
                                      (/ (expt (- x y) 2.0) 4.0)
                                   )
                           )
                      vr))
   )
   (setq v (+ vi v) )
   (setq z (+ zi dprec) )
   (setq zdv (+ (* z vi) zdv))
)
;**********************************************************************
(defun CdG()
        (setq Zg (/ zdv v))
        (print (list "Le CdG est a " Zg " mm du pt d'insertion") )
        (princ)
        (Supp_echo)
        (setq Cin (polar p ang Zg))
        (setvar "PDMODE" 35)
        (command "POINT" Cin)
        (Remet_echo)
)
;**********************************************************************
(defun Masse()
       (setq ro (Question "Masse Volumique? " ro) )
       (setq m (* ro 1E-3 v) )
       (print (list "Masse :" m " grammes") )
       (princ)
)
;**********************************************************************
(defun MomQuadr(/ x y Ini)
       (setq x (/ dd 2.0) )
       (setq y (/ da 2.0) )
       (setq Ini (/ (* pi dist (+ (expt x 4)
                                  (* (expt x 3) y)
                                  (* (expt x 2) (expt y 2))
                                  (* x (expt y 3))
                                  (expt y 4)
                               )
                    ) 5.0
                 )
       )
       (setq Mq (+ Ini Mq))
)
;**********************************************************************
(defun Inertie()
       (setq ro (Question "Masse Volumique? " ro) )
       (setq Iaxe (* ro 1E-3 Mq) )
       (print (list "Moment D'Inertie/axe :" Iaxe " g.mm2") )
       (princ)
)
;**********************************************************************
(defun Squelette()
       (setq p1 (polar px1 (+ ang (/ pi 2.0)) (/ dd 2.0) ) )
       (setq px2 (polar px1 ang dist))
       (setq p2 (polar px2 (+ ang (/ pi 2.0)) (/ da 2.0) ) )
)
;*****************************************************************************
(defun InstPlan()
    (setq pl (getvar "CLAYER"))
    (setq pl (substr pl 1 5))
    (command "PLAN" "IN" "*" "O" "CH" "RLT" "") ;choisit RLT
)
;***************************************************************************
(defun Deplac()
      (command "CHANGER"  (ssget "X" '((8 . "RLT")) ) ""
                         "PR" "P" pl "")
      (command "PLAN" "AC" "*" "CH" pl "")
)
;***************************************************************************
(defun Supp_Echo()
       (setq mark(getvar "blipmode"))
       (setq eko(getvar "cmdecho"))
       (setvar "blipmode" 0)
       (setvar "cmdecho" 0)
)
;***************************************************************************
(defun Remet_Echo()
       (setvar "blipmode" mark)
       (setvar "cmdecho" eko)
)
;***************************************************************************
(defun TraceAxe(/ q0 q1 ax)
      (setq q0 (polar p (+ ang pi) 8.0) )
      (setq q1 (polar px1 ang 8.0) )
      (command "POLYLIGN" q0 q1 "")
      (setq ax (entlast))
      (command "CHANGER" ax "" "PR" "TL" "Axes" "")
      (command "ECHLTP" 10)
)
;***************************************************************************
;	Commande ARBRE
;***************************************************************************
(defun C:ARBRE()
      (prompt "\n************** Trace d'arbre * (C) JP MOLINA *************")
      (graphscr)
      (Supp_Echo)
             ;**** Initialisation ******************************************
                    (setq dd 0)
                    (setq da 0)
                    (setq dist 0)
                    (setq dprec 0)
                    (setq trait 0)
                    (setq ro 7.8)
                    (setq v 0)
                    (setq z 0)
                    (setq zdv 0)
                    (setq Mq 0)
             ;************************************************************
       (setq p (getpoint "\nPoint de Depart: ") )
       (setq ang (getangle p "\n2eme point/angle en deg.<0>: ") )
       (if (= ang nil) (setq ang 0) )
       (setq trait (Question "Epaisseur du trait : " trait) )
       (setvar "highlight" 1)
       (InstPlan)
       (prompt "\n*********** Taper un d.de depart < 0 pour finir **********")
       (setvar "highlight" 0)
       (setq dd (Question "Diametre de depart : " dd) )
       (setq px1 p)
       (while (>= dd 0)
              (progn
                     (setq dprec (+ dist dprec))
                     (message) (volume) (MomQuadr) (squelette)
                     (command "POLYLIGN" px1 "e" trait "" p1 p2 px2 "")
                     (command "MIROIR" "D" "" p px2 "")
                     (setq px1 px2)
                     (terpri)
                     (prompt "\n***** Entrer un nombre negatif pour finir ****")
                     (setq dd (Question "Diametre de depart : " da))
              )
       )
       (TraceAxe)
       (Deplac)
       (Remet_Echo)

(princ)
)
;***************************************************************************

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp