Classement

Bonjour, En fin de compte, j'ai pris le temps, cela peut servir. (vl-load-com) ; blocsinbuffer ; Renvois la liste des blocs se trouvant dans des Buffers (emprise autour d'une polyligne). ; Arg: ; pols (liste d'objet vla) ; blocs (liste d'objet vla) ; buf (entier ou réel) emprise du buffer ; ; Ret: Liste des blocs dans les buffers (liste d'objet vla) (defun blocsinbuffer ( pols blocs buf / ptpol1 ptpol2 pt1 pt2 dim ret) ; Pour chaque chaque polylignes. (foreach pol pols ; Extrémités de la polyligne. (setq ptpol1 (vlax-curve-getStartPoint pol) ptpol2 (vlax-curve-getEndPoint pol)) ; Pour chaque blocs (foreach bloc blocs ; Point d'insertion. (setq pt1 (vlax-get bloc 'InsertionPoint) ; Point situé sur la polyligne le plus proche du bloc. pt2 (vlax-curve-getClosestPointTo pol pt1) ; Distance entre ces 2 points. dim (distance pt1 pt2)) (and (<= dim buf) ; Si le bloc n'est pas en extrémité. (not (member pt2 (list ptpol1 ptpol2))) ; Ajout du bloc dans la liste en retour. (setq ret (cons bloc ret) ; Suppression du bloc dans la liste des blocs. blocs (vl-remove bloc blocs)) ) ) ) ret ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:bufbloc ( / acdc mod lblocs lpols objname lbuf emp) (setq acdc (vla-get-activedocument (vlax-get-acad-object)) mod (vla-get-modelspace acdc) emp (getreal "Emprise du Buffer: ") ) (vlax-for obj mod (setq objname (vla-get-ObjectName obj)) (if (= objname "AcDbBlockReference") (setq lblocs (cons obj lblocs))) (if (= objname "AcDbPolyline") (setq lpols (cons obj lpols))) ) (setq lbuf (blocsinbuffer lpols lblocs emp)) (foreach bloc lblocs (if (not (member bloc lbuf)) (vla-erase bloc)) ) (princ (strcat "\n " (itoa (length lbuf)) " Blocs dans les Buffers.")) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:odbx_bufbloc (/ dir axdoc mod objname lblocs lfil lpols lbuf emp) (if (and (setq dir (getdir)) (setq lfil (vl-directory-files dir "*.dwg" 1))) (progn (setq emp (getreal "Emprise du Buffer: ")) (foreach f lfil (if (setq axdoc (getaxdbdoc (strcat dir f))) (progn (setq mod (vla-get-modelspace axdoc) lblocs '() lpols '()) (vlax-for obj mod (setq objname (vla-get-ObjectName obj)) (if (= objname "AcDbBlockReference") (setq lblocs (cons obj lblocs))) (if (= objname "AcDbPolyline") (setq lpols (cons obj lpols))) ) (setq lbuf (blocsinbuffer lpols lblocs emp)) (foreach bloc lblocs (if (not (member bloc lbuf)) (vla-erase bloc)) ) (vla-saveas axdoc (strcat dir f)) (vlax-release-object axdoc) ) (princ (strcat "\n" f ": Illegible or corrupt.")) ) ) (princ "\n " (itoa (length lfil)) " fichiers traités") ) (princ "\nHave you lost your way?") ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun getdir( / shell rep) (setq shell (vlax-create-object "Shell.Application") rep (vlax-invoke shell 'browseforfolder 0 "Choose folder" 512 "" ) ) (vlax-release-object shell) (strcat (vlax-get-property (vlax-get-property rep 'self) 'path) "\\") ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun getaxdbdoc (filename / axdbdoc release) (setq axdbdoc (vlax-create-object (if (< (setq release (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa release)) ) ) ) (if (vl-catch-all-apply 'vla-open (list axdbdoc filename)) (not (vlax-release-object axdbdoc)) axdbdoc ) ) La fonction blocsinbuffer, peut être lancé dans le dessin courant avec la commande bufbloc, ou pour traiter un dossier avec odbx_bufbloc. C'est plus rapide qu'avec décaler. Dans mon exemple je supprime les blocs qui ne se trouve pas dans le buffer.

Bonjour, Aurais tu plus de facilité avec un code plus simple? Par exemple! (defun c:test ( / js ent l_pt closed lg_seg typ) (while (null (setq js (ssget "_+.:E:S" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>")))))) (setq ent (ssname js 0) l_pt (list (vlax-curve-getEndPoint ent)) closed (vlax-curve-isClosed ent) ) (initget 91) (setq lg_seg (getdist "\nLongueur des segments: ")) (command "_.measure" ent lg_seg) (while (and (= (cdr (assoc 0 (entget (entlast)))) "POINT") (not (equal (entlast) ent)) ) (setq l_pt (cons (cdr (assoc 10 (entget (entlast)))) l_pt)) (entdel (entlast)) ) (setq l_pt (cons (vlax-curve-getStartPoint ent) l_pt)) (cond (l_pt (initget "2D 3D Spline") (setq typ (getkword "\nDessiner une polyligne [2D/3D/Spline]?: ")) (cond ((eq typ "2D") (command "_.pline")) ((eq typ "3D") (command "_.3dpoly")) ((eq typ "Spline") (command "_.spline")) ) (foreach n l_pt (command "_none" n)) (if (eq typ "Spline") (if closed (command "_close" "") (command "" "" "")) (if closed (command "_close") (command "")) ) ) ) (initget "Oui Non") (if (eq (getkword "\nEffacer l'entité source? [Oui/Non] <N>: ") "Oui") (entdel ent) ) (prin1) )

Bonjour, Je pense qu'avec le nouveau module "zone de structures de la V18.1" il y a quelque chose a faire. Je reviens vers vous très vite avec une petite vidéo