Routine pour sélectionner les blocs qui sont uniquement sur des sommets de polylignes

[Stepane]

Bonjour à tous.

Ma question concerne toutes les versions d'Autocad, mais je l'ai mise dans le forum 2020-2024 faute de mieux.

J'ai à traiter des levés de réseaux. Il y a des dizaines de milliers de points de profondeur, qui sont sous forme de bloc, plus des polylignes 3D qui représentent le tracé des câbles/buses.

Les blocs sont des "pastilles" rondes, et leur point d'insertion est au milieu du rond.

Il s'agit de répartir ces blocs, qui, dans le fichier brut, sont tous dans le même calque, par réseau : dans le calque de leur réseau respectif. Ces blocs sont normalement (sauf exception qui demande une étude au cas par cas) placés chacun sur un sommet de polyligne.

C'est une tâche qui prend plusieurs jours à faire à la main.

L'idée serait d'avoir un LISP ou routine VBA capable de sélectionner tous les blocs dont le point d'insertion coïncide en x,y avec un sommet de polyligne, pour pouvoir leur assigner ensuite un calque. Évidemment, si la routine place les blocs dans le bon calque (celui de la poly) ce serait encore mieux.

Que le bloc touche la poly ne suffirait pas, il faut vraiment que le point d'insertion soit pile sur un sommet.

J'ai cherché dans Covadis et dans les Express Tools sans résultat ,et j'ai regardé sur les forums.

Par contre j'ai remarqué qu'il y a un certains nombres d'utilisateurs chevronnés qui rendent service aux autres, avec une grande générosité, en leur créant des routines ad hoc.

D'avance merci à ceux qui prendront du temps pour se pencher sur ma question!

 

[lecrabe]

Hello

SVP tu peux partager un petit DWG du style :

A gauche : AVANT  --  A droite : APRES 

Avec 3/4 Polylignes et 10/20 Bloc bien places / mal places

On parle de quel types de Polylignes : 2D Legere, 2D Lourde (Polyligne 2D splinee /courbee), 3D simple, 3D splinee

Bye, lecrabe

 

[Stepane]

Bien sûr. Je pense que le fichier suivant sera parfaitement représentatif :

extrait exemple.dwg

[vincentp010]

Un lisp bricolé vite fait à partir d'un autre qui sélectionnait des blocs aux sommets de polylignes

;###########################################################################
;# Copyright (C) 09-2023  Vincent PRELAT                                   #
;# This program is free software: you can redistribute it and/or modify	   #
;#  it under the terms of the GNU General Public License as published by   #
;#  the Free Software Foundation, either version 3 of the License, or      #
;#  any later version.                                                     #
;# This program is distributed in the hope that it will be useful,         #
;#  but WITHOUT ANY WARRANTY; without even the implied warranty of         #
;#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          #
;#  GNU General Public License for more details.                           #
;# You should have received a copy of the GNU General Public License       #
;#  along with this program.  If not, see <http://www.gnu.org/licenses/>.  #
;###########################################################################

; change layer of block of pline sommet


(defun c:blksomtolayer (/ entpol ent ent1 ent2 typ lay nbsom nbsom1 recher pt xx yy pt1 xx1 yy1 bl nbl cl)
  (setvar "cmdecho" 0)
  (command "_.undo" "_m")
  (setq entpol nil ent 0)


  (while (/= ent nil) 
    (progn 
      (print)
      (setq ent (entsel "Pointez la polyligne : "))
      (setq ent (car ent))
      (if (/= ent nil) 
        (progn 
          (setq typ (cdr (assoc 0 (entget ent))))
          (setq lay (cdr (assoc 8 (entget ent))))

          ;polyligne 3d -> 2d
          (if (= typ "POLYLINE") 
            (progn 
              (command "_copy" ent "" "0,0,0" "0,0,1e99")
              (command "_move" "_l" "" "0,0,0" "0,0,-1e99")
              (command "_explode" "_l")
              (command "_pedit" "_m" "_p" "" "_y" "_j" "0" "")
              (setq ent (entlast))
              (setq entpol ent)
              (setq typ (cdr (assoc 0 (entget ent))))
            )
          )

          (if (= typ "LWPOLYLINE") 
            (progn 
              (setq ent (entget ent))
              (setq nbsom (cdr (assoc 90 ent)))
              (setq nbsom1 1)
              (while (<= nbsom1 nbsom) 
                (setq recher nil)
                ;recherche les coordonnes du sommet suivant
                (while (/= recher 10) 
                  (setq ent (cdr ent))
                  (setq recher (caar ent))
                )
                (setq pt (cdr (assoc 10 ent)))
                (setq xx (car pt))
                (setq yy (cadr pt))

                (setq pt1 nil)
                (setq bl (ssget "x" 
                                (list '(-4 . "<OR") 
                                      (cons 8 "POINTS")
                                      (cons 8 "POINT")
                                      '(-4 . "OR>")
                                )
                         )
                )
                (if (= bl nil) (exit))
                (setq nb1 0)
                (setq nb (sslength bl))
                (while (< nb1 nb) 
                  (setq ent1 (ssname bl nb1))
                  (setq ent1 (entget ent1))
                  (setq pt1 (cdr (assoc 10 ent1)))
                  (setq xx1 (car pt1))
                  (setq yy1 (cadr pt1))
                  (if (and (equal xx xx1 0.001) (equal yy yy1 0.001)) 
                    (setq nb1 nb)
                    (setq pt1 nil)
                  )
                  (setq nb1 (+ nb1 1))
                )

                (if (/= pt1 nil) 
                  (progn 
                    (setq sl (ssget "p" (list (cons 10 pt1))))
                    (if (= sl nil) (exit))
                    (setq nb1 0)
                    (setq nb (sslength sl))
                    (while (< nb1 nb) 
                      (setq ent2 (ssname sl nb1))
                      (setq ent2 (append (entget ent2) (list (cons 8 lay))))
                      (entmod ent2)
                      (setq nb1 (+ nb1 1))
                    )
                  )
                )

                (setq aff (strcat (rtos nbsom1 5 0) "/" (rtos nbsom 5 0)))
                (grtext -2 aff)
                (setq nbsom1 (+ nbsom1 1))
              )
            )
          )
          (if (/= entpol nil) 
            (command "_erase" entpol "")
          )
        )
      )
      (if (/= ent nil) (setq ent 0) (setq ent nil))
    )
  )

)

 

[bonuscad]

Ou alors ceci!

(defun c:change_layer_blk&vertex ( / ss_blk ss_poly i ent dxf_ent next_dxf nam_lay lst_pt nw_pt n ent_blk dxf_blk pt_ins)
  (setq ss_blk (ssget "_X" '((0 . "INSERT") (2 . "DETECT"))))
  (cond
    (ss_blk
      (princ "\nSelect 3Dpolylines")
      (setq ss_poly (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))
      (cond
        (ss_poly
          (repeat (setq i (sslength ss_poly))
            (setq
              ent (ssname ss_poly (setq i (1- i)))
              dxf_ent (entget ent)
              next_dxf (entget (entnext (cdar dxf_ent)))
              nam_lay (assoc 8 dxf_ent)
              lst_pt nil
            )
            (while (/= (cdr (assoc 0 next_dxf)) "SEQEND")
              (if (eq (cdr (assoc 70 next_dxf)) 32)
                (setq
                  nw_pt (cdr (assoc 10 next_dxf))
                  lst_pt (cons nw_pt lst_pt)
                )
              )
              (setq next_dxf (entget (entnext (cdar next_dxf))))
            )
            (repeat (setq n (sslength ss_blk))
              (setq
                ent_blk (ssname ss_blk (setq n (1- n)))
                dxf_blk (entget ent_blk)
                pt_ins (cdr (assoc 10 dxf_blk))
              )
              (mapcar
                '(lambda (x)
                  (if (equal (list (car pt_ins) (cadr pt_ins)) (list (car x) (cadr x)) 1E-08)
                    (entmod (subst nam_lay (assoc 8 dxf_blk) dxf_blk))
                  )
                )
                lst_pt
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)

 

[Stepane]

Et bien, vous m'en bouchez un coin! 😲

Moi qui n'étais même pas sûr de recevoir du tout une réponse!

Vous faites la course à celui qui programmera le plus vite?

Bravo et merci à tous les deux.

Vincent, je n'ai pas réussi à faire fonctionner ton lisp. Si tu veux approfondir un peu, le résultat est que les poly3D sont converties en poly2D. Par contre les blocs sont inchangés.

Bonuscad, ton lisp fonctionne très bien.

Ce sera des jours de travail de gagné!

En mon nom et en celui de mon supérieur, un grand merci! 🤩

[vincentp010]

J'ai modifié vite fait un vieux lisp, je n'ai peut être pas assez testé.

Si celui de Bonuscad fonctionne, tant mieux