Insérer un bloc sur chaque sommet d'une polyligne avec incrémentation automatique du numéro

[nen]

Bonjour le Forum,
J'ai besoin de votre aide.
Le code ci-dessous est censé insérer un bloc (contenant deux attributs "DESIGNATION" et "LOCAL") à chaque sommet d'une polyligne (chemin). Après avoir sélectionné la polyligne, il demande un point de départ, puis un numéro de départ, puis incrémente ce numéro de 1 pour chaque sommet de la polyligne et insère le bloc à ces positions.
Le problème est que les blocs sont bien insérés, mais je ne parviens pas à les voir ni à les sélectionner. La seule façon de les localiser est en utilisant leur "Handle", et si j'explose un bloc, les attributs deviennent visibles. Je ne comprends pas.
Si quelqu'un pouvait m'aider et m'expliquer pourquoi je ne peux pas voir les blocs, ce serait sympa.
 

(defun c:InsertInfoLocaux (/ ent obj pts p0 num prefix suffix count blkName blkLayer blkScale blkRotation objType vertexList i coordList blkEnt attrEnt insPt) 
  (setq blkName "LOCAUX"      ;; Nom du bloc
        blkLayer "INFORMATIONS"    ;; Nom du calque
        blkScale 1.0
        blkRotation 0.0)
  
  ;; Vérifier si le bloc existe dans le dessin
  (if (not (tblsearch "BLOCK" blkName))
    (progn
      (princ "\nErreur : Le bloc LOCAUX n'existe pas dans le dessin.")
      (exit)))
  
  ;; Sélection de la polyligne
  (setq ent (car (entsel "\nSélectionnez une polyligne : ")))
  (if (and ent
           (setq obj (vlax-ename->vla-object ent))
           (setq objType (cdr (assoc 0 (entget ent))))
           (or (eq objType "LWPOLYLINE") (eq objType "POLYLINE")))
    (progn
      ;; Récupération des sommets
      (setq pts (cond
                 ;; Polyligne légère (LWPOLYLINE)
                 ((eq objType "LWPOLYLINE")
                  (setq coordList (vlax-get obj 'Coordinates)
                        pts '()
                        i 0)
                  (while (< i (length coordList))
                    (setq pts (append pts (list (list (nth i coordList) (nth (1+ i) coordList) 0))))
                    (setq i (+ i 2)))
                  pts)
                 ;; Polyligne 2D (avec sommets VERTEX)
                 ((eq objType "POLYLINE")
                  (setq vertexList '())
                  (setq ent (entnext ent))
                  (while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
                    (if (= (cdr (assoc 0 (entget ent))) "VERTEX")
                        (setq vertexList (append vertexList (list (cdr (assoc 10 (entget ent))))))
                    )
                    (setq ent (entnext ent))
                  )
                  vertexList
                 )
      ))
      
      (if pts
        (progn
          ;; Sélection du point de départ
          (setq p0 (getpoint "\nSélectionnez le point de départ : "))
          
          ;; Demande du numéro de départ
          (setq num (getstring "\nEntrez le numéro de départ (ex: SURFACE-01) : "))
          
          ;; Séparation du préfixe et du suffixe
          (setq prefix (vl-string-left-trim "0123456789" num)
                suffix (atoi (vl-string-right-trim prefix num)))
          
          ;; Création du calque si nécessaire
          (if (not (tblsearch "LAYER" blkLayer))
            (entmakex (list (cons 0 "LAYER") (cons 2 blkLayer) (cons 62 1))))
          
          ;; Insérer les blocs sur chaque sommet
          (setq count 0)
          (foreach pt pts
            (setq insPt pt)
            (setq blkEnt (entmakex
                           (list
                             (cons 0 "INSERT")
                             (cons 2 blkName)
                             (cons 8 blkLayer)
                             (cons 10 insPt)
                             (cons 41 blkScale) ;; X scale
                             (cons 42 blkScale) ;; Y scale
                             (cons 43 blkScale) ;; Z scale
                             (cons 50 blkRotation)
                           )
                         )
            )
            
            (if blkEnt
              (progn
                (setq suffix (+ suffix 1))
                (setq attrEnt (entnext blkEnt))
                (while (and attrEnt (/= (cdr (assoc 0 (entget attrEnt))) "SEQEND"))
                  (if (eq (cdr (assoc 2 (entget attrEnt))) "LOCAL")
                    (entmod (subst (cons 1 (strcat prefix (itoa suffix))) (assoc 1 (entget attrEnt)) (entget attrEnt)))
                  )
                  (setq attrEnt (entnext attrEnt))
                )
                (princ (strcat "\nBloc inséré au point : " (rtos (car insPt)) ", " (rtos (cadr insPt))))
              )
              (princ "\nErreur lors de l'insertion du bloc.")
            )
            (setq count (+ count 1))
          )
          
          ;; Forcer le rafraîchissement d'AutoCAD
          (command "REGEN")
        )
        (princ "\nAucun sommet trouvé sur la polyligne sélectionnée.")
      )
    )
    (princ "\nErreur : Veuillez sélectionner une polyligne.")
  )
  (princ)
)

 

[lecrabe]

Hello @nen

Je n ai pas teste la routine Lisp ...

 blkName   "LOCAUX"                ;; Nom du bloc
 blkLayer   "INFORMATIONS"    ;; Nom du calque

1) SVP tu vas verifier que tous les elements (Graphisme + Attributs) du Bloc "LOCAUX" sont bien CONCUS

sur le calque ZERO en Mode "DuCalque" ou mieux en Mode "DuBloc" !?

2) J ose esperer que les attributs sont bien en mode VISIBLE et non pas INVISIBLE !?

3) Ensuite le calque "INFORMATIONS" est bien visible : actif ET libere  !?

Bye, lecrabe

 

[Olivier Eckmann]

Bonjour,

 

Est-ce que ce code a déjà fonctionné? Car pas testé, mais juste à le lire, ça ma parait correct pour créer un bloc sans attribut avec le entmakex, mais pour les attributs, ça me semble assez douteux comme méthode.

Dans cette discussion Gilles a proposé le code pour insérer un bloc avec ses attributs.

 

Olivier

[nen]

Bonjour le Forum👋,

Merci à vous deux pour vos messages😉. Je vais répondre à vos questions et vous envoie en pièce jointe un fichier DWG contenant le bloc en question.

1. Oui, tous les éléments graphiques sont bien définis et placés sur le calque "0" en mode "DuCalque".
2. Oui, les attributs sont bien en mode visible.
3. Oui, le calque "INFORMATIONS" est actif, visible et non verrouillé.

Concernant le fonctionnement du code, il est difficile de répondre avec certitude. Je constate que les blocs sont bien insérés, mais comme ils ne s'affichent pas, je ne peux pas vérifier si l'incrémentation fonctionne correctement. Maintenant que tu en parles, il est possible que mon code importe uniquement les blocs sans leurs attributs. Tu as peut-être raison🤔.

Meilleures salutations

Dessin1.dwg

[lecrabe]

Hello @nen

Voici une superbe routine "BLP" de notre regrette Patrick_35 qui insere un Bloc (sans ou avec Attributs = remplis par la valeur par defaut)

sur les Extremites OU sur chaque Vertex / Sommet des LWPOLYLINE, POLYLINE, ARC, LINE ...

Je pense que cette routine devrait etre amelioree pour correspondre a tes besoins !?

Bye, lecabe

 

 
;; 
;; http://cadxp.com/topic/4615-inserer-un-bloc-sur-chaque-sommet-polyligne/page__pid__237625
;; 
;; Routine: BLP par P35 v3.10 - 03/02/2005 - Forum AutoCAD 2000-2002
;; 
;; Inserer un Bloc sur le sommet de chaque Polyligne
;; 
;; NOTE : faire tourner sans doute AVANT avec : ATTREQ = 0 & ATTDIA = 0   --> Pas besoin
;;     Ainsi les eventuels attributs auront leurs valeurs par defaut ...  --> Pas besoin
;;     Remettre sans doute APRES : ATTREQ = 1 & ATTDIA = 1                --> Pas besoin
;; 
;; BLP v2.00 par P35 : Ajout de la question en debut de lisp  (suivant message du 28/08/2018) par mail perso
;; 
;; v2.00 - Traite : Polylignes 2D (NON-Splinees/NON-Curvees) / 3D (Splinees ou NON) et Lignes 
;; 
;; v2.00 - ATTENTION sur Polylignes 2D/3D Closes : Double Insertion du Bloc
;; 
;; v3.00 par P35
;; Salut - Le Lisp modifie... Par contre, je ne sais pas comment traiter un arc ou une ellipse 
;;                            J ai quand meme fait quelque chose. Redis-moi, Amicalement
;; 
;; v3.10 par P35 : Ellipses non traitees - Corrections de qq Micro-Bugs
;; 
 
(vl-load-com) 

(defun c:BLP (/ doc nb ent lst nom opt pts rot sel tot ajout)

  (defun ajout(/ ang) 

    (if rot 
      (setq ang 0) 

      (setq ang (if (and (not (zerop nb)) (not (eq (1+ nb) tot)))
		  (+ (* pi 0.5) (* 0.5 (+
		    (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent (1- nb)))
		    (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent nb))
 		  )))
		  (- (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv ent nb)) (* pi 0.5))
		)
      ) 
    ) 

    (setq ang 0)  ;; Angle = ZERO  Micro-Modif par Patrice

    (vla-insertblock (if (eq (getvar "cvport") 2)
		       (vla-get-modelspace doc)
		       (vla-get-paperspace doc)
		     )
		     (vlax-3d-point pts)
		     nom
		     1 1 1 ;  facteur echelle X Y Z
		     ang
    )
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object))) 

  (vla-startundomark doc) 

  (initget "E V")
  (or (setq opt (getkword "\nBloc aux Extremites (depart/arrivee) ou a chaque Vertex [E/V] <E> : "))
    (setq opt "E")
  )
  (and	(setq nom (getstring "\nNom du Bloc : "))
	(tblsearch "block" nom) 

	(ssget (list (cons 0 "LWPOLYLINE,POLYLINE,LINE,ARC")))   ;; Entites TRAITEES

    (progn
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(setq nb 0 lst nil rot nil)
	(cond
	  ((eq (vla-get-objectname ent) "AcDbLine")
	    (setq lst (list (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent))
		  nb 2
	    )
	  )
	  ((eq (vla-get-objectname ent) "AcDbArc")
	    (setq lst (list (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent))
		  rot T
		  nb 2
	    )
	  )
	  (T
	    (while (setq pts (vlax-curve-getpointatparam ent nb))
	      (setq lst (cons pts lst)
		    nb  (1+ nb)
	      )
	    )
	  )
	)
	(setq tot (1- nb) nb 0)
	(while (setq pts (nth nb lst))
	  (cond
	    ((or (eq nb 0) (and (eq opt "V") (< nb tot)))
	      (ajout)
	    )
	    ((eq nb tot)
	      (if (vlax-property-available-p ent 'closed)
		(and (eq (vla-get-closed ent) :vlax-false)
		  (ajout)
		)
		(ajout)
	      )
	    )
	  )
	  (setq nb (1+ nb))
	)
      )
      (vla-delete sel)
    )
  ) 

  (vla-endundomark doc) 

  (princ)
)