Classement

Un exemple de lisp, il faut dire que ce n'est pas un exercice de nouveau débutant. ; ANSI-Windows 1252 ; Autolisp ;| segpol.lsp, Segmente une polyligne selon une distance. Testé sur Windows 10 et Autocad 2015 No copyright: (!) 2023 by Frédéric Coulon. No license: Do with it what you want. |; ; Chargement des fonctions VLA/Activex. (vl-load-com) ; getpt3dpol, récupère la liste des points d'une polyligne 2D ou 3D (defun getpt3dpol (ent / n pts) (setq n (1+ (fix (vlax-curve-getEndParam ent)))) (repeat n (setq pts (cons (vlax-curve-getPointAtParam ent (setq n (1- n))) pts))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:segpol ( / acdc clay ce objnam flagscu pol lptpol long pts cpt lpt lpts) (setq acdc (vla-get-activedocument (vlax-get-acad-object)) clay (getvar 'clayer)) ; Point de retour (vla-startundomark acdc) (setq ce (getvar 'cmdecho)) (setvar 'cmdecho 0) ; Controle du SCU (if (= (getvar "worlducs") 0)(setq flagscu (vl-cmdf "_ucs" ""))) ; Séléction de la polyligne. (while (not (wcmatch (setq objnam (cdr (assoc 0 (entget (setq pol (car (entsel "\nSéléctionnez une polyligne"))))))) "*POLYLINE"))) (if pol (progn ; Liste des points de la polyligne. (setq lptpol (getpt3dpol pol) long (getint "\nLongueur des segments: ")) ; Création du calque TMP. (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list layers "TMP" ))) (vla-add (vla-get-layers acdc) "TMP")) ; les points de la commande MESURER sont placés dans le calque TMP. (setvar 'clayer "TMP") (command "_measure" pol long) (setvar 'clayer clay) ; Séléction des points. (if (setq pts (ssget "_x" (list (cons 0 "point")(cons 8 "TMP")))) (progn (setq cpt 0) (while (setq point (ssname pts cpt)) ; Liste des coordonnnées des points. (setq lpt (cons (cdr (assoc 10 (entget point))) lpt) cpt (1+ cpt))) ; Rajout des extrémités de la polyligne. (setq lpt (cons (car lptpol) lpt) lpt (reverse (cons (last lptpol) (reverse lpt)))) ; Formatage de la liste pour vla-AddLightWeightPolyline ou vla-Add3DPoly. (if (= objnam "POLYLINE") (progn (setq lpt (apply 'append (mapcar '(lambda (x)(list (car x) (cadr x) (caddr x))) lpt)) lpts (vlax-make-safearray vlax-vbDouble (cons 0 (- (length lpt) 1)))) (vlax-safearray-fill lpts lpt) ; Dessin de la polyligne 3D (vla-Add3DPoly (vla-get-ModelSpace acdc) lpts) ) (progn (setq lpt (apply 'append (mapcar '(lambda (x)(list (car x) (cadr x))) lpt)) lpts (vlax-make-safearray vlax-vbDouble (cons 0 (- (length lpt) 1)))) (vlax-safearray-fill lpts lpt) ; Dessin de la polyligne (vla-AddLightWeightPolyline (vla-get-ModelSpace acdc) lpts) ) ) ; Efface les points et la polyligne. (initget 1 "Oui Non") (if (eq (getkword "\nSupprimer la polyligne originale? [Oui/Non] <Oui> : ") "Oui") (command "_erase" pts pol "") (command "_erase" pts "")) ) (princ "\nAbandon, vérifiez la longueur des segments.") ) ) (princ "\nAbandon.") ) ; Restauration du SCU. (if flagscu (command "_ucs" "p")) ; Restauration echo (setvar 'cmdecho ce) ; Fin du UndoMark. (if (= 8 (logand 8 (getvar 'UNDOCTL)))(vla-EndUndoMark acdc)) (princ) ) Il faut taper segpol, puis choisir sa polyligne et donner la longueur des segments.

Bonjour, Peut etre que les utilisateurs d'Autocad Architecture sont passés sur Revit !?

Tu cherches de l'aide pour écrire toi même le Lisp, ou bien tu veux un Lisp tout fait qui fait le boulot? Olivier