-
Compteur de contenus
12 247 -
Inscription
-
Dernière visite
-
Jours gagnés
209
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par (gile)
-
Salut, Impair = non multiple de 2 En LISP : (/ 3 2) retourne 1 (/ 3 2.0) ou (/ 3.0 2) ou (/ 3.0 2.0) retournent 1.5
-
Salut, Un petit LISP qui devrait fonctionner dans les SCU parallèles au SCG. Nouvelle version qui devrait fonctionner quelque soit le SCU courant et le plan de la spline/cercle (defun c:sp2c (/ AcDoc Space ss n ent obj long p1 p2 p3 p4 p5 norm l1 l2 cen) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (prompt "\nSélectionnez les splines (ou ENTER pour toutes)." ) (if (not (setq ss (ssget '((0 . "SPLINE") (-4 . "&") (70 . 8))))) (setq ss (ssget "_X" '((0 . "SPLINE") (-4 . "&") (70 . 8)))) ) (if ss (progn (vla-StartUndoMarK AcDoc) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ent) long (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) p1 (vlax-curve-getStartPoint obj) p2 (vlax-curve-getPointAtDist obj (* 0.3 long)) p3 (vlax-curve-getPointAtDist obj (* 0.6 long)) p4 (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2) p5 (mapcar '(lambda (x y) (/ (+ x y) 2)) p2 p3) norm (norm_3pts p1 p2 p3) l1 (vla-addLine Space (vlax-3d-Point p4) (vlax-3d-Point p2)) l2 (vla-addLine Space (vlax-3d-Point p5) (vlax-3d-Point p3)) ) (vla-rotate3d l1 (vlax-3d-point p4) (vlax-3d-point (mapcar '+ p4 norm)) (/ pi 2)) (vla-rotate3d l2 (vlax-3d-point p5) (vlax-3d-point (mapcar '+ p5 norm)) (/ pi 2)) (setq cen (vl-catch-all-apply 'vlax-invoke (list l1 'IntersectWith l2 acExtendBoth) ) ) (if (not (vl-catch-all-error-p cen)) (progn (vla-put-Normal (vla-addCircle Space (vlax-3d-point cen) (distance cen p1)) (vlax-3d-point norm)) (mapcar 'vla-delete (list l1 l2 obj)) ) ) ) (vla-EndUndoMark AcDoc) ) ) (princ) ) ;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm))) (setq norm (v^v xdir ydir)) ) ) ;;; V^V Retourne le produit vectoriel (vecteur) de deux vecteurs (defun v^v (v1 v2) (if (inters '(0 0 0) v1 '(0 0 0) v2) (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2))) (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2))) (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2))) ) ) ) [Edité le 3/10/2006 par (gile)]
-
Salut, Tu peux faire la boite de dialogue avant, si tu sais ce qu'elle doit contenir. Le code DCL définit la "forme" de la boite, tu peux l'écrire dans l'éditeur visualLISP et l'enregistrer au format .dcl, tu pourras ainsi visualiser le résultat (inactif) en faisant menu Outils >> Outils d'interface >> Aperçu DCL dans l'éditeur. C'est avec le LISP que tu récupères les valeurs des différentes cases (tile) et que tu les traites. Je te redonnes deux liens vers des sujets avec des exemples simples :ici et là.
-
sélectionner des objets à partir d\'une Polyligne
(gile) a répondu à un(e) sujet de rebcao dans AutoCAD, liste de souhaits
Re, Pour les non lispeurs, deux fonctions d'appel : SSOC pour une sélection par capture et SSOF pour une sélection par fenêtre. Comme précédemment, supprimer les espaces entre SelByObj doit, bien sûr, être chargé. (defun c:ssoc (/ ss opt) (sssetfirst nil nil) (if (setq ss (ssget "_:S:E" (list '(-4 . "[color=#CC0000] '(0 . "CIRCLE") '(-4 . "[color=#CC0000] '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . "[color=#CC0000] '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) (sssetfirst nil (SelByObj (ssname ss 0) "Cp" nil)) ) (princ) ) (defun c:ssof (/ ss opt) (sssetfirst nil nil) (if (setq ss (ssget "_:S:E" (list '(-4 . "[color=#CC0000] '(0 . "CIRCLE") '(-4 . "[color=#CC0000] '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . "[color=#CC0000] '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) (sssetfirst nil (SelByObj (ssname ss 0) "Wp" nil)) ) (princ) ) [Edité le 4/10/2006 par (gile)] -
Salut, Il me sembe que le plus simple pour programmer les propriétés d'une polyligne, c'est d'utiliser entmake Certains codes sont facultatifs, les valeurs par défaut sont les valeurs courantes (calque, couleur, élévation, direction d'extrusion, espace, fenêtre, couleur ...). Vois les codes DXF dans l'aide aux développeurs >> Références DXF >> Section ENTITES Un exemple pour créer une polyligne à 3 sommets de largeur constante : (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 . Calque) ; Nom du calque (facultatif) '(100 . "AcDbPolyline") '(90 . 3) ; nombre de sommets '(70 . 1) ; ouverte (0) ou fermée (1) (cons 38 elev) ; élévation (facultatif) (cons 43 larg) ; largeur constante (facultatif) (cons 10 pt1) ; premier sommet (cons 42 courb1) ; courbure (facultatif) (cons 10 pt2) ; deuxième sommet (cons 42 courb2) ; courbure (facultatif) (cons 10 pt3) ; troisième sommet (cons 42 courb3) ; courbure (facultatif) (cons 210 zdir) ; direction d'extrusion (facultatif) ) ) Si les largeurs sont différentes entre les sommets : (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 . Calque) ; Nom du calque (facultatif) '(100 . "AcDbPolyline") '(90 . 3) ; nombre de sommets '(70 . 1) ; ouverte (0) ou fermée (1) (cons 38 elev) ; élévation (facultatif) (cons 10 pt1) ; premier sommet (cons 40 dep1) ; largeur de départ (cons 41 fin1) ; largeur de fin (cons 42 courb1) ; courbure (facultatif) (cons 10 pt2) ; deuxième sommet (cons 40 dep2) ; largeur de départ (facultatif) (cons 41 fin2) ; largeur de fin (facultatif) (cons 42 courb2) ; courbure (facultatif) (cons 10 pt3) ; troisième sommet (cons 40 dep3) ; largeur de départ (facultatif) (cons 41 fin3) ; largeur de fin (facultatif) (cons 42 courb3) ; courbure (facultatif) (cons 210 zdir) ; direction d'extrusion (facultatif) ) )
-
Salut, Dans l'éditeur de bloc, après avoir mis un paramètre linéaire sur la base du triangle, tu mets deux actions d'étirement sur ce même paramètre, une pour chaque angle de la base, et tu mets -1 pour le Variateur de distance de l'action sur l'angle de gauche dans le fenêtre de propriétés. http://img201.imageshack.us/img201/7056/dynmw1.png [Edité le 3/10/2006 par (gile)]
-
Salut Steven, Edit_bloc permet de mettre toutes les entités sur le calque 0, et les couleurs, les types de ligne, les épaisseurs de type de ligne et le style de tracé (STB uniquement) en DUBLOC suivant les cases cochées, il permet aussi de changer l'échelle globale ou l'unité des blocs (2006 et plus). Télécharger Edit_bloc
-
J'ai corrigé un petit bug quand le "cercle de sélection" rencontrait certaine polylignes fermées ne conteneant pas le point spécifié. Il semble que ça fonctionne bien maintenant...
-
sélectionner des objets à partir d\'une Polyligne
(gile) a répondu à un(e) sujet de rebcao dans AutoCAD, liste de souhaits
À cause d'un petit oubli, le filtre de sélection ne fonctionnait pas, c'est réparé. -
Salut, Ce soir j'était plutôt dans les sélections de polylignes et les sélections par les polylignes, je n'ai pas eu le temps de voir ça. Comme d'habitude, peux tu voir si c'est xref_purge qui plante en le lançant tout seul, sinon c'est que ça vient de spurge.
-
J'ai apporté quelques améliorations au premier LISP, notamment en utilisant SelByObj, une routine qui permet de faire un jeu de sélection à partir d'un objet (polyligne cercle ellipse). La nouvelle version cherche une polyligne fermée par Capture avec des cercles concentriques autour du point spécifié. Chaque polyligne sélectionnée est testée toujours avec SelByObj pour vérifier si elle contient le point spécifié (les arcs des polylignes sont donc maintenant pris en compte). Si le point est contenu dans plusieurs polylignes c'est la plus proche du point qui est sélectionnée. Le LISP ne fonctionne que si la vue est parallèle au SCU courant et la polyligne contenue dans la vue. Le LISP est décomposé en une routine pour pouvoir l'utiliser dans d'autres LISP et une fonction d'appel. Nouvelle version (04/10/06) ;;; SELPLINE -Gilles Chanteau- 04/10/06 ;;; Sélection d'une polyligne par un point à l'intérieur ;;; Retourne un nom d'entité (ename) ou un message d'erreur (defun SelPlineByPoint (pt / size inc rad norm loop pick circle ss ent x_lst) (if (equal '(0 0) (reverse (cdr (reverse (getvar "VIEWDIR")))) 1e-9 ) (progn (setq size (getvar "viewsize") inc (/ size 200) rad inc norm (trans '(0 0 1) 1 0 T) loop T ) (entmake (list '(0 . "LINE") (cons 10 (trans pt 1 0)) (cons 11 (trans pt 1 0)) ) ) (setq pick (entlast)) (while loop (if ( (setq loop nil) ) (entmake (list '(0 . "CIRCLE") (cons 10 (trans pt 1 norm)) (cons 40 rad) (cons 210 norm) ) ) (setq circle (entlast)) (if (setq ss (SelByObj circle "Cp" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)) ) ) (progn (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n)))) (if (member ent x_lst) (ssdel ent ss) ) ) (if (setq ent (ssname ss 0)) (if (SelByObj ent "Wp" (list '(0 . "LINE") (cons 10 (trans pt 1 0)) (cons 11 (trans pt 1 0)) ) ) (setq loop nil) (setq x_lst (cons ent x_lst)) ) ) ) ) (entdel circle) (setq rad (+ rad inc)) ) (entdel pick) ent ) (alert "La vue doit être dans le plan du SCU courant") ) ) ;;; Fonction d'appel (defun c:selpline (/ pt) (sssetfirst nil nil) (initget 1) (setq pt (getpoint "\nSpécifiez un point à l'intérieur de la polyligne: " ) ) (if (setq ent (SelPlineByPoint pt)) (sssetfirst nil (ssadd ent)) (princ "\nPas polyligne trouvée.") ) (princ) ) Et SelByObj qui doit être chargée aussi : version corrigée (04/10/06) ;;; SelByObj -Gilles Chanteau- 04/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou ;;; capturés par le polygone créé à partir de l'objet sélectionné ;;; Les courbes (cercles, ellipses, arcs de polylignes) sont segmentés ;;; Arguments : ;;; - un nom d'entité (ename) -cercle, ellipse, polyligne fermée- ;;; - un mode de sélection (Cp ou Wp) ;;; - un filtre de sélection (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst) (vl-load-com) (setq obj (vlax-ename->vla-object ent)) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 1 ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (append lst (list (cdr (assoc 10 p_lst))))) (if (/= 0 (cdadr p_lst)) (progn (setq prec (fix (* 50 (abs (cdadr p_lst)))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (cdaddr p_lst) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (cdar p_lst) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (append lst (list (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (cdar p_lst) ) (* dist (setq n (1+ n))) ) ) 0 1 ) ) ) ) ) ) ) (setq p_lst (cddr p_lst)) ) (setq lst (mapcar '(lambda (x) (trans x 0 1)) lst)) ) ) (ssget (strcat "_" opt) lst fltr) ) Sinon, bien vu phil, pour utiliser SelPline dans Pline_Block, il faut remplacer : (while (not (setq ent (car (entsel))))) (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") par : (if (= (type (setq ent (selpline (getpoint "\nSpécifiez un point à l'intérieur de la polyligne: " ) ) ) ) 'ENAME ) en utilisant la dernière version de SelPline.[Edité le 3/10/2006 par (gile)][Edité le 3/10/2006 par (gile)] [Edité le 4/10/2006 par (gile)]
-
sélectionner des objets à partir d\'une Polyligne
(gile) a répondu à un(e) sujet de rebcao dans AutoCAD, liste de souhaits
Je réveille cette discussion un peu ancienne parce que je me suis penché sur ce sujet à propos de celui-ci. Je propose donc ici ma version, avec une routine qui peut être appelée depuis d'autres LISP et comme exemple une fonction d'appel. La routine permet de créer un jeu de sélection avec tous les objets contenus ou capturés par la polyligne, le cercle ou l'ellipse sélectionné. Le polygone de sélection est constitué de 50 sommets pour les coubes fermées (cercles ellipses), le nombre de sommets est calculé en fonction de la courbure des arc de polylignes dans les mêmes proportions. La routine nécessite 3 arguments : - le nom d'entité de l'objet (ename) - le mode de sélection Fenêtre ou Capture (Wp Cp) - un filtre de sélecion (liste ssget) si aucun filtre n'est utilisé cet argument doit être nil. La routine : (bug du filtre de sélection corrigé) Version corrigée le 04/10/06 ;;; SelByObj -Gilles Chanteau- 04/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou ;;; capturés par le polygone créé à partir de l'objet sélectionné ;;; Les courbes (cercles, ellipses, arcs de polylignes) sont segmentés ;;; Arguments : ;;; - un nom d'entité (ename) -cercle, ellipse, polyligne fermée- ;;; - un mode de sélection (Cp ou Wp) ;;; - un filtre de sélection (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst) (vl-load-com) (setq obj (vlax-ename->vla-object ent)) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 1 ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (append lst (list (cdr (assoc 10 p_lst))))) (if (/= 0 (cdadr p_lst)) (progn (setq prec (fix (* 50 (abs (cdadr p_lst)))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (cdaddr p_lst) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (cdar p_lst) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (append lst (list (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (cdar p_lst) ) (* dist (setq n (1+ n))) ) ) 0 1 ) ) ) ) ) ) ) (setq p_lst (cddr p_lst)) ) (setq lst (mapcar '(lambda (x) (trans x 0 1)) lst)) ) ) (ssget (strcat "_" opt) lst fltr) ) Une fonction d'appel (supprimer les espaces entre ;;; SSO ;;; Grippe les objets contenus ou capturés par l'objet sélectionné (defun c:sso (/ ss opt) (sssetfirst nil nil) (if (setq ss (ssget "_:S:E" (list '(-4 . "[color=#CC0000] '(0 . "CIRCLE") '(-4 . "[color=#CC0000] '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . "[color=#CC0000] '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) (progn (initget "Cp Wp") (setq opt (getkword "\nChoisir une méthode de sélection [Cp/Wp]: ") ) (sssetfirst nil (SelByObj (ssname ss 0) opt nil)) ) ) (princ) ) [Edité le 3/10/2006 par (gile)] [Edité le 4/10/2006 par (gile)] -
Salut Fraid, Curieux, en effet ! Ça fonctionne chez moi. :casstet:
-
Que n'y avais-je pensé plus tôt ! Mieux que le changement de PDMODE : mode de sélection _CP (crossing polygon) et une ligne de longueur 0 pour remplacer le point temporaire. Le point peut être spécifié à l'intérieur de la polyligne ou sur la polyligne (avec les accrochages aux objets) Je re-modifie le LISP [Edité le 1/10/2006 par (gile)]
-
J'ai un peu modifier le LISP : - changement de l'incrémentation de la longueur du trajet de sélection (1/100 de la hauteur de la fenêtre au lieu de 1/1000) pour plus de rapidité d'exécution. - Changement de la variable PDMODE pour le point temporaire, et restauration de la valeur initiale.
-
Je ne l'ai pas fait en un seul coup, j'ai d'abord pensé au mode de sélection par un trajet qui augmente depuis le point spécifié, puis en faisant des essais j'ai imaginé que ce trajet pouvait rencontrer une autre polyligne fermée qui ne "contenait" pas ce point, alors j'ai imaginé un moyen pour écarter ce type de polyligne de la sélection. Je crois que le plus difficile en programmation est d'imaginer tout ce qui peut mettre en echec le programme, alors quand une routine semble fonctionner je fais des test pour essayer de la faire échouer.
-
Salut lecrabe, En fait, dans une boucle, je fais d'abord une sélection en mode _Fence (Trajet) depuis le point spécifié en augmentant le trajet de 1/1000 de la taille de la vue active à chaque boucle jusqu'à ce que je trouve un polyligne fermée. Si une poly est trouvée je fais une selection en mode _WP avec les sommet de la dernière poly trouvée pour être sûr que le point spécifié est bien à l'intérieur, s'il n'y est pas on continue à boucler pour trouver une autre poly. Si aucune poly n'est trouvée la boucle s'arrête quand le trajet est égal à la hauteur de la vue (VIEWSIZE). PS : J'ai modifié le LISP, le trajet pour la sélection se faisait sur l'axe des X, je l'ai passé sur les Y puisque la limite est la hauteur de la vue. [Edité le 1/10/2006 par (gile)]
-
Salut, Voici un LISP pas très élégant (il y a peut-être plus simple mais je n'ai pas trouvé). Il ne fonctionne sous certaines conditions : - La polyligne doit être entièrement visible à l'écran - Le point de sélection ne doit pas être spécifié à l'intérieur d'un arc Nouvelle nouvelle version (defun c:selpline (/ pt size fenc inc loop point pmode ss ent test) (initget 1) (setq pt (getpoint "\nSpécifiez un point à l'intérieur de la polyligne: " ) size (getvar "viewsize") fenc (/ size 100) inc fenc loop T ) (entmake (list '(0 . "LINE") (cons 10 (trans pt 1 0)) (cons 11 (trans pt 1 0)) ) ) (setq point (entlast)) (while loop (if ( (setq loop nil) ) (if (and (setq ss (ssget "_F" (list pt (mapcar '+ pt (list 0 fenc 0)) ) '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)) ) ) (setq ent (ssname ss (1- (sslength ss)))) (setq test (ssget "_CP" (mapcar '(lambda (pt) (trans pt ent 1) ) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent) ) ) ) (list '(0 . "LINE") (assoc 10 (entget point)) ) ) ) ) (setq loop nil) (setq ent nil) ) (setq fenc (+ fenc inc)) ) (entdel point) (if ent (sssetfirst nil (ssadd ent)) ) (princ) ) [Edité le 1/10/2006 par (gile)][Edité le 1/10/2006 par (gile)] [Edité le 1/10/2006 par (gile)]
-
Histoire d\'AutoCAD et MAP (R11 - 2007)
(gile) a répondu à un(e) sujet de lecrabe dans CAO, généralités
Grand respect pour les Jurassic Park Brothers En ces temps (pas si) lointains, je traçais mes épures et mes plans à la main, sur la planche ou le plancher. Puis on a commencé à voir arriver dans les ateliers des dessinateurs avec leurs ordinateurs. Ils étaient souvent accueillis avec une réticence certaine due au fait que, si beaucoup savaient se servir de leurs logiciels, certains avaient de sérieuses lacunes en géométrie (descriptive) et/ou en construction. C'est ce qui a fini par me pousser, tardivement à apprendre, moi aussi, à me servir du cette nouvelle sorte de planche à dessin. Depuis, je suis devenu "accro". Encore une fois merci à ces montagnes de connaissances que sont nos dinausores. -
lisp dans autocad donnant la somme des polylignes dans un dessin
(gile) a répondu à un(e) sujet de jeanpoco dans AutoCAD 2007
Salut x_all, Ça devrait tourner sous 2006 sans problème, j'ai effectivement oublié de glisser un (vl-load-com) en début de routine, mais il me semble que ceci n'est plus nécéssaire depuis les versions 2004. Telle quelle la routine fonctionne sur tous les calques (actif/inactif, gelé/dégelé, vérouillé/dévérouillé) si tu veux écarter certains calques, il faut remplacer : (ssget "_X" '((0 . "LWPOLYLINE"))) par : (ssget "_A" '((0 . "LWPOLYLINE"))), et les calques gelés ne seront pas traités. Quelque chose comme ça ? ((lambda (/ ss tot nb n long obj lst lay l_lay) (vl-load-com) (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE")))) (progn (setq nb (sslength ss) n 0 tot 0.0) (princ (strcat "\n\nLe dessin contient : " (itoa nb) " polylignes") ) (repeat nb (setq obj (vlax-ename->vla-object (ssname ss n)) long (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) tot (+ tot long) lay (vla-get-Layer obj) ) (princ (strcat "\nP" (itoa (setq n (1+ n))) " = " (rtos long) "\tCalque : " lay ) ) (if (setq l_lay (assoc lay lst)) (setq lst (subst (cons lay (+ long (cdr l_lay))) l_lay lst)) (setq lst (cons (cons lay long) lst)) ) ) (mapcar '(lambda (x) (princ (strcat "\nLongueur totale sur le calque " (car x) " : " (rtos (cdr x)) ) ) ) lst ) (princ (strcat "\nLongueur totale dans le dessin = " (rtos tot))) (textscr) ) (princ "\nLe dessin ne contient pas de polylignes.") ) (princ) ) ) [Edité le 1/10/2006 par (gile)] -
:casstet: Chez moi ça marche très bien : http://img177.imageshack.us/img177/5652/commentsqn9.png
-
Le LISP ci-dessus a été modifié pour prendre en compte une éventuelle modification de largeur de polyligne entre deux appels de la fonction SetPlineWidthTo0, ainsi que pour l'ajout ou la suppression d'une polyligne. [Edité le 30/9/2006 par (gile)]
-
lisp dans autocad donnant la somme des polylignes dans un dessin
(gile) a répondu à un(e) sujet de jeanpoco dans AutoCAD 2007
Re, ((lambda (/ ss tot n long obj lst) (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE")))) (progn (setq n (sslength ss)) (princ (strcat "\n\nLe dessin contient : " (itoa n) " polylignes") ) (setq tot 0.0) (repeat n (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) long (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) lst (cons (strcat "P" (itoa (1+ n)) " = " (rtos long)) lst) tot (+ tot long) ) ) (mapcar 'print lst) (princ (strcat "\nLongueur totale = " (rtos tot))) (textscr) ) (princ "\nLe dessin ne contient pas de polylignes.") ) (princ) ) ) -
lisp dans autocad donnant la somme des polylignes dans un dessin
(gile) a répondu à un(e) sujet de jeanpoco dans AutoCAD 2007
Salut, Comme je ne savais pas ce que tu voulais exactement, j'ai juste donné ces quelques lignes comme exemple. C'est une fonction lambda, tu copies tout le code, tu le colles sur la ligne de commade et tu tapes ENTER. Le nombre de polylignes et la longueur totale s'affichera sur la ligne de commande. Si la fonction te conviens en l'état et que tu veux t'en faire une commande,colle le code dans le bloc note et remplace : ((lambda au début du code, par : (defun c:MaFonction (tu peux remplacer MaFonction par ce que tu veux en évitant les nom de commandes déjà définis) et supprime la dernière paranthèse (il doit y avoir autant de paranthèses ouvrantes que de fermantes). Puis enregistre le fichier avec l'extension .lsp et charge le dans AutoCAD. Ils uffit ensuite de taper "MaFonction" ou ce que tu auras mis derrière c: dans le defun). -
Je l'ai découvert il y a peu sur un forum anglo-saxon (peut-être ici). Mais, même si ça fonctionne, ce n'est peut-être pas la fonction la plus adaptée. Je n'avais pas très bien compris la discussion en anglais, en fait, l'intérêt principal de vl-bb-set et vl-bb-get est de permettre de faire passer une valeur contenue dans une variable entre différents dessins pendant la même session. Dans le cas présent il me semble plus "rationnel" de lier les données au document (dictionnaire) avec les Xdata (vlax-ldata-put et vlax-ldata-get). Donc, une nouvelle version, avec les Xdata, les données sont conservées pour chaque dessin même après fermeture et ré-ouverture d'AutoCAD. ;;; Met toutes les polylignes de largeurs constantes à 0 ;;; et enregistre leurs largeurs initiale (defun c:SetPlineWidthTo0 (/ lst ss n e_lst data) (setq lst (vlax-ldata-get "PlineDict" "Width")) (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0)))) (repeat (setq n (sslength ss)) (setq e_lst (entget (ssname ss (setq n (1- n)))) data (cons (cdr (assoc 5 e_lst)) (cdr (assoc 43 e_lst))) ) (cond ((null (assoc (car data) lst)) (setq lst (cons data lst)) ) ((/= (cdr (assoc (car data) lst)) (cdr data)) (setq lst (subst data (car sav) lst)) ) ) (entmod (subst '(43 . 0) (assoc 43 e_lst) e_lst)) ) ) (vlax-ldata-put "PlineDict" "Width" lst) (princ) ) ;;; Restaure les largeurs initiales des polylignes modifiées ;;; avec SetPlineWidthTo0 (defun c:RestorePlineWidth (/ lst ent e_lst) (if (setq lst (vlax-ldata-get "PlineDict" "Width")) (mapcar '(lambda (x) (if (setq ent (handent (car x))) (progn (setq e_lst (entget ent)) (entmod (subst (cons 43 (cdr x)) (assoc 43 e_lst) e_lst)) ) (setq lst (vl-remove x lst)) ) ) lst ) ) (vlax-ldata-put "PlineDict" "Width" lst) (princ) ) [Edité le 30/9/2006 par (gile)]
