Routine: Blocs sur des Points

[lecrabe]

 

Bonsoir à tous

 

Après avoir demandé une routine qui insère des points au centre des cercles et l'avoir obtenu

un temps record (Merci à Tramber et aussi à Gile), je vous présente une autre routine (très proche) qui insère un BLOC sur les coordonnées des Points sélectionnés dans le calque courant ...

 

Je ne sais plus du tout où j'ai récupéré cette routine "fort sympathique" !

( J'espère DONC ne pas vexer son auteur en la diffusant )

Sans doute, le résultat de mes ballades sur les sites US et News Groups divers...

 

 

;;;--------------------------------------------------------------------;

;;; PNT2BLK.LSP

;;; July 2001

;;;--------------------------------------------------------------------;

;;; DESCRIPTION

;;; Place a block object in the location of selected point objects.

;;;--------------------------------------------------------------------;

 

;;;*********************************************************************

;;; Function: C:PNT2BLK

;;; 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:pnt2blk( / 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:")

(setq ss (ssget))

 

;;;filter selection to only point objects

(if ss (ssget "p" (list (cons 0 "POINT"))))

 

;;;if point objects were selected

(if ss

(progn

 

;;;walk through point objects

(setq len (sslength ss))

(setq ct 0)

(while (

 

;;;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 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)

)

 

 

Decapodus "blocus"

 

[Patrick_35]

Même le "crabinou" se met au lisp :cool:

 

@+

[lecrabe]

Bonsoir

 

Le Crabinou ne se met pas au Lisp par contre il va te passer à la tondeuse ! ;)

 

Ainsi je n'aurais plus à supporter ton crane d'oeuf hirsute ! :D

 

Encore merci à tous les Lispeurs, V-Lispeurs, VBAistes, etc

 

Le Decapode "grognon et suant"

 

 

 

[Edité le 26/7/2006 par lecrabe]

[Patrick_35]

Le Crabinou ne se met pas au Lisp par contre il va te passer à la tondeuse ! ;)

 

Il y a du boulot

 

http://smileys.smileycentral.com/cat/36/36_1_53.gif

 

@+