Blocs aux extremités d\'une polyligne

[chris_mtp]

Bonjour à tous,

 

J'ai dans un dessin une centaine de polylignes appartenant à un calque spécifique et chacune des extremités de ces polylignes doit être relié à des blocs nommés soit Placard soit Tampon.

J'essaye de programmer un lisp qui me permette de vérifier chacune des extrémités de mes polylignes mais en vain.

 

Si vous avez une idée, merci par avance.

 

John

[(gile)]

Salut,

 

La demande n'est pas très claire...

 

Pour récupérer les coordonnées des sommets aux extrémités d'une polyligne (LWPOLYLINE) on peut utiliser les données DXF (ent = polyligne):

 

(setq elst (entget ent))

(setq pt1 (cdr (assoc 10 elst)))

(setq pt2 (cdr (assoc 10 (reverse elst)))

 

Ou encore les fonctions vlax-curve-* :

 

(setq pt1 (vlax-curve-getStartPoint ent))

(setq pt2 (vlax-curve-getEndPoint ent))

[chris_mtp]

Merci Gile de me répondre.

 

Le but serait de sélectionner toutes les polylignes 2D d'un calque spécifique et de contrôler que chacune des extremités de ces polylignes soit relié à un bloc.

 

En autre chose, que les coordonnées du point de début et de fin de ma polyligne correspondent au point d'insertion d'un bloc nommé Placard ou xxxx ou ....

 

Les extremités de mes polylignes peuvent être raccordé à 3 blocs différents, soit un Placard soit un Coffret soit une Armoire.

 

Par contre, certains de mes blocs sont levés par 3 points mais les polylignes sont reliés à un point nodal au centre de ces blocs. Le nodal est compris dans le bloc.

 

Je vais mettre en ligne une image pour expliquer clairement ma demande.

 

Merci encore de ton aide.

John.

 

[chris_mtp]

Voici ce que j'ai pu faire

 

 (defun c:cpoly (/ ss ss1 pti ptd ptf d long nom dxf_ent lst_b1 i bloc bent echx echy rot ptnod)

(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)

(setq ss1 (ssget "X" (list (cons 0 "INSERT") (cons 8 "POTEAU"))))

(repeat (setq i (sslength ss1))
(setq pti (cdr (assoc 10 (entget (ssname ss1 (setq i (1- i)))))))
(setq lst_b1 (cons (list (car pti) (cadr pti)) lst_b1))
)

(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 8 "PLAQUE"))))
(setq i 0)
 
(repeat (sslength ss)
(setq bloc (ssname ss i))
(setq bent (entget bloc))

(setq pti (cdr (assoc 10 bent)))
(setq echx (cdr (assoc 41 bent)))
(setq echy (cdr (assoc 42 bent)))
(setq rot (cdr (assoc 50 bent)))
(setq ptnod (polar pti (+ rot (atan (/ echy echx))) (sqrt (+ (* (/ echx 2) (/ echx 2)) (* (/ echy 2) (/ echy 2))))))

(setq lst_b1 (cons (list (car ptnod) (cadr ptnod)) lst_b1))
(setq i (+ i 1))

)

(setq ss (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 "CABLE"))))

(if (not (tblsearch "LAYER" "ERREUR"))
(command "_layer" "_N" "ERREUR" "_CO" "1" "ERREUR" ""))
(setvar "CLAYER" "ERREUR")

(princ "\nCONTROLE EXTREMITES DES POLYLIGNES")

(setq d 0)
(setq long (sslength ss))

(while (< d long)

(setq nom (ssname ss d))
(setq dxf_ent (entget nom))
(setq ptd (cdr (assoc 10 dxf_ent)))
(setq ptf (cdr (assoc 10 (reverse dxf_ent))))

 (if (not (member ptd lst_b1))
   (command "_.circle" ptd 5)
   )

 (if (not (member ptf lst_b1))
   (command "_.circle" ptf 5)
   )

(setq d (+ d 1))
)

(setvar "OSMODE" 65)
(setvar "CMDECHO" 1)
(prin1)
)

 

Mais la routine bloque à la fin et me plante AutoCAD à chaque.

J'essaye d'abord de faire marcher la routine sur les blocs ponctuel levés par un point avant de me lancer sur les blocs par 3 points et le fameux nodal au centre.

 

Gile, j'ai fait attention à la présentation et je l'ai fait avec AutoLisp.

 

Merci par avance de ton aide.

John[Edité le 8/8/2009 par chris_mtp][Edité le 8/8/2009 par chris_mtp][Edité le 9/8/2009 par chris_mtp][Edité le 9/8/2009 par chris_mtp][Edité le 9/8/2009 par chris_mtp]

 

[Edité le 9/8/2009 par chris_mtp]

[chris_mtp]

J'ai trouvé pourquoi la routine bloque, c'était à cause de l'incrément d+1.

J'ai modifié le code.

 

 

[chris_mtp]

Rebonjour Gile,

 

J'ai modifié le code pour faire une liste de points 2d seulement.

Pour les blocs par un point je n'ai pas de problème maintenant ca marche mais par contre j'ai un autre souci.

 

Je dois pouvoir récupérer le nodal qui est au centre de mon bloc levés par 3 points comme le montre l'image ci-jointe mais je ne vois comment m'y prendre même avec les sous entités DXF je ne vois pas.

 

Le nodal fait partie intégrante du bloc

http:// http://www.cijoint.fr/cjlink.php?file=cj200908/cijo9sJNNE.jpg

 

Si vous pouvez m'aider, merci par avance.

John.

[(gile)]

Salut,

 

Essaye de te mettre à la place de ceux qui vont te lire et demande toi si ce que tu écris est intelligible par tous.

 

Si je pense avoir compris que ce que tu appelles "nodal" est un point AutoCAD, je ne sais toujours pas ce qu'est un "bloc levés par 3 points".

 

Toi seul sait comment a été faite la définition de ce bloc et comment il a été inséré (l'image jointe n'indique rien).

Tu dois connaître les coordonnées du point dans la définition du bloc (par rapport au point de base).

 

Pour chaque référence insérée il faut recalculer les coordonnées du point dans le bloc en fonction des transformations subies par la référence (rotation et mise à l'échelle).

et ensuite ajouter le résultat au point d'insertion de la référence.

[(gile)]

Re,

 

Une petite routine qui retourne les coordonnées d'un point (connu dans la définition du bloc) dans une référence de ce bloc.

La routine calcule d'abord les coordonnées du point suivant les échelles de la référence, puis transforme ces coordonnées en coordonnées polaires pour les utiliser avec la fonction polar en intégrant la rotation et le déplacement.

 

;; Retourne les coordonnées d'un point connu dans une définition de bloc
;;
;; Arguments
;; pt : coordonées du point dans la définition du bloc
;; blk : référence du bloc (ENAME)
(defun TransBlk (pt blk / elst ins xscl yscl zscl rot ang dist)
 (setq elst (entget blk)
       ins  (cdr (assoc 10 elst))
       xscl (cdr (assoc 41 elst))
       yscl (cdr (assoc 42 elst))
       zscl (cdr (assoc 43 elst))
       rot  (cdr (assoc 50 elst))
       pt   (mapcar '* pt (list xscl yscl zscl))
       ang  (angle '(0. 0. 0.) pt)
       dist (distance '(0. 0. 0.) pt)
 )
 (polar ins (+ rot ang) dist)
)

 

On peut aussi utiliser la matrice de transformation de la référence, soit en la récupérant avec nentselp, soit en la recalculant à partir des données DXF de la référence de bloc.

 

avec nentselp (utilise les routines mxv et butlast) :

(defun TransBlk (pt blk / ins mat)
 (setq ins (cdr (assoc 10 (entget blk)))
       mat (caddr (nentselp ins))
 )
 (mapcar '+ (mxv (butlast (mapcar 'butlast mat)) pt) ins)
)

 

en calculant la matrice (utilise les routines trp mxm mxv)

(defun TransBlk (pt blk / elst ins xscl yscl zscl rot)
 (setq elst (entget blk)
       ins  (cdr (assoc 10 elst))
       xscl (cdr (assoc 41 elst))
       yscl (cdr (assoc 42 elst))
       zscl (cdr (assoc 43 elst))
       rot  (cdr (assoc 50 elst))
 )
 (mapcar '+
         (mxv
           (mxm
             (list (list (cos rot) (- (sin rot)) 0)
                   (list (sin rot) (cos rot) 0)
                   '(0. 0. 1.)
             )
             (list (list xscl 0. 0.)
                   (list 0. yscl 0.)
                   (list 0. 0. zscl)
             )
           )
           pt
         )
         ins
 )
)

 

routines :

;; TRP
;; transpose une matrice -Doug Wilson-
;;
;; Argument : une matrice

(defun trp (m) (apply 'mapcar (cons 'list m)))

;; MXV
;; Applique une matrice de transformation à un vecteur -Vladimir Nesterovsky-
;;
;; Arguments : une matrice et un vecteur

(defun mxv (m v)
 (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

;; MXM
;; Multiple (combine) deux matrices -Vladimir Nesterovsky-
;;
;; Arguments : deux matrices

(defun mxm (m q)
 (mapcar '(lambda (r) (mxv (trp q) r)) m)
)

;; BUTLAST
;; Retourne la liste sans le dernier élément

(defun butlast (lst)
 (reverse (cdr (reverse lst)))
)

 

[chris_mtp]

Merci Gile pour ta réponse mais j'ai fait comme tu m'as dit précédemment en calculant les coordonnées de mon point nodal avec les facteurs d'échelle et de rotation du bloc.

J'ai vérifié, le calcul des coordonnées du point est correct mais il doit y avoir un autre pb car ca ne marche toujours pas comme je voudrais.

 

J'ai modifié le code.

 

Je pense qu'il doit y avoir un pb de décimales entre le calcul de coordonnées de mon point nodal et les extremites de mes polylignes.

 

Pourtant, j'ai vérifié avec l'Editeur Visual Lisp, la liste lst_b1 me retourne bien une liste de points 2d et les points ptd et ptf sont eux aussi des points 2d et surtout avec le même nombre de décimales.

 

Mais les cercles s'insérent toujours sur les blocs "plaques".

Je ne vois pas mon erreur.

 

Par contre, j'ai essayé ta fonction TransBlk.

En argument, le point pt correspond à quoi exactement.

 

Merci par avance de ton aide.

John.

[chris_mtp]

C'est bon j'ai compris pour ta fonction Transblk.

Elle me retourne le même résultat que moi mais toujours le même problème.

Il y a des cercles sur les blocs plaques alors que l'extremité de mes polylignes arrive bien sur le nodal du bloc et donc sur le nodal du point qu'on calcule.

 

Il doit y avoir un pb de décimales non ?

John.

[(gile)]

Salut,

 

Le point pt correspond aux coordonnées du point (nodal) dans la définition du bloc (l'origine étant le point de base du bloc : 0,0,0 par défaut).

 

Quand on compare des points dans AutoCAD, il est toujours préférable d'utiliser la fonction equal avec une tolérance à cause des inévitables arrondis fait par AutoCAD.

Pour ma part, j'utilise en général un facteur de 1e-9 (0.000000001, soit un milliardième, soit un micron pour 1 kilomètre). Ce facteur permet de comparer des points sans être pris en défaut par les arrondis AutoCAD tout en gardant une précision largement convenable.

 

(equal pt1 pt2 1e-9)

[(gile)]

il me semble que la comparaison est faite dans cette expression :

(not (member ptd lst_b1))

La fonction member compare les éléments sans tolérance : (equal pt1 pt2)

 

Tu peux utiliser vl-member-if avec une fonction qui accepte une tolérance :

 

(not (vl-member-if '(lambda (x) (equal x ptd 1e-9)) lst_b1))

[chris_mtp]

Merci pour la fonction equal mais dans ce cas comment faire avec mes if

 

   (if (not (equal ptd (member ptd lst_b1) 1e-9)) (command "_.circle" ptd 5))
 (if (not (equal ptf (member ptf lst_b1) 1e-9)) (command "_.circle" ptf 5))

 

John

[chris_mtp]

A 2 min près.

Ca marche nickel maintenant.

 

Merci encore Gile.

John.