salut, voici un lisp récuper sur le forum, d'ailleur remercie à lauteur de m'avoir dépanner ce jour là.
(defun c:pmp(/ Cmd Co Coo Compt ep Lg os Pt1 Pt2 Pts Pas s)
(defun *errmp* (msg)
(if (/= msg "Function cancelled")
(if (= msg "quit / exit abort")
(princ)
(princ (strcat "\nErreur : " msg))
)
(princ)
)
(if os
(setvar "osmode" os)
)
(setvar "cecolor" coo)
(command "_.undo" "_end")
(setvar "cmdecho" Cmd)
(setq *error* s)
(princ)
)
(defun cg_co()
(setvar "cecolor" (itoa Co))
(if (= Co 1)
(setq Co 7)
(setq Co 1)
)
)
(setq s *error*)
(setq *error* *errmp*)
(setq Cmd (getvar "cmdecho") Coo (getvar "cecolor"))
(setvar "cmdecho" 0)
(setq Ep (getstring (strcat "\nEpaisseur des polylignes <" (rtos (getvar "plinewid")) "> : ")))
(if Ep
(setvar "plinewid" (atof Ep))
)
(setq Pt1 (getpoint "\nPremier point : ") Pt2 '(0.0 0.0 0.0) Co 7 Compt 0)
(if Pt1
(progn
(setq Pts (list (cons 0 Pt1)))
(while Pt2
(initget "Undo")
(setq Pt2 (getpoint Pt1 "\nPoint suivant / Undo : "))
(if Pt2
(progn
(if (= Pt2 "Undo")
(progn
(if (/= Compt 0)
(progn
(command "_.undo" "1")
(setq Pts (vl-remove (assoc Compt Pts) Pts) Compt (1- Compt) Pt1 (cdr (assoc Compt Pts)))
)
(princ "\nRien à annuler")
)
)
(progn
(command "_.undo" "_group")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq Pas 0 Lg (* (getvar "ltscale") 20))
(while (< Pas (- (distance Pt1 Pt2) Lg))
(cg_co)
(command "_.pline" (if (= Pas 0)
Pt1
"@"
)
(strcat "@" (rtos Lg) "<" (angtos (angle Pt1 Pt2) 0 16))
"")
(setq Pas (+ Pas Lg))
)
(cg_co)
(command "_.pline" "@" Pt2 "")
(setvar "osmode" os)
(setvar "cecolor" coo)
(command "_.undo" "_end")
(setq Pt1 Pt2 Compt (1+ Compt) Pts (append Pts (list (cons Compt Pt2))))
)
)
)
)
)
)
)
(setvar "cmdecho" Cmd)
(setq *error* s)
(princ)
) Sa te créra des segment de couleur noir et rouge