Coordonnée Z bis

[Phil24]

bonjour

je voulais remercier bryce avec beaucoup de retard(deplacement oblige) pour le lips qu'il a crée, qui fonctionne parfaitement et qui me sera tres utile.

seul petit bemol mais peut etre trop complexe

la possibilite de selectionner plusieurs attribut en même temps pour les deplacer suivant l' axe Z d'une valeur X ou Y donnée quel que soit leur altitude d'origine

 

 (defun c:MAJZ (/ obj acdoc precision *error* oldcmdecho blk b att ss ins)
; Met à jour pour toutes les références du bloc choisi un attribut sélectionné,
; pour y afficher la coordonnée Z du bloc.
; Brice Studer, mars 2011
;
;~~~~~~~ CONFIG ~~~~~~~~~~~

(setq precision 3) ; nombre de décimales de l'altitude

;~~~~~~~ FIN CONFIG ~~~~~~~

(vl-load-com)
(setq	acdoc (vla-get-ActiveDocument (setq
	obj (vlax-get-acad-object)))
)

;~~~~~~~ GESTION ERREURS ~~~~~~~~~~~
(defun *error* (msg)
(and msg
	(or
		(member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
		(princ (strcat "\nErreur : " msg))
	)
)
(if ss (vla-delete ss))
(setvar "cmdecho" oldcmdecho)
(vla-endundomark acdoc)
(princ)
)
;~~~~~~~ FIN GESTION ERREURS ~~~~~~~

;~~~~~~~ SOUS-FONCTIONS ~~~~~~~~~~~
(defun PutAttValue ( object tag value )
;; Lee Mac  ~  05.05.10
(mapcar
  (function
	(lambda ( attrib )
	  (and
		(eq tag (vla-get-TagString attrib))
		(vla-put-TextString attrib value)
	  )
	)
  )
  (vlax-invoke object 'GetAttributes)
)
value
)
;~~~~~~~ FIN SOUS-FONCTIONS ~~~~~~~

(vla-StartUndoMark acdoc)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(while
(not
	(and
		(setq blk (car (entsel "\nSélectionnez un des blocs à mettre à jour: ")))
		(setq blk (vlax-ename->vla-object blk))
		(= (vla-get-ObjectName blk) "AcDbBlockReference")
		(setq blk (vla-get-effectivename blk))
	);and
);not
(princ "\nL'objet sélectionné n'est pas un bloc ! ")
);while no bloc

(while
(not
	(and
		(setq att (car (nentsel "\nCliquez sur une valeur d'altitude: ")))
		(setq att (vlax-ename->vla-object att))
		(= (vla-get-ObjectName att) "AcDbAttribute")
		(setq att (vla-get-tagstring att))
	);and
);not
(princ "\nL'objet sélectionné n'est pas un attribut ! ")
);while no attribute

(if (ssget "_X" '( (0 . "INSERT") ) )
(vlax-for b (setq ss (vla-get-ActiveSelectionSet acdoc))
	(if (= blk (vla-get-effectivename b))
		(if
			(and
				(setq ins (vlax-get b 'InsertionPoint))
				(setq ins (caddr ins))
			)
			(putattvalue b att (rtos ins 2 precision))
		)
	);if b = blk
);vlax-for
);if ssget

(*error* nil)
(princ)
);MAJZ

(princ "\nCommande à utiliser: MAJZ")
(princ)

[bryce]

Bonjour,

 

Je ne comprends pas ta demande...

Pour déplacer des objets d'une valeur donnée, il y a la commande Déplacer, non ?! :P

 

Pourrais-tu préciser/fournir un exemple ?

 

[Phil24]

mettons j'ai deux bloc avec attribut

1 a Z +20.00m

1 a Z +30.00m

je selectionne les deux pour les rehausser de 5.00 m

resultat

attribut 1 +25.00m

attribut 2 +35.00m

[bryce]

Ce n'est toujours pas clair, désolé...

 

Si tu veux déplacer les blocs de 5m, il y a la commande Déplacer.

 

Ou bien tu veux simplement ajouter 5 à la valeur de l'attribut Altitude, sans déplacer les blocs ?

 

 

 

[Edité le 9/3/2011 par bryce]

[Phil24]

je vais essayer d'etre plus clair

 

mon batiment est a l'altitude 32.00m

mes chaussée sont au niveau 31.98 et 31.00

si je remonte mon batiment de 0.20 m

 

j'aurais batiment 32.20m

chaussee 32.18 et 31.20

si ces niveau son reperes par des bloc avec attribut

les rehausser tous de 0.20 mettra l'attribut automatiquement a jour

 

 

[speedy]

Bonjour à toutes et à tous

 

Pet etre ce sujet pourras t'aider ...

http://www.cadxp.com//modules.php?op=modload&name=XForum&file=viewthread&fid=141&tid=25964

 

@+

 

Michel a

[Phil24]

bonjour

effectivement marche bien avec des textes

mais pas avec des attibuts de bloc

[vincentp010]

Salut,

 

en supposant que ton bloc s'appelle TCPOINT et que ton attribut est le 2em

(defun c:z2att (/ blocs nb1 nb ent pt ptz attAlt)
 (setvar "cmdecho" 0)
 
 (setq blocs (ssget "x" (list (cons 2 "TCPOINT"))))
 (if (= blocs nil) (exit))
 (setq nb (sslength blocs))
  (setq nb1 0)
  (while (< nb1 nb)
     (setq ent (ssname blocs nb1))
     (setq pt (cdr (assoc 10 (entget ent))))
     (setq ptz (rtos (caddr pt) 2 2))
     (setq attAlt (entget (entnext (entnext ent))))
     (entmod (subst (cons 1 ptz) (assoc 1 attAlt) attAlt))
     (setq nb1 (+ nb1 1))
   )

)