ASTERIXII Posté(e) le 13 février 2007 Posté(e) le 13 février 2007 Je reviens sur un ancien sujet, sur le comptage des blocs dynamique et autresLe code suivant est bon (de patrick), mais j'ai besoin de pouvoir selectionner une zone de comptage, et voir même compter dans une zone definie par une polyligne merci (defun c:CT(/ js bllst ent CT) (if (setq js (ssget "x" (list (cons 0 "INSERT")))) (progn (setq CT (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (mapcar 'cadr (ssnamex js)) ) ) (foreach ent CT (if (not (member ent (mapcar 'car bllst))) (setq bllst (append bllst (list (cons ent (length (vl-remove-if-not '(lambda (x) (eq ent x)) CT)))))) ) ) ;(mapcar '(lambda (x) (princ (strcat "\n" (itoa (cdr x)) " bloc(s) " (car x)))) bllst ) (mapcar '(lambda (x) (princ (strcat "\n" (car x) " " (itoa (cdr x)) ))) bllst ) ) ) (princ) ) (princ "\nCTT chargé. Tapez CT pour l'exécuter") (princ)
Patrick_35 Posté(e) le 13 février 2007 Posté(e) le 13 février 2007 SalutQuelque chose comme ça (defun c:ct(/ bllst ent js lstbl nb) (if (setq js (ssget (list (cons 0 "INSERT")))) (progn (setq nb 0) (while (setq ent (ssname js nb)) (setq ent (vlax-ename->vla-object ent)) (if (not (vlax-property-available-p ent 'Path)) (if (vlax-property-available-p ent 'EffectiveName) (setq lstbl (append lstbl (list (vla-get-EffectiveName ent)))) (setq lstbl (append lstbl (list (vla-get-Name ent)))) ) ) (setq nb (1+ nb)) ) (setq lstbl (acad_strlsort lstbl)) (while (setq ent (car lstbl)) (setq nb (length lstbl) lstbl (vl-remove ent lstbl) bllst (append bllst (list (cons ent (- nb (length lstbl)))))) ) (mapcar '(lambda (x) (princ (strcat "\nIl y a " (itoa (cdr x)) " bloc(s) " (car x)))) bllst) ) ) (princ) ) (princ "\nCTT.LSP chargé. Tapez CT pour l'exécuter") (princ) @+ Les Lisps de PatrickLe but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.Joseph Joubert, 1754-1824
ASTERIXII Posté(e) le 14 février 2007 Auteur Posté(e) le 14 février 2007 Bien comme d'habitude..... Juste une question, pourquoi ne retrouve ne pas ton travail en zone de téléchargement ?car dans le cas suivant c'est ton code depuis le début, et cela dans le but de retrouver plus facilement les petit lisp qui nous rendent la vie plus facile. c'est juste une idée..
Patrick_35 Posté(e) le 14 février 2007 Posté(e) le 14 février 2007 Tu le retrouves sur cette pageAvec le lisp LSTBL, mais là, c'est une adaptation de ton code, même s'il est fortement inspiré du mien @+ Les Lisps de PatrickLe but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.Joseph Joubert, 1754-1824
funkkybebel Posté(e) le 17 juillet 2007 Posté(e) le 17 juillet 2007 Bonjour,je ne comprend pas pourquoi ça marche pas chez moi. J'ai chargé cela : (defun c:ct(/ bllst ent js lstbl nb)(if (setq js (ssget (list (cons 0 "INSERT"))))(progn(setq nb 0)(while (setq ent (ssname js nb))(setq ent (vlax-ename->vla-object ent))(if (not (vlax-property-available-p ent 'Path))(if (vlax-property-available-p ent 'EffectiveName)(setq lstbl (append lstbl (list (vla-get-EffectiveName ent))))(setq lstbl (append lstbl (list (vla-get-Name ent))))))(setq nb (1+ nb)))(setq lstbl (acad_strlsort lstbl))(while (setq ent (car lstbl))(setq nb (length lstbl)lstbl (vl-remove ent lstbl)bllst (append bllst (list (cons ent (- nb (length lstbl)))))))(mapcar '(lambda (x) (princ (strcat "\nIl y a " (itoa (cdr x)) " bloc(s) " (car x)))) bllst)))(princ)) (princ "\nCTT.LSP chargé. Tapez CT pour l'exécuter")(princ) Mas je n'ai toujours pas le choix de prendre une polyligne comme zone de comptage. Comment cela se fait ? Merci de votre aide !
(gile) Posté(e) le 17 juillet 2007 Posté(e) le 17 juillet 2007 Mas je n'ai toujours pas le choix de prendre une polyligne comme zone de comptage. Pour utiliser un objet graphique comme fenêtre (ou capture) de sélection, il faut utiliser une routine qui récupère des sommets sur l'objet pour lees passer comme argument à une sélection polygonale ("_wp" ou "_cp").Tu peux utiliser la routine SelbyObj et changer le début du LISP de ASTERIXII/Patrick_35 avec quelque chose du genre : NOTA : Supprimer les espaces apès les " (defun c:ct (/ opt obj bllst ent js lstbl nb) (initget "Objet Sélection Tous") (or (setq opt (getkword "\Choisir une option [Objet/Sélection/Tous] : " ) ) (setq opt "Sélection") ) (cond ((= opt "Objet") (and (setq obj (ssget "_:S:E" (list '(-4 . " '(0 . "CIRCLE") '(-4 . " '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . " '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) (setq js (SelbyObj (ssname obj 0) "Wp" '((0 . "INSERT")))) [color=#FF0000]; Remplacer "Wp" par "Cp" pour une capture[/color] ) ) ((= opt "Sélection") (setq js (ssget '((0 . "INSERT")))) ) ((= opt "Tous") (setq js (ssget "_X" '((0 . "INSERT")))) ) ) (if js (progn (setq nb 0) (while (setq ent (ssname js nb)) (setq ent (vlax-ename->vla-object ent)) (if (not (vlax-property-available-p ent 'Path)) (if (vlax-property-available-p ent 'EffectiveName) (setq lstbl (append lstbl (list (vla-get-EffectiveName ent))) ) (setq lstbl (append lstbl (list (vla-get-Name ent)))) ) ) (setq nb (1+ nb)) ) (setq lstbl (acad_strlsort lstbl)) (while (setq ent (car lstbl)) (setq nb (length lstbl) lstbl (vl-remove ent lstbl) bllst (append bllst (list (cons ent (- nb (length lstbl))))) ) ) (mapcar '(lambda (x) (princ (strcat "\nIl y a " (itoa (cdr x)) " bloc(s) " (car x)) ) ) bllst ) ) ) (princ) ) ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou ;;; capturés, dans la vue courante, par l'objet sélectionné ;;; (cercle, ellipse, polyligne fermée). ;;; Arguments : ;;; - un nom d'entité (ename) ;;; - un mode de sélection (Cp ou Wp) ;;; - un filtre de sélection ou nil (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 (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) ) ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 50 (abs (cdadr p_lst))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (append lst (list (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) ) ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (ssget (strcat "_" opt) lst fltr) ) [Edité le 17/7/2007 par (gile)] Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD
funkkybebel Posté(e) le 17 juillet 2007 Posté(e) le 17 juillet 2007 Bonjour,merci, mais comme je suis nul en lisp, je n'ai rien compris. Pourriez-vous me coller dans un post le lisp complet qu'il faudra que je charge sous AutoCAD ? Merci.
(gile) Posté(e) le 17 juillet 2007 Posté(e) le 17 juillet 2007 J'ai ajouté le code de SelByObj dans le LISP donné plus haut, il suffit de tout charger et ça devrait fonctionner. Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD
funkkybebel Posté(e) le 19 juillet 2007 Posté(e) le 19 juillet 2007 Ok merci beaucoup ! Par contre j'ai remarqué un gros bug (qui vient d'autocad à mon avis). Quand je selectionne ma polyligne avec un zoom tout, alors, le lisp me comptabilise bien tous les blocs. Par contre, si je zoom sur une partie de l'écran (donc je ne vois plus ma polyligne entièrement), le lisp prend en considération l'affichage écran + polilygne. (c'est à dire que les limites de mon écran (ce que je vois) correspond à ce moment là à ma polyligne !!!! Pour palier à ce problème, comment pourrait-on rajouter un zoom objet sur la polyligne (dans le lisp) afin que avant le traitement de comptage, le lisp positionne l'affichage écran sur la totalité de la polyligne ? En théorie il suffirait de rajouter _zoom _omais où, ça je ne sais pas ! Merci de votre aide. [Edité le 19/7/2007 par funkkybebel]
(gile) Posté(e) le 20 juillet 2007 Posté(e) le 20 juillet 2007 Salut, eh oui, AutocAD ne permet pas une sélection par fenêtre, capture, polygone ou trajet hors de la fenêtre courante. Voilà une version de SelByObj qui le fait (zoom étendu avant la sélection et zoom précédent ensuite). Il suffit de remplacer la routine selbyOj que tu avais par celle-ci. ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou capturés, ;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée) ;;; Arguments : ;;; - ent : un objet (ename ou vla-object) ;;; - opt : un mode de sélection (Cp ou Wp) ;;; - fltr : un filtre de sélection (liste) ou nil ;;; ;;; modifié le 19/07/07 : fonctionne avec les objets hors fenêtre (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse")) (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 ) ) ) ) ((and (= (vla-get-ObjectName obj) "AcDbPolyline") (= (vla-get-Closed obj) :vlax-true) ) (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (cond (lst (vla-ZoomExtents (vlax-get-acad-object)) (setq ss (ssget (strcat "_" opt) lst fltr)) (vla-ZoomPrevious (vlax-get-acad-object)) ss ) ) ) ;;; SSOC pour sélectionner tous les objets capturés, suivant ;;; la vue, par le cercle, l'ellipse ou la polyligne. (defun c:ssoc (/ ss opt) (and (or (and (setq ss (cadr (ssgetfirst))) (= 1 (sslength ss)) ) (and (sssetfirst nil nil) (setq ss (ssget "_:S:E" (list '(-4 . " '(0 . "CIRCLE") '(-4 . " '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . " '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) ) ) (sssetfirst nil (ssdel (ssname ss 0) (SelByObj (ssname ss 0) "Cp" nil)) ) ) (princ) ) ;;; SSOF pour sélectionner tous les objets contenus, suivant ;;; la vue, dans le cercle, l'ellipse ou la polyligne. (defun c:ssof (/ ss opt) (and (or (and (setq ss (cadr (ssgetfirst))) (= 1 (sslength ss)) ) (and (sssetfirst nil nil) (setq ss (ssget "_:S:E" (list '(-4 . " '(0 . "CIRCLE") '(-4 . " '(0 . "ELLIPSE") '(41 . 0.0) (cons 42 (* 2 pi)) '(-4 . "AND>") '(-4 . " '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") ) ) ) ) ) (sssetfirst nil (SelByObj (ssname ss 0) "Wp" nil) ) ) (princ) ) Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD
funkkybebel Posté(e) le 26 juillet 2007 Posté(e) le 26 juillet 2007 Bonjour,désolé pour le temps de réponse, et je te remercie.Par contre ça ne marche pas et en plus je me suis trompé de programme. Est-il possible d'ajouter la particularité de faire un zoom OBJET (uniquement sur la polyligne et pas sur tout le dessin) avant de procéder au comptage sur le lisp suivant (cnt-blk.lsp) : (defun c:cnt-blk (/ obj ss n bl nom lst str file) (vl-load-com) (prompt "\nSélectionnez les blocs ou < Objet >: ") (if (not (setq ss (ssget '((0 . "INSERT"))))) (if (setq obj (car (entsel "\nSélectionnz l'objet délimitant la sélection: ") ) ) (if (member (cdr (assoc 0 (entget obj))) '("CIRCLE" "ELLIPSE" "LWPOLYLINE") ) (setq ss (SelByObj obj "WP" '((0 . "INSERT")))) (princ "\nEntité non valide.") ) (princ "\nAucune entité sélectionnée.") ) ) (if ss (progn (setq n (sslength ss)) (setq str (strcat "\n" (itoa n) " blocs dans la sélection\n") ) (repeat n (setq bl (vlax-ename->vla-object (ssname ss (setq n (1- n)))) nom (if (vlax-property-available-p bl 'EffectiveName) (vla-get-EffectiveName bl) (vla-get-Name bl) ) lst (if (assoc nom lst) (subst (cons nom (1+ (cdr (assoc nom lst)))) (assoc nom lst) lst ) (cons (cons nom 1) lst) ) ) ) (setq str (apply 'strcat (cons str (mapcar '(lambda (x) (strcat (car x) "\t" (itoa (cdr x)) "\n" ) ) lst ) ) ) ) (textscr) (princ str) (initget "Oui Non") (if (= (getkword "\nEnregistrer dans un fichier ? [Oui/Non] < Non >: " ) "Oui" ) (progn (setq file (open (getfiled "Créez ou sélectionnez un fichier" "" "xls" 1 ) "a" ) ) (princ str file) (close file) ) ) (graphscr) ) (princ "\nAucune entité sélectionnée.") ) (princ) ) Merci de votre aide à tous...
(gile) Posté(e) le 26 juillet 2007 Posté(e) le 26 juillet 2007 Salut,Par contre ça ne marche pasCurieux...Avec la nouvelle version de SelByObj (zoom étendu avant la sélection) ça fonctionne très bien chez moi. Est-il possible d'ajouter la particularité de faire un zoom OBJETSi tu pense qu'un zoom objet à la place du zoom étendu fonctionnera mieux, voici une nouvelle version de SelByObj qui fait un zoom sur l'emprise de l'objet sélectionné selon la vue courante.Ou encore, utiliser la routine ZoomObject :(ZoomObject (list obj)) à la place du (vla-zoomExtents (vlax-get-acad-object)) ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou capturés, ;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée) ;;; Arguments : ;;; - ent : un objet (ename ou vla-object) ;;; - opt : un mode de sélection (Cp ou Wp) ;;; - fltr : un filtre de sélection (liste) ou nil ;;; ;;; modifié le 26/07/07 : fonctionne avec les objets hors fenêtre (zoom objet) (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss app doc vdir plst minpt maxpt ) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse") ) (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 ) ) ) ) ((and (= (vla-get-ObjectName obj) "AcDbPolyline") (= (vla-get-Closed obj) :vlax-true) ) (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (cond (lst (setq app (vlax-get-acad-object) doc (vla-get-ActiveDocument app) ) (vla-delete (vla-get-ActiveViewport doc)) (setq vdir (vlax-get (vla-get-ActiveViewport doc) 'Direction) plst (mapcar '(lambda (x) (trans x 1 vdir) ) lst ) minpt (apply 'mapcar (cons 'min plst)) maxpt (apply 'mapcar (cons 'max plst)) ) (vla-ZoomWindow app (vlax-3d-point (trans minpt vdir 0)) (vlax-3d-point (trans maxpt vdir 0)) ) (setq ss (ssget (strcat "_" opt) lst fltr)) (vla-ZoomPrevious (vlax-get-acad-object)) ss ) ) ) Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD
funkkybebel Posté(e) le 27 juillet 2007 Posté(e) le 27 juillet 2007 Merci,mais est-il possible de l'integrer dans l'autre programme cité en réponse n°10 ? Merci, mais je suis une vraie quiche en lisp (j'ai bien essayé de recherché les lignes qui permettent de faire un zoom objet pour les repositionner dans l'autre programme mais je n'y vois que du feu)
(gile) Posté(e) le 30 juillet 2007 Posté(e) le 30 juillet 2007 Salut, J'ai modifié (ci-dessous) cnt-blk pour faire un zoom objet sur l'objet sélectionné avant de lancer SelByObj. Tel quel, la vue précedente est restituée ensuite, si tu veux rester en zoom objet, supprime la ligne : [surligneur](vla-ZoomPrevious (vlax-get-acad-object)) [/surligneur] J'ai aussi joint avec toutes les routines nécessaire, la version originale de SelByObj pour eviter des zooms inutiles. (defun c:cnt-blk (/ obj ss n bl nom lst str file) (vl-load-com) (prompt "\nSélectionnez les blocs ou : ") (if (not (setq ss (ssget '((0 . "INSERT"))))) (if (setq obj (car (entsel "\nSélectionnez l'objet délimitant la sélection: ") ) ) (if (member (cdr (assoc 0 (entget obj))) '("CIRCLE" "ELLIPSE" "LWPOLYLINE") ) (progn (ZoomObject (list (vlax-ename->vla-object obj))) (setq ss (SelByObj obj "WP" '((0 . "INSERT")))) [surligneur](vla-ZoomPrevious (vlax-get-acad-object))[/surligneur] ) (princ "\nEntité non valide.") ) (princ "\nAucune entité sélectionnée.") ) ) (if ss (progn (setq n (sslength ss)) (setq str (strcat "\n" (itoa n) " blocs dans la sélection\n") ) (repeat n (setq bl (vlax-ename->vla-object (ssname ss (setq n (1- n)))) nom (if (vlax-property-available-p bl 'EffectiveName) (vla-get-EffectiveName bl) (vla-get-Name bl) ) lst (if (assoc nom lst) (subst (cons nom (1+ (cdr (assoc nom lst)))) (assoc nom lst) lst ) (cons (cons nom 1) lst) ) ) ) (setq str (apply 'strcat (cons str (mapcar '(lambda (x) (strcat (car x) "\t" (itoa (cdr x)) "\n" ) ) lst ) ) ) ) (textscr) (princ str) (initget "Oui Non") (if (= (getkword "\nEnregistrer dans un fichier ? [Oui/Non] : " ) "Oui" ) (progn (setq file (open (getfiled "Créez ou sélectionnez un fichier" "" "xls" 1 ) "a" ) ) (princ str file) (close file) ) ) (graphscr) ) (princ "\nAucune entité sélectionnée.") ) (princ) ) ;; ZoomObject Effectue un zoom sur les objets contenus dans la liste ;; ;; Argument ;; objlst : une liste de vla-object ;; ;; Variables ;; dir : normale du plan de la vue courante ;; ang : angle de la vue courante ;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3) ;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4) ;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG) (defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst) (vl-load-com) (setq dir (mapcar '- (trans (getvar "viewdir") 1 0) (trans '(0 0 0) 1 0) ) ang (- (getvar "viewtwist")) 3x3 (mxm (mapcar '(lambda (x) (trans x 0 dir)) '((1 0 0) (0 1 0) (0 0 1)) ) (list (list (cos ang) (- (sin ang)) 0) (list (sin ang) (cos ang) 0) '(0 0 1) ) ) 4x4 (append (mapcar '(lambda (v o) (append v (list o)) ) 3x3 '(0 0 0) ) (list '(0 0 0 1)) ) ) (foreach obj objlst (vla-TransformBy obj (vlax-tmatrix (trp 4x4))) (vla-getBoundingBox obj 'minpt 'maxpt) (vla-TransformBy obj (vlax-tmatrix 4x4)) (setq ptlst (cons (vlax-safearray->list minpt) (cons (vlax-safearray->list maxpt) ptlst) ) ) ) (vla-ZoomWindow (vlax-get-acad-object) (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst)))) (vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst)))) ) ) ;; transpose une matrice Doug Wilson (defun trp (m) (apply 'mapcar (cons 'list m)) ) ;; Apply a transformation matrix to a vector by Vladimir Nesterovsky (defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) ) ;; Multiply two matrices by Vladimir Nesterovsky (defun mxm (m q) (mapcar '(lambda (r) (mxv (trp q) r)) m) ) ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou capturés, ;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée) ;;; Arguments : ;;; - ent : un objet (ename ou vla-object) ;;; - opt : un mode de sélection (Cp ou Wp) ;;; - fltr : un filtre de sélection (liste) ou nil (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse")) (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 ) ) ) ) ((and (= (vla-get-ObjectName obj) "AcDbPolyline") (= (vla-get-Closed obj) :vlax-true) ) (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (cond (lst (setq ss (ssget (strcat "_" opt) lst fltr)) ss ) ) ) Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD
Messages recommandés
Créer un compte ou se connecter pour commenter
Vous devez être membre afin de pouvoir déposer un commentaire
Créer un compte
Créez un compte sur notre communauté. C’est facile !
Créer un nouveau compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant