Sélection de bloc dans un buffer autour d'une polyligne

[Olivier Eckmann]

Bonjour,

Je dois sélectionner les blocs présents dans un buffer de 10 m autour d'une polyligne ouverte. En fait j'aurais des milliers de polylignes et des dizaines de millier de blocs à tester.

Je pensais traiter ma polyligne, la décaler à droite, récupérer la liste de ses sommets, la décaler à gauche, récupérer la liste des ses sommets, l'inverser et l'ajouter à la liste précédente.

Puis utiliser cette liste comme Capture Polygonale dans un SSGET (faire un zoom sur le polygone avant) ou bien tester le point d'insertion de chacun de mes blocs pour savoir s'il est à l'intérieur ou à l'extérieur de mon polygone (la solution que je pensais retenir).

Est-ce que vous voyez autre chose de plus performant (éventuellement sans passer par la création d'objet), ou une API toute faite que je ne connaitrais pas?

Pour le moment mon programme est écrit en Lisp, mais s'il y a une API en .Net, ça me convient aussi.

 

Merci, Olivier

[didier]

Bonjour @Olivier Eckmann

Perso, je ferais comme cité en LSP.
Créer une limite du couloir de recherche par une polyligne et lancer un ssget.

Toutefois, il ne faut pas qu'il y ait des bulges car seuls les vertex sont connus en coordonnées.

Amicalement

[lecrabe]

Hello @Olivier Eckmann & @didier

Alors j utilise parfois l excellente routine BUFFER (de Kent Cooper) qui dessine de magnifiques Buffers

autour de N Polylignes 2D (meme avec des Arcs ou "Courbees" mais NON "Splinees") et qq autres entites ...

Et apres j utilise les routines SSOC & SSOF de Gilles suivant mes besoins ...

BUFFER t aidera peut etre !?

Belle annee 2024, La Sante, Bye, lecrabe

PS: en provenance de mon stock de 3001 routines ...

 

 
;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/buffer-lisp-code-around-pline/td-p/5489225
;; 

;|
BUFFER.lsp [command name: BUFFER]
To put a "buffer" boundary outline of User-specified width around User-
  selected Offsettable object(s).
Offsets selected object(s) by specified distance, on both sides of open-ended
  objects, or for closed objects, User choice of both sides or outboard only [e.g.
  wetlands perimeter would not need inboard buffer edge].  Outboard-only
  would be equivalent to regular Offset, except BUFFER determines which
  way is outboard without need for User designation, always rounds convex
  corners of resulting Polylines, and remembers buffer width.
If object is open-ended [other than Xline], Offsets to both sides & wraps Arc(s)
  around end(s) [for Ray, only one end], connecting ends of offset elements to
  complete boundary.  If object is a Line, Arc or non-Fit/Splined Polyline, joins
  buffer boundary into one enclosing Polyline.
Option for resulting buffer boundary to be on same Layer as Source object
  or on Current Layer.
Buffer width & Layer choices independent of regular Offset's distance/Layer
  options, and are remembered and offered as default on subsequent use.
Under Both-ways option for closed objects, if Circle radius or closed Ellipse
  minor radius is not greater than buffer width, goes outboard only.
If Arc or partial Ellipse radius is not greater than buffer width, does not go
  inboard, but still wraps arcs around ends and if appropriate, trims to close.
Can fail or have unexpected results if Polyline/Spline has certain conditions,
  e.g. self-intersection, or [relative to buffer width] too-tight curvature or too-
  close interior approach or too-short end segment(s), or if Ellipse has minor
  radius too close to buffer width, because Offsetting can either fail or result
  in more than one object.
Kent Cooper, last edited 5 January 2017
|; 


;;;;; [doesn't yet work for open objects in different UCS, though for many
;;;;; objects it will look as though it did from current point of view]  

(defun C:BUFFER
  (/ *error* doc svnames svvals ss n ent edata closed new obj etype ang pton e1 e2)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (mapcar 'setvar svnames svvals); reset System Variables
    (vla-endundomark doc)
    (princ)
  ); defun - *error*

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (setq ; System Variable saving/resetting without separate variables for each:
    svnames '(osmode cmdecho peditaccept offsetgaptype blipmode offsetdist)
    svvals (mapcar 'getvar svnames)
  ); setq
  (mapcar 'setvar svnames '(1 1 0)); throughout-routine SV's

  (initget (if *bufferdist 0 1)); no Enter on first use
  (setq
    *bufferdist ; global variable
    (cond
      ( (getdist ; returns nil on Enter
          (strcat
            "\nBuffer width"
            (if *bufferdist (strcat " <" (rtos *bufferdist) ">") ""); prior-value default if present
            ": "
          ); strcat
        ); getdist
      ); User-input condition
      (*bufferdist); prior value [if present] on Enter
    ); cond & *bufferdist
  ); setq
  (initget "Current Source")
  (setq *bufferlay ; global variable
    (cond
      ( (getkword
          (strcat
            "\nLayer for buffer outlines [Current/Source] <"
            (cond (*bufferlay) ("Current")); prior value default if present **
            ">: "
          ); strcat
        ); getkword
      ); User-input condition
      (*bufferlay); prior value if present on Enter
      ("Current"); initial-use default on Enter with no prior value **
      ; ** if "Source" preferred as initial default, EDIT in two places above
    ); cond
  ); setq

  (prompt "\nTo add surrounding buffer outline(s),")
  (if
    (and 

      (setq ss (ssget "_:L" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY")))) 

        ; *LINE allows Line/Polyline [any kind]/Spline/Xline/Mline, but Mlines & 3D
        ; Polylines/Splines can't be offset, and don't want Polygon/Polyface Meshes, so: 

      (repeat (setq n (sslength ss))
        (setq edata (entget (setq ent (ssname ss (setq n (1- n))))))
        (if
          (or
            (member '(0 . "MLINE") edata)
            (and
              (member '(0 . "POLYLINE") edata); "heavy" type
              (/= (logand 88 (cdr (assoc 70 edata))) 0); 8 = 3DPoly, 16 or 64 = mesh
            ); and
            (not (vlax-curve-isPlanar ent)); 3D Spline
          ); or
          (ssdel ent ss); then -- remove [returns reduced ss]
          (if (vlax-curve-isClosed ent); else -- for Circle, closed Pline/Ellipse/Spline
            (setq closed T); then -- marker for both-ways question later
            T ; else [for non-nil return from (repeat) if last object is open]
          ); if [else]
        ); if
      ); repeat
      (> (sslength ss) 0); valid object(s) remaining
    ); and
    (progn ; then -- proceed
      (mapcar 'setvar svnames (list 0 0 1 1 0 *bufferdist)); set System Variables
      (if closed ; any remaining viable object(s) closed?
        (progn
          (initget "Both Outboard")
          (setq *buffersides ; global variable
            (cond
              ( (getkword
                  (strcat
                    "\nFor closed object, offset Both ways or Outboard only? [Both/Outboard] <"
                    (cond (*buffersides) ("Outboard")); prior value default if present **
                    ">: "
                  ); strcat
                ); getkword
              ); User-input condition
              (*buffersides); prior value if present on Enter
              ("Outboard"); initial-use default on Enter with no prior value **
              ; ** if "Both" preferred as initial default, EDIT in two places above
            ); cond
          ); setq
        ); progn
      ); if
      (repeat (setq n (sslength ss))
        (setq
          new (ssadd); initially empty for each
          obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
          etype (substr (vla-get-ObjectName obj) 5); without AcDb prefix
          closed (vlax-curve-isClosed obj); [re-use variable name]
        ); setq
        (if (= etype "Ray")
          (progn ; then [by pick because (vla-offset) method not available]
            (setq ang
              (angle
                (vlax-get obj 'BasePoint)
                (setq pton (vlax-get obj 'SecondPoint))
                  ; [less subject to seeing something else than end]
              ); angle
              pickoffs (list (getvar 'aperture) (getvar 'aperture))
            ); setq
            (while ; find pick location where Offset pick finds only this Ray
              (> (sslength (ssget "_C" (mapcar '+ pton pickoffs) (mapcar '- pton pickoffs))) 1)
                ; more than one thing within Osnap Aperture range?
              (setq pton (polar pton ang 1)); then -- move along Ray
            ); while
            (command "_.offset" "" pton (polar pton (- ang (/ pi 2)) *bufferdist) "")
            (setq e1 (entlast)) (ssadd e1 new)
            (command "_.offset" "" pton (polar pton (+ ang (/ pi 2)) *bufferdist) "")
            (setq e2 (entlast)) (ssadd e2 new)
          ); progn -- then
          (progn ; else [all other types]
            (vla-offset obj *bufferdist); always outboard of Arc/Circle/Ellipse
            (setq e1 (entlast))
            (if
              (and
                closed
                (= *buffersides "Outboard")
                (< (vla-get-Area (vlax-ename->vla-object e1)) (vla-get-Area obj)); went inboard
              ); and
              (entdel e1); then -- remove [other-way Offset wanted]
              (ssadd e1 new); else
            ); if
            (if ; Offset other way when applicable:
              (cond
                ((wcmatch etype "Line,Xline"))
                ((= etype "Arc") (> (vlax-get obj 'Radius) *bufferdist)); big enough
                ((= etype "Circle")
                  (and
                    (> (vlax-get obj 'Radius) *bufferdist); big enough
                    (= *buffersides "Both"); if asked for [always closed]
                  ); and
                ); Circle condition
                ((= etype "Ellipse")
                  (and
                    (> (vlax-get obj 'MinorRadius) *bufferdist); big enough
                    (if closed (= *buffersides "Both") T)
                  ); and
                ); Ellipse condition
                ((not closed)); open-ended Polyline/Spline
                ((= *buffersides "Both")); closed Polyline/Spline
                ((not (entget e1))); Outboard-only option with closed Polyline/Spline
                  ; first one was inboard under Outboard-only option, so deleted
                  ; [if (entget) succeeds, e1 was already outboard -- don't go other way]
              ); cond
              (progn ; second Offset
                (vla-offset obj (- *bufferdist))
                (setq e2 (entlast)) (ssadd e2 new)
              ); progn
            ); if
          ); progn -- else [other than Ray]
        ); if [Ray or otherwise]
        (if (and (not closed) (/= etype "Xline"))
          ; open-ended object other than Xline -- wrap Arcs around ends
          (progn ; then
            (command
              "_.arc" (vlax-curve-getStartPoint e1) "_c" (vlax-curve-getStartPoint obj)
                ; [spelling out "_cen[ter]" is taken as Osnap call]
              "_angle"
                (strcat
                  (if (= etype "Line") "" "-")
                  (angtos pi (getvar 'aunits) 8); any Units angle settings
                ); strcat
            ); command
            (ssadd (entlast) new)
            (if (/= etype "Ray"); other end for all but Ray
              (progn ; then
                (command
                  "_.arc" (vlax-curve-getEndPoint e1) "_c" (vlax-curve-getEndPoint obj)
                  "_angle"
                    (strcat
                      (if (= etype "Line") "-" "")
                      (angtos pi (getvar 'aunits) 8); any Units angle settings
                    ); strcat
                ); command
                (ssadd (entlast) new)
              ); progn
            ); if [not Ray]
            (if (wcmatch etype "*Polyline,Line,Arc"); connectable with Pedit

; [In older versions, Fit-curved or Spline-curved 2D Polyline will LOSE curvature
; if PEDIT/Joined; if an issue, replace above (if... line with:
;  (if
;    (or
;      (wcmatch etype "Line,Arc,Polyline"); always PEDIT/Joinable without loss
;      (and
;        (= etype "2dPolyline")
;        (= (vlax-get obj 'Type) 0); NOT Fit- or Spline-curved
;      ); and
;    ); or
; In newer versions, could use JOIN also with Spline, Ellipse or such Plines, BUT:
; JOIN when in a (command) function does NOT allow multiple initial selection
; as command-line version does, but requires selecting one object first, after which
; expectations vary with combinations of entity types, etc., e.g. if Line selected first,
; can't JOIN Arc to it, or vice versa.  If desired to use JOIN with other entity types
; than Lines/Arcs/"plain" Polylines joinable via PEDIT, do it manually afterwards.
; [As of Acad2016 -- may change in later versions.]

              (progn ; then
                (command "_.pedit" "_multiple" new "" "_join" "" ""); connect them
                (ssadd (entlast) new)
              ); progn
            ); if [Pedit-Joinable or not]
            (if
              (and
                (wcmatch etype "Arc,Ellipse")
                (not closed); if Ellipse, partial [i.e. not full with Outboard-only option]
                (not e2); did not go inboard [radius not more than buffer width]
              ); and
              (if (= etype "Arc"); then -- trim end-wrapping arcs if needed
                (if (not (vlax-curve-isClosed (setq e1 (entlast)))); [re-use variable name]
                  ; with close-enough ends, PEDIT/Join sometimes trims to closed, but if not:
                  (command "_.trim" e1 "" ; then
                    (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e1) ""
                  ); command
                ); if [joined-Polyline result around Arc]
                (if ; else [open Ellipse -- buffer not joined]
                  (vlax-invoke
                    (setq e1 (vlax-ename->vla-object (ssname new 1))); [re-use variable names]
                      ; 1st Arc [0 is outward-Offset Spline]
                    'IntersectWith ; Arcs cross? [won't always with Ellipses as with Arcs]
                    (setq e2 (vlax-ename->vla-object (ssname new 2))); 2nd
                    acExtendNone
                  ); vlax-invoke
                  (command "_.trim" new "" ; then
                    (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e2)
                  ); command
                ); if
              ); if [Arc vs. Ellipse]
            ); if [may need wrap-around-end Arcs trimmed]
          ); progn -- then
        ); if [open-ended non-Xline or otherwise]
        (command "_.chprop" new "" "_layer"
          (if (= *bufferlay "Source") (vla-get-Layer obj) (getvar 'clayer)) ""
        ); command
      ); repeat [through selection set]
    ); progn -- then
    (prompt "\nNo Offsettable object(s) selected."); else
      ; [whether because of object type(s) or locked Layer(s)]
  ); if [valid selection or not]

  (mapcar 'setvar svnames svvals); reset
  (vla-endundomark doc)
  (princ)
); defun

(vl-load-com) 

(prompt "\nType BUFFER to add buffer boundary outline(s) around object(s). ") 

 

[Fraid]

Bonjour,

Citation

Je dois sélectionner les blocs présents dans un buffer de 10 m autour d'une polyligne ouverte

Je suis peux être à coté de la plaque, mais en calculant simplement la distance en les vertex et les blocs?

On n'a pas le même Buffer, mais peut être que cela te conviendrais quand même,

surtout pour traiter un grand nombre d'objets.

[didier]

Bonjour @Fraid

Pourquoi pas, Si le nombre de blocs n'est pas trop élevé ça peut le faire.

C'est le dilemme habituel, à savoir est-il plus rapide de tout sélectionner puis traiter le jeu de sélection avec une condition de distance.
ou faire un ssget déjà filtré en position par rapport à la polyligne.

Si on a des milliers de blocs qui ne répondent pas à la condition, le filtre a posteriori sera chronophage, sinon ça peut le faire.

Amicalement

[Olivier Eckmann]

Je vais traiter par zone, car le projet total c'est 10 000 polylignes et environ 250 000 blocs.

Pour la zone, je calcule le buffer, puis l'enveloppe du buffer (boite rectangulaire). Et je teste d'abord si c'est dans la boite avant de tester plus finement si c'est à l'intérieur du buffer. C'est plus rapide pour éliminer les points hors zone.

Je pourrais préparer les données plus intelligemment en faisant des boites de boites (décomposition en quadtree), mais le traitement pourra de toute manière tourner sur plusieurs jours, mais peut-être en CoreConsole donc sans interface graphique, d'où la recherche sans appel à la sélection écran.

Pour le buffer, c'est bien une bande fermée verticalement à chaque extrémité et pas par une distance "arrondie". Donc l'analyse de distance entre le point et sa projection sur la polyligne n'est pas efficiente dans ce cas.

Il y a quelques années, j'avais lu un article intéressant qui proposait d'utiliser les fonctions d'analyse spatiale de SQLServer dans un plug-in AutoCAD développé en C#.

Et effectivement, ces fonctionnalités semblent aujourd'hui intégrées nativement dans les API .Net, notamment le buffer : https://learn.microsoft.com/en-us/dotnet/api/system.data.entity.sqlserver.sqlspatialservices.buffer?view=entity-framework-6.2.0 

Si je trouve un peu de temps, je vais me pencher dessus en complément des API d'AutoCAD Map pour l'analyse spatiale.

 

Je pense que je vais partir d'un calcul par décalage et assemblage des 2 poly décalées, puis analyse si le point est intérieur au buffer d'après ses coordonnées.

Merci pour vos réflexions. Si il y a d'autres idées, je suis toujours preneur.

[Fraid]

Je pense que je me suis mal exprimé.

Avec la fonction vlax-curve-getClosestPointTo par exemple.

 

; Distptpol
; Distance mini entre un point et une polyligne.
; Args: pt Liste de coordonnées (10.0 12.0 0.0)
;       vpol Objet vla "Polyligne" 
; Ret: Réel 
(defun distptpol (pt vpol / ret)
   (setq ret (distance (vlax-curve-getClosestPointTo vpol pt) pt))
)
(distptpol (getpoint "\nClique un point:") (vlax-ename->vla-object (car (entsel))))

A toi de sélectionner les blocs à traiter par rapport à la polyligne ( une selection avec les coordonnées des extrémités décaler de 10 par exemple)

[Olivier Eckmann]

Si j'ai bien compris, le problème c'est que le buffer est rond sur les extrémités, alors que je les veux "droites"

[lecrabe]

Hello @Olivier Eckmann

Modifier la routine BUFFER de Kent Cooper pour avoir une Droite et non pas un Arc 180 degres, me parait simple ?!

Comme en sortie de BUFFER, tu obtiens N Polylignes 2D closes, tu pourrais les utiliser pour sélectionner les Blocs !?

Mais Bon, je ne suis pas (plus en fait) développeur depuis environ 25 ans !

Good luck, Bye, lecrabe

[Fraid]

Un chalenge, comment ignorer cette zone.

 

[Olivier Eckmann]

Je viens de tester la routine Buffer. Elle ne fonctionne pas sir tu es réglé en unités topo : 0 au Nord et sens Topo. Dans ce cas les arcs sont dessiné à l'envers.

Un autre problème se pose lorsque la distance de décalage est trop grande par rapport à ta polyligne et qu'un des 2 côtés n'est plus décalable. Dans ce cas, on obtient une erreur Automation et ça s'arrête.

 

[lecrabe]

Hello

ZUT !

Bye, lecrabe

 

[Fraid]

Pour ignorer les blocs qui se trouve dans la zone "arrondie".

On garde de coté le point obtenu avec vlax-curve-getClosestPointTo

On calcul l'angle du bloc a ce dernier

On calcul l'angle premier point deuxième point de la polyligne.

Si le point du bloc est égal au premier point de la polyligne

et si l'angle du bloc n'est pas égal à celui de la poly - pi/2 et + pi/2 le bloc n'est pas sélectionne ...

on fait la même chose pour l'autre extrémité.

comme tu connais le Lisp je n'ais pas pris le temps de le coder.

Bonne pêche aux blocs !

[Fraid]

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.

[bonuscad]

Bonjour Olivier,

J'ai essayer d'approfondir rapidement ce que j'avais fais ICI

J'espère que cela pourra te convenir !

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
  (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
  (while (cadr ls)
    (if (zerop (car lb))
      (setq l_new (append l_new (list (car ls))))
      (progn
        (setq
          rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
          a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
        )
        (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
        (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
        )
      )
    )
    (setq ls (cdr ls) lb (cdr lb))
  )
  (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
  (setq
    inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
    ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
    nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
  )
  (repeat nm
    (setq
      p1 (polar pt_cen inc rad)
      inc (+ inc (/ (* pi 2.0) 36.0))
      lst (append lst (list p1))
    )
  )
  (setq
    p2 (polar pt_cen ang rad)
    lst (append lst (list p2))
  )
  (if (< sens 0.0) (reverse lst) lst)
)
(defun c:sel_blk_by_buffer ( / js acadObj AcDoc Space ss_all n ent vla_obj l_blg1 l_blg2 v l_blg e_width ename l_pt nw_pl lst ss nb)
  (initget 7)
  (setq e_width (getdist "\nLargeur de la zone tampon: "))
  (princ "\nSélectionner les polylignes à bufferiser")
  (setq js
    (ssget
      (list
        (cons 0 "*POLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
        (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
        (cons -4 "<NOT")
         (cons -4 "&") (cons 70 127)
        (cons -4 "NOT>")
      )
    )
  )
  (setq
    acadObj (vlax-get-acad-object)
    AcDoc (vla-get-ActiveDocument acadObj)
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (cond
    (js
      (vla-ZoomAll acadObj)
      (setq ss_all (ssadd))
      (repeat (setq n (sslength js))
        (setq
          ent (ssname js (setq n (1- n)))
          vla_obj (vlax-ename->vla-object ent)
          l_blg1 nil
          l_blg2 nil
        )
        (cond
          ((not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Offset (list vla_obj (* 0.5 e_width)))))
            (setq
              ename (vlax-ename->vla-object (entlast))
              l_pt
              (l-coor2l-pt
                (vlax-get ename 'Coordinates)
                (if (eq (vlax-get ename 'ObjectName) "AcDb2dPolyline")
                  T
                  nil
                )
              )
              v -1
            )
            (repeat (fix (vlax-curve-getEndParam ename))
              (setq l_blg1 (cons (vla-GetBulge ename (setq v (1+ v))) l_blg1))
            )
            (entdel (entlast))
            (cond
              ((not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Offset (list vla_obj (- (* 0.5 e_width))))))
                (setq
                  ename (vlax-ename->vla-object (entlast))
                  l_pt
                  (append
                    l_pt
                    (reverse
                      (l-coor2l-pt
                        (vlax-get ename 'Coordinates)
                        (if (eq (vlax-get ename 'ObjectName) "AcDb2dPolyline")
                          T
                          nil
                        )
                      )
                    )
                  )
                  v -1
                )
                (repeat (fix (vlax-curve-getEndParam ename))
                  (setq l_blg2 (cons (vla-GetBulge ename (setq v (1+ v))) l_blg2))
                )
                (entdel (entlast))
                (setq
                  l_pt (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt)))
                  l_blg (append (reverse l_blg1) '(0.0) (mapcar '- l_blg2))
                  nw_pl (vlax-invoke Space 'AddLightWeightPolyline l_pt)
                  v -1
                )
                (mapcar '(lambda (x) (vla-SetBulge nw_pl (setq v (1+ v)) x)) l_blg)
                (vla-put-Closed nw_pl 1)
                (vla-put-Color nw_pl 1)
                (vla-put-Normal nw_pl (vla-get-Normal vla_obj))
                (vla-put-Elevation nw_pl (vla-get-Elevation vla_obj))
                (vla-Update nw_pl)
                (setq
                  ename (vlax-ename->vla-object (entlast))
                  lst (def_bulg_pl (l-coor2l-pt l_pt nil) l_blg 0)
                  ss (ssget "_CP" (mapcar '(lambda (x) (trans (trans x ent 0) 0 1)) lst) '((0 . "INSERT")))
                  nb -1
                )
                (if ss
                  (repeat (sslength ss)
                    (ssadd (ssname ss (setq nb (1+ nb))) ss_all)
                  )
                )
              )
            )
          )
        )
      )
      (sssetfirst nil ss_all)
    )
  )
  (prin1)
)

 

[Olivier Eckmann]

Merci @bonuscad et @Fraid pour les codes.

J'ai testé tout ça et ça fonctionne. Je vais quand même garder le calcul du point d'insertion dans le buffer, plutôt que la sélection graphique, car ça me permet de travailler sans vérifier si les calques sont actifs ou non.

J'avais trouvé/bidouillé un code pour générer un buffer assez simple, mais sans test des décalages

(defun BufferLwPoly (oPoly dDist / oTemp lsPts)
  (setq oPolyVla (vlax-ename->vla-object oPoly))
  (vla-offset oPolyVla dDist)
  (setq oTemp (entlast))
  (vla-offset oPolyVla (- dDist))
  (command "_.pedit" "_m" oTemp (entlast) "" "_j" "_j" "_b" (* dDist 2.5) "")
  oTemp
)

 

Merci encore.

 

Olivier