layer et bloc

speedy · le 26 février 2007

Bonjour à tous

je recherche une solution, y'aurait il un moyen............ dans un bloc ecrire dans l'attribut le nom du calque ou il est placé......

Merci

Michel a

stephan35 · le 26 février 2007

Salut !

Pour moi oui ! no soucy,

En lisp

Il faut faire une selection globale des bloc avec SSGET + filtre

Puis une scrutation totale des entité, en extraire le calque d'insertion, puis ecrire dans le valeur de l'attribut ce que tu y souhaite,

Cependant cela demandera plus de paramétrages et de précision pour le fonctionnement reel.

A+ ;)

speedy · le 27 février 2007

Bonjour à tous

Tu n'aurais pas un bout de code,,, pour le moment je jongle sur 'extraction des attributs et insertion dans autocad c'est un peu long..... filtrer mes bloc c'est bon mais lier l'attribut et le layer dans autocad directement ????

Merci

Michel a

stephan35 · le 27 février 2007

Tu n'aurais pas un bout de code,,, pour le moment je jongle sur 'extraction des attributs et insertion dans autocad c'est un peu long..... filtrer mes bloc c'est bon mais lier l'attribut et le layer dans autocad directement ????

Merci

Si tu te débrouilles pas mal en lisp, tu devrais t'en sortir .... ;)

les exemples fournis sont dissociés par rapport aux fonctions traitées car mes dev sont orientés objets ... De plus il va te manquer tout ce qui est procédure de connection et test mdb ... a voir

fonctionne avec adolisp

Extraction d'une liste de bocs et sauvegarde dans une bd :

 ;_***********************************************************************************************************
;_                              TRAITEMENT NUAGES VERSION BD
(if (= $CHECKSUM nil)(setq $CHECKSUM (@Macro_checksum_fichier (strcat (getvar "DWGPREFIX")(getvar "DWGNAME")))))

;Supprime de la base le folio en cours
(@Macro_execute_sql (strcat "DELETE FROM " $AFF $TRANCHE "DOS WHERE FONC='NUA' AND DWG='" (getvar "DWGNAME") "'"))
;Ajoute dans la base le folio en cours
(@Macro_execute_sql (strcat "INSERT INTO " $AFF $TRANCHE "DOS(FONC,CHK,FOL,AFF,DWG,CHKS) VALUES ('" "NUA" "','" "#CHECK" "','" (nth 1 &NFOL_FOLIO) "','" $Affaire "','" (strcase (getvar "DWGNAME")) "','" $checksum "')" ))


;_***********************************************************************************************************
;_                              TRAITEMENT DES DONNES NUAGES


; toutes les entit‚s Polyligne dont l"‚paisseur = 0.618
(setq &ssPline (ssget "X" '((0 . "POLYLINE") (40 . 0.618))))
(setq &ssLWPline (ssget "X" '((0 . "LWPOLYLINE") (40 . 0.618))))

; tous les blocs Triangles
(setq &ssTriangle (ssget "X" '((2 . "TRIANGLE"))))

(if (/= &ssTriangle nil)
    (progn
         (setq #Compteur 0)
         (repeat (sslength &ssTriangle)
              (setq $Nom_entite_Bloc (ssname &ssTriangle #Compteur))
              (setq $indice (@Macro_scan_bloc_attrib_valeur "INDICE" $Nom_entite_Bloc))
              (if (/= $indice "")
                   (progn
	    ;Ajoute dans la base le folio en cours
		(@Macro_execute_sql (strcat "INSERT INTO " $AFF $TRANCHE "DOS(FONC,CHK,FOL,AFF,DWG,CHKS) VALUES ('" "NUA" "','" $indice "','" (nth 1 &NFOL_FOLIO) "','" $Affaire "','" (strcase (getvar "DWGNAME")) "','" $checksum "')" ))
                     )
                   (progn
	    		    ;Ajoute dans la base le folio en cours
		(@Macro_execute_sql (strcat "INSERT INTO " $AFF $TRANCHE "DOS(FONC,CHK,FOL,AFF,DWG,CHKS) VALUES ('" "NUA" "','" "#TRIANGLEVIDE" "','" (nth 1 &NFOL_FOLIO) "','" $Affaire "','" (strcase (getvar "DWGNAME")) "','" $checksum "')" ))
		      )
              )
              (setq #Compteur (1+ #Compteur));Incrémente le compteur
         )
    )
    ; Traitement du cas de pas d'indice trouvé
    (progn
         ; Cas pas de triangle trouvé mais des nuages quand même !
         (if(or (/= &ssLWPline nil)(/= &ssPline nil))
              (progn
		(@Macro_execute_sql (strcat "INSERT INTO " $AFF $TRANCHE "DOS(FONC,CHK,FOL,AFF,DWG,CHKS) VALUES ('" "NUA" "','" "#PASDETRIANGLE" "','" (nth 1 &NFOL_FOLIO) "','" $Affaire "','" (strcase (getvar "DWGNAME")) "','" $checksum "')" ))
              )
         )        
    )
)

extraction du contenu d'un attribut, dans ce scan tu ajoutes l'extraction du nom du plan (8) de mémoire

  (defun @Macro_scan_bloc_attrib_valeur ($ATTRIB #name_entite_block / #name_ent #ent #type_ent #ETQ #FOLIO_CODE_8 #RESULT1 $Sortie)
 (if (not @DEBUG_MACRO)(prompt (strcat "\n.............[@Macro_scan_bloc_attrib_valeur]""<"$attrib">")))
 (load (strcat $drive "MACRO\\@Macro_scan_bloc_attrib_valeur"))
)

 ;(prompt (strcat "\nRecherche dans :"))(print #name_entite_block)
;(prompt (strcat "\nRecherche de :"))(print $ATTRIB)
(setq @MACRO "@Macro_scan_bloc_attrib_valeur")
(if (/= #name_entite_block nil)
 (progn
   (setq #RESULT1 nil)
   (setq #name_ent #name_entite_block)
   (setq #ent (entget #name_entite_block))
   (setq #type_ent (cdr (assoc 0 #ent)))
   (setq #FOLIO_CODE_8 (cdr (assoc 8 #ent)))
				;(while (/= #type_ent "SEQEND")
   (while (and (/= #type_ent "SEQEND") (/= (entnext #name_ent) nil))
				; Correction Bug ??
     (progn
;(print #name_ent)
(setq #ent (entget (setq #name_ent (entnext #name_ent))))

(setq #type_ent (cdr (assoc 0 #ent)))
(if (= #type_ent "ATTRIB")
  (progn
				; Debug
				;(prompt (strcat "\nValeur :"
				;	      (cdr (assoc 2 #ent))
				;	      " Compare :"
				;	      $ATTRIB
				;     )
				;)
    (if	(= (cdr (assoc 2 #ent)) $ATTRIB)
      (progn
				;(princ #ent)		;Debug
				;(if (= nil #RESULT1)
				; Debug

				;(prompt (strcat "\nValeur Attribut :"
				;	  (cdr (assoc 1 #ent))
				; )
				;)
	(if (or
	      (/= (cdr (assoc 1 #ent)) nil)
	      (/= (cdr (assoc 1 #ent)) "")
	    )
	  (progn
	    (setq $Sortie (cdr (assoc 1 #ent)))
				;(prompt "\n Valeur interne :")
				;(princ $Sortie)
	  )
	)
      )
    )
  )
)
     )
   )					; fin test sequence
   (if	(/= nil $Sortie)
     (progn
				;(prompt "\n Valeur memorise :")
(setq @MACRO "")
(setq $Sortie $Sortie)
     )
   )
 )
)

L'écriture dans un attribut

 (defun @Macro_ecrire_attrib (#Name_ent $Valeur #error / $entget)
(if (not @DEBUG_MACRO)(prompt (strcat "\n.............[@Macro_ecrire_attrib]""<"$Valeur ">")))
(setq @MACRO "@Macro_ecrire_attrib")
 (load (strcat $drive "MACRO\\@Macro_ecrire_attrib"))
 (setq @MACRO "")
)

 (setq $entget (entget #Name_ent))
(redraw #Name_ent 2)
(setq $entget (subst (cons '1 $Valeur) (assoc 1 $entget) $entget))
(entmod $entget)
;(entupd #Name_ent)
;(redraw #Name_ent 1)

[surligneur] tout ceci peut-être largement simplifié en vlisp ![/surligneur]

Et je devrais y passer dans pas longtemps ....

en espérant que tu y trouves ton bonheur ...

speedy · le 27 février 2007

Merci stéphan35

il y a de quoi faire......

Michel a

stephan35 · le 27 février 2007

Si tu peux attendre un peu je vais creer un objet qui , suivant les parametres , modifiera tel ou tel caractéristique sur une entité ...

D'ici vendredi ?

;)

speedy · le 28 février 2007

Bonjour

Merci Stephan35

@+

Michel a

stephan35 · le 2 mars 2007

Salut,

Brut de fonderie,

voilà le code qui va remplacer tous mes devs (sur le principe)

si tu es bon en lisp, tu ne devrais pas trop avoir de soucis ... :casstet:

Mes conventions :

& = Liste

# = Nom entité ou chiffre

$ = chaine ascii

@xxx = fonction

Contre toute logique, après moultes essais cette méthode est 20 fois plus rapide que la version linéraire, à tout hasard, si quelqu'un avait une explication ... ;)

 (defun c:ttb()
 ; Macro extrait valeur d'un attribut
 (defun @S_AE ( #SSN $T $E #t $valeur / &Be $Be0 R)
   (if (not #SSN)(progn (alert (strcat "@S_AE \nValeur nil pour #SSN"))(exit)))
   (if (not $T)(progn (alert (strcat "@S_AE \nValeur nil pour $R"))(exit)))
   (if (not $E)(progn (alert (strcat "@S_AE \nValeur nil pour $V"))(exit)))
   (if (not #t)(progn (alert (strcat "@S_AE \nValeur nil pour #t"))(exit)))
   
   (setq &Be (entget #SSN))
   (setq $Be0 (@R0 &Be))
   (while (and (/= $Be0 "SEQEND") (/= (entnext #SSN) nil))
     (setq &Be (entget (setq #SSN (entnext #SSN))))
     (setq $Be0 (@R0 &Be))
     (if (= $Be0 $T) ;Attribut
    (if (= $E (@R2 &Be)) ; Si Etiquette ok
	(if (not $valeur)
	  (progn
	    (cond
	      ((= #t 8)(setq R (@R8 &Be)))
	      ((= #t 1)(setq R (@R1 &Be)))
	      ((= #t 2)(setq R (@R2 &Be)))
	      )
	    )
	  (progn
	    (cond
	      ((= #t 8)(setq R (@W8 &Be $valeur)))
	      ((= #t 1)(setq R (@W1 &Be $valeur)))
	      ((= #t 2)(setq R (@W2 &Be $valeur)))
	      )
	    )
	  )
      )
)
     )
   R
   )
 
 ; Macro eXplore le jeu de selection
 (defun @X_SS (#SS / #C)
   (if (not #SS)(progn (alert (strcat "@X_SS \nValeur nil pour #SS"))(exit)))
   (if (not @MX_SS)(progn (alert (strcat "@X_SS \nMacro nil pour @MX_SS"))(exit)))
   (setq #C 0)
   (repeat (sslength #SS)
     (setq #SSN (ssname #SS #C))
     (@MX_SS #SSN)
     (setq #C (1+ #C))
   )
   (setq @MX_SS nil)
 )
 
;;;  (defun @MX_SS ()
;;;    (print #SSN)
;;;    )

 ; Macro selection Type Valeur
 (defun @SS_@R0_@R2 (@R0 @R2 / )
   (if (and @R0 @R2)
     (setq #SS (ssget "X" (list(cons 0 @R0 )(cons 2 @R2))))
     (alert (strcat "@SS_@R0_@R2 \nValeur nil pour &entget")) 
   )
   #SS
   )
 (defun @R-1 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R-1 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc -1 &entget))
   )
 (defun @R330 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R330 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 330 &entget))
   )
 (defun @R300 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R300 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 300 &entget))
   )
 (defun @R2 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R2 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 2 &entget))
   )
 (defun @R8 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R8 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 8 &entget))
   )
 (defun @R1 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R1 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 1 &entget))
   )
 (defun @R0 ( &entget / tmp )
   (if (not &entget)(progn (alert (strcat "@R0 \nValeur nil pour &entget"))(exit)))
   (cdr(assoc 0 &entget))
   )
 (defun @W1 ( &entget $Valeur / tmp )
   (if (not &entget)(progn (alert (strcat "@W1 \nValeur nil pour &entget"))(exit)))
   (if (not $Valeur)(progn (alert (strcat "@W1 \nValeur nil pour $Valeur"))(exit)))
   (setq &entget (subst (cons '1 $Valeur) (assoc 1 &entget) &entget))
   (entmod &entget)
   (entupd (@R-1 &entget));Pour faire une mise a jour ponctuelle
   )
 
 (setq $nom_bloc (@R2 (setq &e (entget (setq #e (car(entsel)))))))
 ; Selectionne dans le document tous les blocs portant ce nom
 (@SS_@R0_@R2 (@R0 &e)(@R2 &e))
 
 ; Explore le jeu de selection mettre à 500 pour comparer mes 2 dev
 (repeat 1
(defun @MX_SS ( #SSN / )
  (print (@S_AE #SSN "ATTRIB" "L3" 1 nil))


  
  (@S_AE #SSN "ATTRIB" "L3" 1
  (strcat ":"
    (@S_AE #SSN "ATTRIB" "L3" 8 nil)
	  ":"
	  (@S_AE #SSN "ATTRIB" "L3" 1 nil)
	  )
  )

  ; Version 2
  ;(@S_AE #SSN "ATTRIB" "L3" 1 "ooooooooooo")

  ;Pour faire une mise a jour globale
  ;(entupd #SSN)
	  
  
   )
 (@X_SS #SS)
   )
 )

nota: n'esite pas à poster des commentaires ... ;)

bon courrage :P

Didier-AD · le 2 mars 2007

Je ne dois pas tout avoir compris car voici une solution plus simple et plus courte

 
(defun c:CalqueDuBloc (/ js n  bl layer att)
 ;sélectionner les blocs avec attribut du dessin
 (setq js (ssget "X" (list (cons 0 "INSERT") (cons 66 1)))
n 0
 )
 (repeat (if js (sslength js) 0)
   (setq bl (ssname js n)
  layer (cdr (assoc 8 (entget bl))) ;; récupérer le calque
  att (entget (entnext bl))
  att (subst (cons 1 layer) (assoc 1 att) att) ; modifier l'attribut
   )
   (entmod att) ;; mise à jour de l'attribut
   (entupd bl)  ;; mise à jour du bloc
   (setq n (1+ n))	  
 )  
)


(alert "Commande c:CalqueDuBloc chargée")

bon courage

stephan35 · le 5 mars 2007

Je ne dois pas tout avoir compris car voici une solution plus simple et plus courte

Bien-entendue , on peut toujours faire plus court, cependant ton exemple ne permet pas de choisir l'attribut dans lequel on va ecrire l'information ... :casstet:

il va falloir écrire une routine de scrutation d'attribut .... :casstet:

Etant donné, comme je l'avais expliqué, que je mettais mes applicatifs à jour, et ce, pour un gain de temps de traitement, et d'optimisation d'écriture (+ 3Mo dans 300 lsp), je proposais à speedy d'en profiter .... :D

L'orientation objet permettrai de réutiliser ceux-ci sans réécriture ...

Exemple :

(@R1 &entget) te retourne simplement le cdr (assoc 1 , avec le test entget non nil

(@X_SS #SS) Explore le jeu de selection #SS et execute la macro variable (@MX_SS #SSN) pour chasue entité #SSN

Etc .

A partir de conventions d'écriture , on peut facilement relire un developpement utilisant cette méthode .... essayer c'est l'adopter ! ;)

A+

Connexion

layer et bloc

Messages recommandés

speedy

stephan35

speedy

stephan35

speedy

stephan35

speedy

stephan35

Didier-AD

stephan35

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante