Bonjour, J'utilisais ce lisp pour représenter un tube coupé. Sous Autocad 2009, il ne fonctionne plus! Quelqu'un peut m'aider en corrigeant le lisp pour qu'il fonctionne à nouveau. Merci ;************************** ROD-END.LSP ***********************************
; By Simon Jones Autodesk Ltd, London March 1987
; This macro constructs a "broken shaft end" at the end of two
; specified lines. The "S" shaped curve starts at a point on the
; "nearest" line to the first pick-point. Both lines will be trimmed
; or extended to neatly intersect the "S" shape.
;******************* SYSTEM VARIABLE STORE *********************
; Store system variables
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a)))
)
; Reset System variables
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
;****************** ANGLE CONVERTERS ***************************
(defun DTR (a)
(* pi (/ a 180.0))
)
(defun RTD (a)
(/ (* a 180.0) pi)
)
;********************** CON-LST ********************************
; Add new point to list of previous points
(defun CON-LST (a d)
(append l (list (polar pt1 a d)))
)
;******************* LINE SELECTION ****************************
(defun PICK (prmpt / e)
(setq e (entsel prmpt))
(if (null e)
(pick prmpt)
(cond
((/= (cdr (assoc 0 (entget (car e)))) "LINE")
(prompt "\nError: Entity is a ")
(princ (cdr (assoc 0 (entget (car e)))))
(pick prmpt)
)
(T
(eval 'e)
)
)
)
)
;********************** MAIN PROGRAM ****************************
(defun C:ROD-END (/ p1 p2 pt1 pt2 dist ang l)
(modes '("BLIPMODE" "CMDECHO" "HIGHLIGHT" "ORTHOMODE"))
(setvar "CMDECHO" 0)
(setvar "HIGHLIGHT" 0)
(setvar "ORTHOMODE" 0)
(setq p1 (pick "\nSelect first line: "))
(setq p2 (pick "\nSelect second line: "))
(setvar "BLIPMODE" 0)
(setq pt1 (osnap (cadr p1) "near"))
(setq pt2 (inters
(cdr (assoc 10 (entget (car p2))))
(cdr (assoc 11 (entget (car p2))))
pt1
(polar pt1
(+ (angle
(cdr (assoc 10 (entget (car p1))))
(cdr (assoc 11 (entget (car p1))))
)
(dtr 90)
)
1
)
nil
)
)
(command "CHANGE" (car p1) "" pt1)
(command "CHANGE" (car p2) "" pt2)
(setq dist (distance pt1 pt2)
ang (angle pt1 pt2)
l (list pt1)
l (con-lst (- ang (dtr 31)) (* dist 0.29))
l (con-lst ang (* dist 0.5))
l (con-lst (+ ang (dtr 11.3)) (* dist 0.76))
l (append l (list pt2))
l (con-lst (- ang (dtr 11.3)) (* dist 0.76))
l (con-lst ang (* dist 0.5))
)
(command "PLINE")
(foreach n l (command n))
(command "")
(command "PEDIT" "L" "E" "T" (- (rtd ang) 90) "X" "F" "")
(moder)
(princ)
)
