Petit bug dans routine PNT2BLK

[lecrabe]

Hello

 

Voici une routine Lisp (PNT2BLK) que j'utilise depuis longtemps et qui insere un bloc AutoCAD (existant) par dessus des points graphiques AutoCAD

 

Cependant elle a un petit bug qui m'enerve et que je n'arrive pas a corriger !

Cette routine insere un bloc supplementaire en ZERO,ZERO

 

SVP est ce que quelqu'un pourrait la corriger ? ou en proposer une autre ...

 

Merci d'avance, le Decapode

 

 

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

;;; PNT2BLK.LSP

;;; July 2001

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

;;; DESCRIPTION

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

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

 

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

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

)

 

 

 

 

[Edité le 9/11/2007 par lecrabe]

[bseb67]

Salut!

 

Solution un peu bidon, cherche les blocs ayant le nom de celui insérer se trouvant dans le

carré (-1,-1) (+1,+1) et supprime le.

[lecrabe]

 

Hello

 

Après qq tests intensifs, j'ai progressé ...

 

En fait la routine n'a pas de bug REEL mais elle ne filtre pas correctement la sélection et donc elle dessine un bloc supplémentaire sur chaque debut de ligne / polyligne, centre de cercle, etc

 

Donc si on ne sélectionne QUE des points graphiques alors tout va bien ! :)

 

Testé sur AutoCAD 2004 / 2005 / 2006 / 2007

 

Je suis donc toujours preneur d'une petite modif qui filtre la sélection ! :P

 

Merci d'avance, Le Decapode

 

[(gile)]

Salut,

 

La sélection était faite de manière très curieuse (en 2 temps)

 

J'ai corrigé ça, je te laisse tester

 

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

;;;if point objects were selected
     (if (setq ss (ssget '((0 . "POINT"))))
(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)
) 

[lecrabe]

 

Hello Gilles

 

Comme d'hab, c parfait ! :)

 

J'ai fait la micro-modif nécessaire et maintenant j'ai 2 routines

- L'une pour dessiner un bloc sur des points graphiques

- L'autre pour dessiner un bloc au centre de cercles

 

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

ou

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

 

Encore Merci, Le Decapode

 

[richard-c]

bonjour,

 

en associant getblock.lsp de (gille) à ton programme, tu as un peu plus de convivialité.

 

tu remplaces

 

;;;get name of block to insert

(setq bname (getstring "\nBlock name: "))

 

par

 

[surligneur] (setq bname (getblock "\nBlock name: "))[/surligneur]

 

A+

[lili2006]

Bonjour à toutes et tous,

 

Terrible aussi ton outil l lecrabe, avec la modif de richard-c utilsant la boite de (gile). Moi qui cherchais à comprendre le fonctionnement des sous-routines, en voici un deuxième exemple super d'utilisation.

 

Bravo à tous.

[(gile)]

Salut,

 

(setq bname (getblock "\nBlock name: "))

 

Tant qu'à modifier le LISP pour le rendre plus convivial, autant traduire les invites :

 

(setq bname (getblock "Nom du bloc"))

 

ou encore :

 

(setq bname (getblock nil))

 

pour avoir le titre par défaut : "Choisir un bloc".

[lili2006]

Re,

 

Une question : Serait-il possible, d'associer les blocs aux points dans leurs calques de destination si ceux-ci sont déjà insérés avec le bon calque, sur un gabarit, par exemple ?

 

Merci d'avance.

[(gile)]

Je ne comprends pas la question

 

- mettre les blocs sur le calque des points ?

 

- sinon comment est défini le "bon calque" ?

[lili2006]

Re,

 

En fait sur mon gabarit, j'ain inséré tous les blocs associés aux calques souhaités. J'en ai fait de même sur ma palette d'outils. Donc à l'insertion depuis la palette, les blocs arrivent dans le bon calque. Je me demandai juste si c'était possible d'en faire de même avec "pnt2blk". Et peu importe le calque des points, à la limite.

 

- sinon comment est défini le "bon calque" ?

 

C'est la question que je me posais, c'est pour cel que j'ai parlé du gabarit, puisque ces blocs sont déjà dans l'espace dessin et dans le bon calques. Peut-être est t-il possible de récupérer l'information de calque sur ces blocs déjà insérés ???!!!

 

Voilà l'objet de ma requête, ou plutôt de mon interrogation. (Quoi que option plutôt intéressante dans ma façon de travailler,...)

 

Merci.

[(gile)]

Oui c'est possible, mais ça ne marchera que si un bloc est bien inséré et on ne peut être sûr du calque que si tous les blocs du même nom sont bien sur le "bon calque".

 

Je n'aime pas trop ces façons trop spécifiques, je préfère la polyvalence et, entre nous, mettre courant le calque voulu avant de lancer le LISP n'est pas bien laborieux.

 

J'ai ajouté les deux expressions (surlignées) qui permettent de définir le "bon calque" et de changer les propriété des blocs insérés si ce calque a été trouvé.

Je n'ai rien changé d'autre au LISP, je pense que les (command ...) sont plus faciles à comprendre qu'un (entmake ..) ou u (vla-insertblock ...) même si ces dernières sont plus performantes.

 

(defun c:pnt2blk (/ ss ct len e eb bname lay 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

     [surligneur](if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))
(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
     )[/surligneur]

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

;;;if point objects were selected
     (if (setq ss (ssget '((0 . "POINT"))))
(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 "" "" "")
    
    [surligneur](if	lay
      (command "_chprop" (entlast) "" "_Layer" lay "")
    )[/surligneur]
    
  )
)
(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)
) 

[lili2006]

Re,

 

Super (gile)

 

je préfère la polyvalence et, entre nous

 

Moi aussi quand c'est possible.

 

mettre courant le calque voulu avant de lancer le LISP n'est pas bien laborieux.

 

Oui, mais tu le sais comme moi, sur une journée de production, forcément on va se tromper, alors que là, plus de risque, et surtout plus à s'en soucier.

 

C'est vrai que l'utilisation régulière de covadis nous fait perdre les réflexes AutoCAD.

 

Et puis là, c'est aussi pédagogique. On met en oeuvre une charte graphique au niveau des étudiants afin de leur faire prendre conscience de l'intérêt des gabarits, cartouches, normalisation du tracé, onglets de présentations,... bref, l'organisation et l'harmonisation des méthodes de travail. Et ce sont eux, en grande partie, qui définissent les calques, blocs, plumes de tracé, méthodes d'archivage, remise au client,....

 

Ce qui me plait aussi dans cette routine, c'est que c'est le principe adopté par covadis et je trouve cea pas mal en tout cas dans l'habillage de plans topos. Maintenant, dans les autres domaines, faut voir,...

 

Merci encore (gile)

[richard-c]

j'ai essayé la dernière version de (gile) je n'ai pas vu de différence avec la version précédente,

 

j'avais bidouillé çà :

 

on choisi le calque destination

on choisi le bloc à insèrer avec getblock

 

les lignes ajoutées sont entre les ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 (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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;Choix du calque courrant
(calq_cour)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq bname (getblock "\n Choix du bloc: "))
;;;;;(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 "\n Sélectionner ler points:")

;;;if point objects were selected
(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 "" "" "")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "_.CHANGE" (entlast) "" "PR" "CA" calq_cour "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;Choix du calque courrant
(defun calq_cour ()
    (princ "\n Sélection du calque destination  ")
    (setq OBJ (car (entsel)))    
    (setq OBJ1 (entget obj))       
    (setq CALQ (assoc '8 obj1))      
    (setq calq_cour (cdr calq))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[lili2006]

Re,

 

richard-c, est-ce que ta routine retourne le même résultat que celui de (gile) ?

 

Merci d'avance.

[(gile)]

j'ai essayé la dernière version de (gile)

 

Ce LISP n'est pas de moi (je ne l'aurais certainement pas écrit comme ça), j'apporte juste les modifications qu'on me demande.

 

Si vous voulez choisir un calque, vous pouvez continuer avec les boites de dialogue (getlayer sans s)

[lili2006]

Re,

 

Pour moi, la dernière mouture est parfaite (avec getblock).

 

Merci encore.

 

[richard-c]

pour (gile), je suis d'accord, le programme n'est pas de toi mais tu dépannes tellement souvent.

 

pour lili2006, je n'ai pas trouver de différence entre les 2 programmes,

dans celui que j'ai modifoé suivant tes désirs, (enfin je pense), il y avais un petit bug, il ne fonctinnait qu'une seule fois, il fallait fermer le dessin et le rouvrir pour que cela fontionne de nouveau.

 

voilà ma nouvelle alchimie (je ne suis pas programmeur comme nos amis.

 

par contre je n'en vois pas une utilité personnelle (poutant je fais du VRD)

mais avec le temps, je changerai surement d'idée.

 

 (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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;Choix du calque courrant
    (princ "\n Sélection du calque destination  ")
    (setq OBJ (car (entsel)))    
    (setq OBJ1 (entget obj))       
    (setq CALQ (assoc '8 obj1))      
    (setq calq_cour (cdr calq))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq bname (getblock "\n Choix du bloc: "))
;;;;;(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 "\n Sélectionner ler points:")

;;;if point objects were selected
(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 "" "" "")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "_.CHANGE" (entlast) "" "PR" "CA" calq_cour "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

 

A+

 

 

[lili2006]

Re,

 

pour lili2006, je n'ai pas trouver de différence entre les 2 programmes,

, moi non plsu, c'est pour cela que je me suis permis de demander.

 

Merci à vous deux.

 

lecrabe, bon courage pour la lecture de tous ces post et tous ces tests. Aprés tout, l'idée vient de toi, alors quelle opinion ?

[lili2006]

Re,

 

(poutant je fais du VRD)

 

richard-c, utilises-tu covadis ? Car, grace au principe du bloc point et la géocodification, tu peux compléter avec cet outil (pnt2blk) si tu ne travaille qu'avec AutoCAD. Et c'est mon cas quand je rend visite au Bureau d'Etudes de mon ami (Spécialité Béton Armé) qui n'est bien sûr pas équipé de covadis.

[(gile)]

I y a une différence fondamentale entre ce que j'ai fait pour lili2006 et ce que donne richard-c, c'est l'intervention ou non de l'utilisateur.

 

Un plus automatisé travaille en aveugle et ne pourra fonctionner correctement qu'avec les restrictions que je donnais, l'autre oblige l'utilisateur à intervenir pour le choix du calque.

[lecrabe]

Hello

 

Je ne pensais que ce petit Lisp que j'utilisais avec ses limitations depuis environ 2001/2002 allait susciter autant d'intérêt ! :o

 

Je suis bien content qu'il puisse rendre qq services ... :)

 

Encore MERCI aux pros du Lisp / V-Lisp / etc !! ;)

 

Bon WE à tous, Le Decapode

 

 

[Edité le 9/11/2007 par lecrabe]

[richard-c]

lili2006, non je n'ai pas covadis, et c'est pas à mon age (- de 2 ans)que je prendrai covadis,

je le laisse aux jeunes ( on attend une 2ème version bientôt ), j'ai demandé que çà soit ma jeune collègue qui l'ai, mais entre nous j'aimerais bien quand même.

 

Bon week end.

 

A+

[lili2006]

Rere,

 

Un plus automatisé travaille en aveugle et ne pourra fonctionner correctement qu'avec les restrictions que je donnais, l'autre oblige l'utilisateur à intervenir pour le choix du calque.

 

En reprenant les tests, j'ai compris ce que tu voulais dire.

 

Je suis bien content qu'il puisse rendre qq services ...

 

Même de grand service, je pense.

 

j'ai demandé que çà soit ma jeune collègue qui l'ai, mais entre nous j'aimerais bien quand même.

 

Ca fait plaisir de voir que même à moins de deux ans de la retraite, on povait encore être intéressé par son outil de travail. Bravo.

 

Merci à tous et bon WE.

[lili2006]

Re,

 

Pendant qu'on y est, J'aimerez pouvoir faire la même chose sur ce lisp (insère un bloc sur chaque somment d'une polyligne de lecrabe aussi, je crois !), A savoir :

 

Utiliser : "(setq bname (getblock "Nom du bloc"))"

 

changer les propriété des blocs insérés si ce calque a été trouvé : "(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))

(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))

)"

 

Définir le bon calque :"(if lay

(command "_chprop" (entlast) "" "_Layer" lay "")

)".

 

Voici le LISP : [Avant]

 

 (vla-get-PaperSpace acdoc)
(vla-get-ModelSpace acdoc)
)
)
(if
(and
(setq bl (getstring T "\nEntrez le nom du bloc: "))
(or
(tblsearch "BLOCK" bl)
(findfile bl)
)
)
(if (ssget "_X" '((0 . "*POLYLINE")))
(progn
(vla-startUndoMark acdoc)
(vlax-for pl (vla-get-ActiveSelectionSet acdoc)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (= (vla-get-Closed pl) :vlax-false)
(setq n (1- n))
)
(repeat (1+ n)
(vla-InsertBlock
space
(vlax-3d-point (vlax-curve-getPointAtParam pl n))
bl
1.0
1.0
1.0
0.0
)
(setq n (1- n))
)
)
(vla-EndUndoMark acdoc)
)
)
(princ (strcat "\nLe block \"" bl "\" est introuvable"))
)
(princ)
) 

 

Voici le LISP : [Apré test infructueux]

 

(defun c:ins-vtx (/ acdoc space bl n)
(vl-load-com)
(setq acdoc (vla-get-activeDocument (vlax-get-acad-object))
space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace acdoc)
(vla-get-ModelSpace acdoc)
)
)
(if
(and
[surligneur] (setq bname (getblock "Nom du bloc"))[/surligneur](or
(tblsearch "BLOCK" bl)
(findfile bl)
)
)
(if (ssget "_X" '((0 . "*POLYLINE")))
(progn

[surligneur] (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))[/surligneur](setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
)

(vla-startUndoMark acdoc)
(vlax-for pl (vla-get-ActiveSelectionSet acdoc)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (= (vla-get-Closed pl) :vlax-false)
(setq n (1- n))
)
(repeat (1+ n)
(vla-InsertBlock

[surligneur] (if lay
(command "_chprop" (entlast) "" "_Layer" lay "")
)[/surligneur]
space
(vlax-3d-point (vlax-curve-getPointAtParam pl n))
bl
1.0
1.0
1.0
0.0
)
(setq n (1- n))
)
)
(vla-EndUndoMark acdoc)
)
)
(princ (strcat "\nLe block \"" bl "\" est introuvable"))
)
(princ)
)  

 

AutoCAD renvoi "ins-vtx ; erreur: type d'argument incorrect: stringp nil"

 

Et, on ne rigole pas SVP,...

 

La boite de dialogue arrive bien cependant, c'est déjà un premier pas,...

 

Merci d'avance.

 

(Gile), avec toutes tes " petites" sous-routines, on a plus qu'à reprendre tous nos lisps,...

 

 

 

 

 

[Edité le 9/11/2007 par lili2006]