Changer l\'echelle de blocs \"relativement\"

[lecrabe]

 

Hello les CADXPiens

 

Je suis un peu fatigué cet après-midi et je n'ai pas trouvé mon bonheur !

Et pourtant j'ai l'impression d'avoir la solution qq part dans mon crane d'oeuf !? :o

 

En fait je cherche la routine qui me permettra à partir de la saisie d'un facteur d'echelle

(Echelle = xx.yy) et d'une sélection AutoCAD classique sur des blocs unqiuement

 

d'appliquer une commanche "Echelle" du facteur voulu à tous les blocs sélectionnés

et ce par rapport à leur point d'insertion RESPECTIF !

 

e non pas globalement par rapport à un point XYZ général

(comme le fait la commande "AutoCAD Echelle")

 

Voyez vous ce que je veux faire ?

 

Merci d'avance, Le Decapode

 

 

 

[Tramber]

Mais quoi, vieille pince ? Et quid des propriétés ?

 

Tes blocs seraient déjà à des échelles différentes les uns les autres moyennant quoi il faudrait vraiment les traiter en lisp grâce aux codes DXF 41, 42 et 43 (échelles en X, Y et Z) ?

 

 

[lecrabe]

 

ReHello

 

Et SVP dans le même genre, la même Routine pour changer la rotation des blocs sélectionnées

par rapport à leur point d'insertion RESPECTIF !? :P

 

Le Decapode "fatigué sous le soleil de la Savoie"

 

 

[lecrabe]

 

Hello

 

Eh OUI, ces blocs sont à des échelles et/ou rotations différentes ! :exclam:

 

Je désire changer leur Echelle et/ou leur Rotation relativement et CE par rapport à leur point d'insertion RESPECTIF ! :P

 

Le Decapode

 

[lecrabe]

 

Hello

 

Un début de réponse, je viens de retrouver l'excellente routine de Gilles :

 

;; Rotation de N Bloc(s) d'un angle donne (+/- xx.xx)

;; par rapport a leur point d'insertion

;; par Gilles

 

(defun c:rotbloc (/ ang ss)

(vl-load-com)

(and (setq ang (getorient "\nSpécifiez l'angle de rotation: "))

(ssget '((0 . "INSERT")))

(vlax-for b (setq ss (vla-get-ActiveSelectionSet

(vla-get-ActiveDocument

(vlax-get-acad-object)

)

)

)

(vla-put-rotation b (+ (vla-get-rotation b) ang))

)

)

(and ss (vla-delete ss))

(princ)

)

 

 

Le Decapode

 

 

[(gile)]

Salut,

 

Très vite fait (et pas vraiment testé).

 

(defun c:bscale	(/ *error* doc scl ss)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark doc)
   (princ)
 )
 (if
   (and
     (setq scl (getreal "\nFacteur d'échelle: "))
     (ssget '((0 . "INSERT")))
   )
    (progn
      (vla-StartUndoMark doc)
      (vlax-for o (setq ss (vla-get-ActiveSelectionSet doc))
 (foreach p '(XScaleFactor YScaleFactor ZScaleFactor)
   (vl-catch-all-apply
     '(lambda ()
	(vlax-put-property o p (* scl (vlax-get-property o p)))
      )
   )
 )
      )
      (vla-delete ss)
      (vla-EndUndoMark doc)
    )
 )
 (princ)
)

(defun c:brot	(/ *error* doc rot ss)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark doc)
   (princ)
 )
 (if
   (and
     (setq rot (getorient "\nRotation: "))
     (ssget '((0 . "INSERT")))
   )
    (progn
      (vla-StartUndoMark doc)
      (vlax-for o (setq ss (vla-get-ActiveSelectionSet doc))
 (vl-catch-all-apply
     '(lambda ()
	(vla-put-Rotation o (+ rot (vla-get-Rotation o)))
      )
   )
      )
      (vla-delete ss)
      (vla-EndUndoMark doc)
    )
 )
 (princ)
)

[lecrabe]

 

Hello Gilles

 

Merci beaucoup, tes nouveaux BROT & BSCALE semblent OK sur MAP 2006 ! :) :D

 

Je vais tester plus tard sur d'autres versions ... :P

 

Encore Merci, Le Decapode (Changeur d'echelle)

 

[lecrabe]

 

Hello

 

Un petit UP pour la route ! :)

 

Ca fonctionne aussi avec MAP 2010 :D

 

Encore Merci à Gilles, Le Decapode

 

[LUDWIG]

Vieux lisps de Didier Lourdelle

 

**********************************************************************************************************************************************************
;échelle / point de base
;**********************************************************************************************************************************************************
;Modification de l'echelle sur plusieur entités par rapport a leur point de base

(defun c:ch_ech	(/ n js ent pt1 ech)
 (SETQ CMDE (GETVAR "cmdecho"))
 (SETVAR "CMDECHO" 0)
 (setq n 0)
 (command "_undo" "_m")
 (prompt "\nSelection des objets :")
 (setq js (ssget))
 (initget 1)
 (setq ech (getstring "/Reference :"))
 (if (or (= ech "R") (= ech "r"))
   (progn
     (setq long_ref (getreal "Longueur de reference <1>:"))
     (if (= nil long_ref)
(setq long_ref 1.0000000)
) ;_ Fin de if
     (initget (+ 1 2 4))
     (setq long_new (getreal "Nouvelle Longueur:"))
     ) ;_ Fin de progn
   ) ;_ Fin de if
 (repeat (sslength js)
   (setq ent (ssname js n))
   (SETQ PT1 (cdr (assoc 10 (entget ent))))
   (if	(or (= ech "R") (= ech "r"))
     (command "_SCALE" ent "" pt1 "r" long_ref long_new)
     (command "_SCALE" ent "" pt1 ech)
     ) ;_ Fin de if
   (setq n (1+ n))
   (IF	(= (/ n 5.00) (/ n 5))
     (prompt ".")
     ) ;_ Fin de IF
   ) ;repeat
 (SETVAR "CMDECHO" CMDE)
 (terpri)
 ) ;
(prompt
 "\nch_ech : Echelle sur plusieurs entités par rapport à leur point de base respectif"
 ) ;_ Fin de prompt

 

 

 
;**********************************************************************************************************************************************************
;----- rotation / point de base ---------
;**********************************************************************************************************************************************************
; Rotation sur plusieurs entités par rapport à leur point de base

(defun c:ch_rotat (/ n js ent pt1 ang)
 (SETQ CMDE (GETVAR "cmdecho"))
 (SETVAR "CMDECHO" 0)
 (setq n 0)
 (command "_undo" "_m")
 (prompt "\nSelection des objets :")
 (setq js (ssget))
 (setq ang (getreal "Angle de rotation:"))
 (repeat (sslength js)
   (setq ent (ssname js n))
   (SETQ PT1 (cdr (assoc 10 (entget ent))))
   (command "_rotate" ent "" pt1 ang)
   (setq n (1+ n))
   (IF	(= (/ n 50.00) (/ n 50))
     (prompt ".")
     ) ;_ Fin de IF
   ) ;repeat
 (SETVAR "CMDECHO" CMDE)
 (terpri)
 ) ;
(prompt
 "\nch_rotat : Rotation de plusieurs entités par rapport à leur point de base respectif"
 ) ;_ Fin de prompt

 

[Edité le 15/5/2009 par LUDWIG]