changer un cercle en bloc

[audrey67]

Bonjour

 

Je viens de recevoir un fichier d'eclairage public avec les point lumineux représentés pour des cercles.

Je dois retravailler ce plan pour le mettre conforme à notre charte

Dans cette charte un point lumineux est représenté pour un bloc.

Existe-t-il une manip pour changer les cercles en bloc?

Merci d'avance pour vos réponses

[lecrabe]

Hello

 

Voila ce que j'ai en stock : routine C2B.lsp

A l'epoque les cercles representaient des arbres !

 

Le Bloc doit DEJA exister dans le dessin ...

 

C la meme routine qui transforme les Points en Blocs !

en deplacant les commentaires : routine P2B.lsp

 

lecrabe

 

;;; Routine pour dessiner un Bloc sur des cercles / points graphiques
;;; Version 2 corrigee pour ne traiter que des cercles ou des points
;;; Commande:  C2B ou P2B
;;;
;;;--------------------------------------------------------------------;
;;; PNT2BLK.LSP -  July 2001 - Original Routine 
;;; Place a block object in the location of selected point objects.
;;;--------------------------------------------------------------------;
;;; Function: PNT2BLK --> C2B / P2B
;;; function to convert point objects to blocks.
;;; block must be defined in the current drawing
;;; blocks including attdefs will not address the attributes
;;; if the block references attdefs with default or constant values, 
;;; these will be populated.
;;;*********************************************************************


(defun c:c2b (/ ss ct len e eb bname pt attreqhold echohold)
;(defun c:p2b (/ ss ct len e eb bname pt attreqhold echohold)

;;;get command echo setting and store it
(setq echohold (getvar "CMDECHO"))

;;;set command echo off
(setvar "CMDECHO" 0)

;;;get attribute request setting and store it
(setq attreqhold (getvar "ATTREQ"))

;;;set attribute request off
(setvar "ATTREQ" 0)

;;;get name of block to insert
(setq bname (getstring "\nBlock name: "))

;;;check that the block is defined in the current drawing
(if (tblsearch "block" bname)
(progn

;;;prompt for point selection
(princ "\nSelect point objects:")

;;; --- if point OR circle objects were selected ---

(if (setq ss (ssget '((0 . "CIRCLE"))))
;(if (setq ss (ssget '((0 . "POINT"))))

(progn

;;;walk through point objects
(setq len (sslength ss))
(setq ct 0)
(while (< ct len)

;;;for each point
(setq e (ssname ss ct))
(setq ct (+ ct 1))
(setq eb (entget e))
;;;get insert point
(setq pt (cdr (assoc 10 eb)))
;;;insert block
(command "_insert" bname pt "" "" "")
)
)
(princ "\nNo circle objects selected.")
;(princ "\nNo point  objects selected.")
)
)
(princ "\nInvalid, block not defined in drawing.")
)

;;;restore command echo setting to stored value
(setvar "CMDECHO" echohold)

;;;restore attribute request setting to stored value
(setvar "ATTREQ" 0)

(princ)
) 

[speedy]

Bonjour à toutes et à tous

voici une version courte, vieux sujet : http://cadxp.com/index.php?/topic/25717-insertion-de-bloc-au-centre-du-cercle/

 

(defun c:c2b (/ ss bloc)

(setq bloc (getstring T "\nEntrez le nom du bloc: "))

(if (tblsearch "BLOCK" bloc)

(progn

(setq ss (ssget "_X" '((0 . "CIRCLE"))))

(if ss

(foreach c (mapcar 'cadr (ssnamex ss))

(entmake (list '(0 . "INSERT")

(cons 2 bloc)

(assoc 10 (entget c))

)

)

(entdel c)

)

)

)

(prompt (strcat "\nLe bloc \"" bloc "\" est introuvable."))

)

(princ)

)

 

@+

 

Michel

[bryce]

Bonjour,

 

Je viens d'écrire ce petit Lisp, comme ça tu as l'embarras du choix ! :D

 

(defun c:CTB ( / acdoc ms *error* ss bname b )
; CirclesToBlocks, remplace les cercles sélectionnés par des références de bloc.

;  (setq bname "NOMDUBLOC") ; décommenter la ligne pour prédéfinir le nom du bloc
 (setq effacerCercles T) ; remplacer T par nil pour ne pas effacer les cercles

 (vl-load-com)

 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       ms (vla-get-ModelSpace acdoc)
       filter '((0 . "CIRCLE")) )

 (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))
   (vla-EndUndoMark acdoc)
   (princ)
 )

 (if (cadr (ssgetfirst))
   (setq ss (ssget "_I" filter))
   (progn
     (prompt "\nSélectionnez les cercles à remplacer ou <entrée pour tous> : ")
     (or
       (setq ss (ssget filter))
       (setq ss (ssget "_A" filter))
     )
   )
 )
 
 (if (not bname) (setq bname (getstring "\nNom du bloc : ")))
 
 (if (and
       (setq ss (vla-get-ActiveSelectionSet acdoc))
       (or (tblsearch "BLOCK" bname) (setq bname (findfile (strcat bname ".dwg"))))
     )
   (progn
     (vla-StartUndoMark acdoc)
     (vlax-for c ss
       (setq b (vla-InsertBlock ms (vla-get-Center c) bname 1 1 1 0))
			(vla-put-Layer b (vla-get-layer c))
       (if effacerCercles (vla-Delete c) )
     )
   )
   (progn
     (setq ss nil)
     (princ "\nBloc non trouvé !")
   )
 )
 
 (*error* nil)
)

 

La commande peut être annulée.

Les cercles peuvent être présélectionnés (parSélection rapide par ex.)

Le bloc n'a pas forcément besoin d'exister dans le dessin, s'il existe sous forme de fichier dans un chemin de recherche d'AutoCAD.

Les blocs sont insérés sur le même calque que les cercles.

On peut prédéfinir dans le fichier LSP le nom du bloc à insérer, et si les cercles doivent être effacés ou non.

[audrey67]

merci pour votre aide

 

vous etes vraiment sympa

 

a+