Déplacer / Sélectionner Bloc

[helas]

Bonjour,

Je suis à la recherche d'un LSP qui pourrait me permettre soit de déplacer automatiquement plusieurs blocs (mais "le même") sur une polyline (accrocher) au plus "proche" mais source d'erreurs je pense et/ou un LSP qui permet de sélectionner et retrouver les blocs qui ne sont pas accrochés sur la polyligne ainsi de pouvoir les changer manuellement.

Je viens de test un LSP trouvé sur un ancien topic mais sans succès et de plus j'ai des paramètres qui me sont inutiles.

 

Voici en screen l'exemple 

Ici le 500 C doit être accrocher sur la polyligne via le point 

Ici également :

 

Comme ici ok :

 

Les polylignes sont pour la plupart du temps coupées entre chaque cercle noir que vous pouvez apercevoir.

Merci d'avance, bonne journée.

lsp.dwg

[Luna]

Coucou,

Essaye ceci est dit moi si cela convient à ta demande 😉

(defun c:MB2CP (/ b jsel i name lsel n ent bpt lpt d lst)
  (while
    (not
      (and
        (setq name (entsel "\nSelect a block :"))
        (setq name (car name))
        (= "INSERT" (cdr (assoc 0 (entget name))))
        (setq name (vlax-ename->vla-object name))
        (setq b (vlax-get name 'EffectiveName))
      )
    )
    (princ "\nInvalid selection...")
  )
  (princ "\nPlease, select blocks...")
  (if (setq jsel (ssget (list (cons 0 "INSERT") (cons 2 (strcat "`*U*," b)))))
    (progn
      (princ "\nPlease, select polylines...")
      (setq lsel (ssget '((0 . "LWPOLYLINE"))))
      (repeat (setq i (sslength jsel))
        (setq
          name (ssname jsel (setq i (1- i)))
          bpt (cdr (assoc 10 (entget name)))
          lst nil
        )
        (if (= b (vlax-get (vlax-ename->vla-object name) 'EffectiveName))
          (progn
            (repeat (setq n (sslength lsel))
              (setq
                ent (ssname lsel (setq n (1- n)))
                lpt (vlax-curve-getClosestPointTo ent bpt T)
                d (distance bpt lpt)
                lst (cons (cons d lpt) lst)
              )
            )
            (setq lpt (cdar (vl-sort lst '(lambda (p1 p2) (< (car p1) (car p2))))))
            (entmod (subst (cons 10 lpt) (assoc 10 (entget name)) (entget name)))
          )
        )
      )
    )
  )
  (command "_ATTSYNC" "_Name" b)
  (princ)
)

Du coup le programme MB2CP (= Move Blocks to Closest Polyline) demandera dans un premier temps de sélectionner une référence de bloc (pour déterminer le nom de la définition de bloc que tu souhaites bouger et ainsi filtrer la sélection pour plus tard), puis il te faudra sélectionner tes blocs (la sélection sera filtrée pour ne sélectionner que des blocs correspondant au nom spécifié plus tôt + les blocs dynamiques et prend en compte la pré-sélection). Tu peux prendre tous tes blocs en même temps cela ne devrait pas poser de soucis. Ensuite il te faudra sélectionner tes polylignes (ici encore c'est une sélection filtrée sur les objets polylignes et tu peux en sélectionner plusieurs).
Une fois tes sélections faites, le programme va regarder pour chaque références de bloc si son nom correspond bien au nom spécifié plus tôt (cela permet de fonctionner aussi avec les blocs dynamiques, c'est pour chat), puis va regarder la position du bloc par rapport à chaque polyligne sélectionnées et ne considérer que le nouveau point qui sera le plus proche du bloc. Une fois ce calcul fait, la référence de bloc sera modifiée pour correspondre aux nouvelles coordonnées (le Z est pris en compte également). En revanche il faut faire attention car si un bloc n'est pas proche d'une polyligne, il perdra sa position initiale et aura pour nouvelle coordonnées le sommet d'une polyligne la plus proche, donc il faut s'assurer d'avoir toujours une polyligne qui correspond à chaque bloc.

J'ai fait quelques tests sur ton .dwg et si tu suis les instruction (notamment celle de toujours avoir une polyligne en face de ton bloc !), le programme fonctionne parfaitement selon moi..

Bisous,
Luna

[lecrabe]

Hello @Luna

SVP je pense qu'il faut ajouter une question du genre "Distance maximum (Défaut=1.0) ?"

Au delà on ne "bouge" pas le Bloc !

Merci, Bye, lecrabe 

 

[helas]

il y a une heure, Luna a dit :

Coucou,

Essaye ceci est dit moi si cela convient à ta demande 😉

(defun c:MB2CP (/ b jsel i name lsel n ent bpt lpt d lst)
  (while
    (not
      (and
        (setq name (entsel "\nSelect a block :"))
        (setq name (car name))
        (= "INSERT" (cdr (assoc 0 (entget name))))
        (setq name (vlax-ename->vla-object name))
        (setq b (vlax-get name 'EffectiveName))
      )
    )
    (princ "\nInvalid selection...")
  )
  (princ "\nPlease, select blocks...")
  (if (setq jsel (ssget (list (cons 0 "INSERT") (cons 2 (strcat "`*U*," b)))))
    (progn
      (princ "\nPlease, select polylines...")
      (setq lsel (ssget '((0 . "LWPOLYLINE"))))
      (repeat (setq i (sslength jsel))
        (setq
          name (ssname jsel (setq i (1- i)))
          bpt (cdr (assoc 10 (entget name)))
          lst nil
        )
        (if (= b (vlax-get (vlax-ename->vla-object name) 'EffectiveName))
          (progn
            (repeat (setq n (sslength lsel))
              (setq
                ent (ssname lsel (setq n (1- n)))
                lpt (vlax-curve-getClosestPointTo ent bpt T)
                d (distance bpt lpt)
                lst (cons (cons d lpt) lst)
              )
            )
            (setq lpt (cdar (vl-sort lst '(lambda (p1 p2) (< (car p1) (car p2))))))
            (entmod (subst (cons 10 lpt) (assoc 10 (entget name)) (entget name)))
          )
        )
      )
    )
  )
  (command "_ATTSYNC" "_Name" b)
  (princ)
)

Du coup le programme MB2CP (= Move Blocks to Closest Polyline) demandera dans un premier temps de sélectionner une référence de bloc (pour déterminer le nom de la définition de bloc que tu souhaites bouger et ainsi filtrer la sélection pour plus tard), puis il te faudra sélectionner tes blocs (la sélection sera filtrée pour ne sélectionner que des blocs correspondant au nom spécifié plus tôt + les blocs dynamiques et prend en compte la pré-sélection). Tu peux prendre tous tes blocs en même temps cela ne devrait pas poser de soucis. Ensuite il te faudra sélectionner tes polylignes (ici encore c'est une sélection filtrée sur les objets polylignes et tu peux en sélectionner plusieurs).
Une fois tes sélections faites, le programme va regarder pour chaque références de bloc si son nom correspond bien au nom spécifié plus tôt (cela permet de fonctionner aussi avec les blocs dynamiques, c'est pour chat), puis va regarder la position du bloc par rapport à chaque polyligne sélectionnées et ne considérer que le nouveau point qui sera le plus proche du bloc. Une fois ce calcul fait, la référence de bloc sera modifiée pour correspondre aux nouvelles coordonnées (le Z est pris en compte également). En revanche il faut faire attention car si un bloc n'est pas proche d'une polyligne, il perdra sa position initiale et aura pour nouvelle coordonnées le sommet d'une polyligne la plus proche, donc il faut s'assurer d'avoir toujours une polyligne qui correspond à chaque bloc.

J'ai fait quelques tests sur ton .dwg et si tu suis les instruction (notamment celle de toujours avoir une polyligne en face de ton bloc !), le programme fonctionne parfaitement selon moi..

Bisous,
Luna

Bonjour Luna,

Je viens de réaliser un test et visiblement cela fonctionne à merveille, merci beaucoup pour ton aide et la rapidité de réponse.

Bisous.

[Luna]

@lecrabe,

En effet, j'ai fait cela un peu vite donc ci-dessous une version améliorée pour définir une distance maximale (valeur par défaut = 1.0 unité) sans prendre en compte le Z dans ce calcul de distance et j'ai également ajouter un retour texte dans la ligne de commande pour donner le nombre de blocs déplacés avec succès 😉

(defun c:MB2CP (/ 2Dp b m jsel i name lsel n ent bpt lpt d lst e esel)
  (defun 2Dp (p)
    (cond
      ( (not (listp p)))
      ( (= 2 (length p)) p)
      ( (= 3 (length p)) (reverse (cdr (reverse p))))
    )
  )
  (while
    (not
      (and
        (setq name (entsel "\nSelect a block :"))
        (setq name (car name))
        (= "INSERT" (cdr (assoc 0 (entget name))))
        (setq name (vlax-ename->vla-object name))
        (setq b (vlax-get name 'EffectiveName))
      )
    )
    (princ "\nInvalid selection...")
  )
  (if (null (setq e 0 m (getdist "\nMaximum distance allowed <1.0> : ")))
    (setq m 1.0)
  )
  (princ "\nPlease, select blocks...")
  (if (setq esel (ssadd) jsel (ssget (list (cons 0 "INSERT") (cons 2 (strcat "`*U*," b)))))
    (progn
      (princ "\nPlease, select polylines...")
      (setq lsel (ssget '((0 . "LWPOLYLINE"))))
      (repeat (setq i (sslength jsel))
        (setq
          name (ssname jsel (setq i (1- i)))
          bpt (cdr (assoc 10 (entget name)))
          lst nil
        )
        (if (= b (vlax-get (vlax-ename->vla-object name) 'EffectiveName))
          (progn
            (repeat (setq n (sslength lsel))
              (setq
                ent (ssname lsel (setq n (1- n)))
                lpt (vlax-curve-getClosestPointTo ent bpt T)
                d (distance bpt lpt)
                lst (cons (cons d lpt) lst)
              )
            )
            (setq
              lst (vl-sort lst '(lambda (p1 p2) (< (car p1) (car p2))))
              lpt (cdar lst)
            )
            (if (<= (distance (2Dp lpt) (2Dp bpt)) m)
              (and
                (entmod (subst (cons 10 lpt) (assoc 10 (entget name)) (entget name)))
                (setq e (1+ e))
              )
              (ssadd name esel)
            )
          )
        )
      )
      (command "_ATTSYNC" "_Name" b)
      (princ
        (strcat
          "\nNumber of block moved successfully : "
          (itoa e)
          " / "
          (itoa (sslength jsel))
        )
      )
      (sssetfirst nil esel)
    )
  )
  (princ)
)

Dis-moi si tu as d'autres remarques :3

Bisous,
Luna

Modifié le 29 avril 2022 par Luna
Modification du code : (ssadd) pour renvoyer un jeu de sélection des blocs n'ayant pas été déplacés

[helas]

Il y a 17 heures, Luna a dit :

@lecrabe,

En effet, j'ai fait cela un peu vite donc ci-dessous une version améliorée pour définir une distance maximale (valeur par défaut = 1.0 unité) sans prendre en compte le Z dans ce calcul de distance et j'ai également ajouter un retour texte dans la ligne de commande pour donner le nombre de blocs déplacés avec succès 😉

(defun c:MB2CP (/ 2Dp b m jsel i name lsel n ent bpt lpt d lst e)
  (defun 2Dp (p)
    (cond
      ( (not (listp p)))
      ( (= 2 (length p)) p)
      ( (= 3 (length p)) (reverse (cdr (reverse p))))
    )
  )
  (while
    (not
      (and
        (setq name (entsel "\nSelect a block :"))
        (setq name (car name))
        (= "INSERT" (cdr (assoc 0 (entget name))))
        (setq name (vlax-ename->vla-object name))
        (setq b (vlax-get name 'EffectiveName))
      )
    )
    (princ "\nInvalid selection...")
  )
  (if (null (setq e 0 m (getdist "\nMaximum distance allowed <1.0> : ")))
    (setq m 1.0)
  )
  (princ "\nPlease, select blocks...")
  (if (setq jsel (ssget (list (cons 0 "INSERT") (cons 2 (strcat "`*U*," b)))))
    (progn
      (princ "\nPlease, select polylines...")
      (setq lsel (ssget '((0 . "LWPOLYLINE"))))
      (repeat (setq i (sslength jsel))
        (setq
          name (ssname jsel (setq i (1- i)))
          bpt (cdr (assoc 10 (entget name)))
          lst nil
        )
        (if (= b (vlax-get (vlax-ename->vla-object name) 'EffectiveName))
          (progn
            (repeat (setq n (sslength lsel))
              (setq
                ent (ssname lsel (setq n (1- n)))
                lpt (vlax-curve-getClosestPointTo ent bpt T)
                d (distance bpt lpt)
                lst (cons (cons d lpt) lst)
              )
            )
            (setq
              lst (vl-sort lst '(lambda (p1 p2) (< (car p1) (car p2))))
              lpt (cdar lst)
            )
            (if (<= (distance (2Dp lpt) (2Dp bpt)) m)
              (and
                (entmod (subst (cons 10 lpt) (assoc 10 (entget name)) (entget name)))
                (setq e (1+ e))
              )
            )
          )
        )
      )
      (command "_ATTSYNC" "_Name" b)
      (princ
        (strcat
          "\nNumber of block moved successfully : "
          (itoa e)
          " / "
          (itoa (sslength jsel))
        )
      )
    )
  )
  (princ)
)

Dis-moi si tu as d'autres remarques :3

Bisous,
Luna

Bonjour,

Merci pour cette update !
C'est vraiment intéressant et puissant.
J'aimerai biens maitriser et pouvoir me débrouiller pour me confectionner des LISPS mais cela demande du temps et pas mal d'apprentissage ...
(VBA également)
Encore merci à vous.

Bonne journée.

[helas]

Bonjour,

Je me permets de revenir vers toi car j'ai toujours le même résultat

"\nNumber of block moved successfully : "

Est-ce possible de faire une sélection sur les XX non déplacés car j'ai certains bloc qui ne bougent pas.
Que je puisse les afficher d'une autres couleurs pour comprendre le problème ou même le déplacer manuellement 😉

Bonne journée 

[Luna]

Coucou,

J'ai modifié mon code ci-dessus pour renvoyer un jeu de sélection contenant les blocs trop éloignés des polylignes spécifiées. As-tu essayé d'augmenter la distance maximale pour voir si cela corrige le problème pour ces blocs ?

Bisous,
Luna

[helas]

Il y a 2 heures, Luna a dit :

Coucou,

J'ai modifié mon code ci-dessus pour renvoyer un jeu de sélection contenant les blocs trop éloignés des polylignes spécifiées. As-tu essayé d'augmenter la distance maximale pour voir si cela corrige le problème pour ces blocs ?

Bisous,
Luna

Super merci

Visiblement j'ai quelques problèmes sur certains points liés à l'élévation sur les polylignes (que je dois forcer en Z = 0)
Pourtant j'ai des Z = 50+ qui passent sans problème et d'autres non.

Etonnant car on s'occupe pas du Z il me semble.

Bises.

[Luna]

C'est étonnant en effet, car pour le calcul de distance j'ai fait en sorte de ne pas considérer l'élévation Z...
Si jamais, tu peux fournir un .dwg avec quelques cas fonctionnels et d'autres non fonctionnels, et je regarderais s'il y a une explication aux problèmes rencontrés (lorsque j'aurais un peu de temps)..

Bisous,
Luna

[jmp33]

Bonjour à tout le monde et bonne année à tous.

Je reviens un peu sur le petit programme lisp réalisé par Luna situé au dessus dans la conversation. Je souhaitais l'utiliser pour déplacer des blocs points sur une polyligne proche.

Le programme fonctionne mais les blocs sont modifiés suite au déplacement. En fait les attributs sont revenus conformes au bloc d'origine (bloc 10 en l’occurrence dans notre fichier). Ce qui fait que les numéros ne sont plus dans le calque N et les altitudes ne sont plus dans le calque du bloc avant déplacement. Tout a été mis dans le calque 0.

Pensez-vous qu'il soit possible d'effectuer ce déplacement sans ces changements dans les calques des attributs et également sans changement sur la position de ces attributs par rapport au point d'insertion du bloc (piqué du point) car là aussi la position change pour ces attributs.

Je joins un fichier avant déplacement pour bien montrer le bloc avant changement et un fichier après changement.

Merci pour votre aide car je ne sais pas trop m'en sortir facilement et je ne suis vraiment pas un pro du lisp.

Dessin3.dwg Dessin2.dwg

[Olivier Eckmann]

Mettre un point virgule devant la ligne : 

;(command "_ATTSYNC" "_Name" b)

pour ne pas lancer la synchronisation qui réinitialise tous les blocs selon leur définition.

Seul le point d'insertion sera modifié, mais pas la position des attributs. Il conserve leur position absolue (pas en relatif par rapport au piqué de point)

Olivier

[jmp33]

Bonjour,

Pas trop actif sur ce forum qui pourtant m'apporte souvent les réponses à certains problèmes lisp, je ne vois la réponse de Olivier Eckmann que maintenant !

Comme il n'est jamais trop tard pour bien faire, je voulais te remercier Olivier pour cette réponse.

JM