Modification de lisp.

chris_mtp · le 16 janvier 2009

Bonjour à tous,

Comment puis je modifier ce fabuleux lisp de Bonuscad pour avoir un tableau de coordonnées avec des en têtes de colonnes Numéro de point, X, Y Z et intégré une colonne supplémentaire avec les angles de la polyligne sur chacun de ces sommets ? (sauf bien sur sur le premier et dernier sommet de la polyligne)

 (defun l-coor2l-pt (lst flag / )
(if lst
(cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
(l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
)
)
)
(defun make_field (pt / obj)
(vlax-put (vla-AddPoint Space (vlax-3d-point pt)) 'layer "Id-Point")
(setq obj (entlast))
(mapcar
'(lambda (lx)
(apply
'(lambda (ins_point value_field att_point txt_height dwg_dir name_style name_layer txt_rot / nw_obj)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point ins_point)
0.0
(strcat
"%<\\AcObjProp.16.2 Object(%<\\_ObjId "
(itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
value_field
)
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list att_point txt_height dwg_dir ins_point name_style name_layer txt_rot)
)
)
lx
)
)
(list
(list
pt_ins
">%).Coordinates \\f \"%lu2%pr3\">%"
7
(getvar "TEXTSIZE")
5
"Romand-Field"
"Id-XYZ"
rtx
)
)
)
(setq pt_ins
(mapcar '- pt_ins
(list
0.0
(+ (* (getvar "TEXTSIZE") (sin rtx0) 2.0) (* (* (getvar "TEXTSIZE") 2.0) (cos rtx0)))
0.0
)
)
)
)
(defun c:cell-xyz_field ( / js pt_ins htx rtx rtx0 AcDoc Space ncol nw_style dxf_cod n lremov ent ename l_pt l_pr)
(princ "\nChoix d'un objet modèle pour le filtrage: ")
(while
(null
(setq js
(ssget "_+.:E:S"
(list
'(0 . "LINE,POLYLINE,LWPOLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
)
(princ "\nCe n'est pas un objet valable pour cette fonction!")
)
(initget 1)
(setq pt_ins (getpoint "\nPoint de départ pour l'écriture des coordonnées: "))
(initget 6)
(setq htx (getdist pt_ins (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if htx (setvar "TEXTSIZE" htx))
(if (not (setq rtx (getorient pt_ins "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0))
(setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx))
(vl-load-com)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
ncol '(96 2)
)
(foreach n '("Id-XYZ" "Id-Point")
(cond
((null (tblsearch "LAYER" n))
(vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol))
)
)
(setq ncol (cdr ncol))
)
(cond
((null (tblsearch "STYLE" "Romand-Field"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
)
)
(setq dxf_cod (entget (ssname js 0)))
(initget "Unique Multiple _Single Multiple")
(if (eq (getkword "\nSélection filtrée [unique/Multiple]: ") "Single")
(setq n -1)
(setq
dxf_cod (entget (ssname js 0))
js
(ssget "_X" 
(foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
(setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
)
)
n -1
)
)
(repeat (sslength js)
(setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil)
(setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
(foreach n l_pr
(if (vlax-property-available-p ename n)
(setq l_pt
(if (eq n 'Coordinates)
(progn
(append
(if (eq (vla-get-ObjectName ename) "AcDbPolyline")
(l-coor2l-pt (vlax-get ename n) nil)
(l-coor2l-pt (vlax-get ename n) T)
)
l_pt
)
)
(cons (vlax-get ename n) l_pt)
)
)
)
)
(mapcar 'make_field l_pt)
(setq pt_ins
(mapcar '- pt_ins
(list
0.0
(+ (* (getvar "TEXTSIZE") (sin rtx0) 2.0) (* (* (getvar "TEXTSIZE") 2.0) (cos rtx0)))
0.0
)
)
)
)
(prin1)
)

Merci par avance de votre aide.

John.

chris_mtp · le 17 janvier 2009

J'ai changé mon fusil d'épaule et essayé de faire un petit lisp mais je ne comprend pas pourquoi ca na marche pas.

(defun c:tblcoord (/ ht ts pt pti bdent typent ent ent1 bdent1 typent1 code10 xentit yentit zentit xyzentit i)
(setq ts (getvar "TEXTSIZE"))
(setq ht (* 1.5 ts))
(setq ent (car (entsel "\nCliquez une polyligne :")))
(setq bdent (entget ent))
(setq typent (cdr (assoc 0 bdent)))
(if (= typent "POLYLINE")
(setq i 0)
(setq ent1 (entnext ent))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))
(while (= typent1 "VERTEX")
(setq pt pti)
(setq code10 (cdr (assoc 10 bdent1)))
(setq xentit (car code10))
(setq yentit (cadr code10))
(setq zentit (caddr code10))
(setq xyzentit (strcat (rtos xentit 2 3) " " (rtos yentit 2 3) " " (rtos zentit 2 3)))
(setq pti (getpoint ptb "\nSpécifiez le point d'insertion des coordonnées: "))
(command "_text" "bg" pti "5" "100" xyzentit)
(setq ent1 (entnext ent1))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))
(setq pt (list (car pt) (- (cadr pt) ht)))
)
)
(prin1)
)

Je sélectionne la polyligne 3D mais après il ne me propose pas de choisir le point d'insertion des textes. Pourquoi ?

De plus, comment puis je récupérer la valeur des angles des sommets de ma polyligne ?

Merci par avance de votre aide.

John.

Tramber · le 17 janvier 2009

Y a beaucoup d'erreurs :

Pas de PROGN dans le IF.

Pas d'initialisation du pti (ni du ptb)

Beaucoup de problèmes que j'ai corrigé ici

(defun c:tblcoord (/ ht ts pt pti bdent typent ent ent1 bdent1 typent1 code10 xentit yentit zentit xyzentit i)
 (setq ts (getvar "TEXTSIZE"))
 (setq ht (* 1.5 ts))
 (setq ent (car (entsel "\nCliquez une polyligne :")))
 (setq bdent (entget ent))
 (setq typent (cdr (assoc 0 bdent)))
 (setq pt (getpoint  "\nSpécifiez le point d'insertion des coordonnées: "))
 (if (= typent "POLYLINE")
   (progn
     (setq i 0)
     (setq ent1 (entnext ent))
     (setq bdent1 (entget ent1))
     (setq typent1 (cdr (assoc 0 bdent1)))
     (while (= typent1 "VERTEX")
(setq code10 (cdr (assoc 10 bdent1)))
(setq xentit (car code10))
(setq yentit (cadr code10))
(setq zentit (caddr code10))
(setq xyzentit (strcat (rtos xentit 2 3) " " (rtos yentit 2 3) " " (rtos zentit 2 3)))	
(command "_text" "bg" pt ht "0" xyzentit)
(setq pt (list (car pt) (- (cadr pt) ht)))	
(setq ent1 (entnext ent1))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))	
)
     )
   )
 (prin1)
)

N'oublies pas d'ajouter un code pour contrôler les ACCROBJ !

[Edité le 17/1/2009 par Tramber]

chris_mtp · le 17 janvier 2009

Cette fois, il me propose le point d'insertion mais ne m'insère aucun texte et j'ai beau voir et revoir ce qui cloche walou .......

J'ai définit en début de lisp un (command "_osnap" "auc") et ma chaine de caractere semble correcte.

chris_mtp · le 18 janvier 2009

J'ai essayé de voir si il n'y avait pas un probleme dans ma liste.

J'ai enlevé la variable locale i qui ne sert à mon avis à rien mais ca ne marche pas. Je ne comprends pas.

Merci par avance de votre aide.

John.

(gile) · le 18 janvier 2009

Salut,

J'ai essayé le code corrigé par Tramber, ça fonctionne chez moi à ceci près que la hauteur de texte est égale au décalage vertical entre les lignes.

chris_mtp · le 18 janvier 2009

A nouveau J'ai copié le code de Tramber. Je sélectionne la polyligne et le point d'insertion des textes mais rien de s'affiche même pas le moindre texte. J'ai vérifié aussi les accrobj. Rien ne plus.

si tu as une solution.

Merci par avance.

John.

(gile) · le 18 janvier 2009

Essaye ça

(defun c:tblcoord (/	   ht	   ts	   pt	   pti	   bdent
	   typent  ent	   ent1	   bdent1  typent1 code10
	   xentit  yentit  zentit  xyzentit	   i
	  )
 (setq ts (getvar "TEXTSIZE"))
 (setq ht (* 1.5 ts))
 (setq ent (car (entsel "\nCliquez une polyligne :")))
 (setq bdent (entget ent))
 (setq typent (cdr (assoc 0 bdent)))
 (setq	pt (getpoint
     "\nSpécifiez le point d'insertion des coordonnées: "
   )
 )
 (if (= typent "POLYLINE")
   (progn
     (setq i 0)
     (setq ent1 (entnext ent))
     (setq bdent1 (entget ent1))
     (setq typent1 (cdr (assoc 0 bdent1)))
     (while (= typent1 "VERTEX")
(setq code10 (cdr (assoc 10 bdent1)))
(setq xentit (car code10))
(setq yentit (cadr code10))
(setq zentit (caddr code10))
(setq xyzentit (strcat (rtos xentit 2 3)
		       " "
		       (rtos yentit 2 3)
		       " "
		       (rtos zentit 2 3)
	       )
)
(command "_text" "bg" pt ts "0" xyzentit)
(setq pt (list (car pt) (- (cadr pt) ht)))
(setq ent1 (entnext ent1))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))
     )
   )
   (alert "L'objet séléctionné n'est pas une polyligne 3d.")
 )
 (prin1)
)

chris_mtp · le 18 janvier 2009

C'est bon ca marche nickel.

Merci Gile. Je vais essayer de récupérer la valeur de l'angle pour chaque sommet pour l'intégrer dans le tableau.

Par contre, comment numéroter les sommets de polyligne de 1 à n par exemple?

John.

chris_mtp · le 19 janvier 2009

C'est bon j'ai trouvé comment numéroter les sommets avec la variable i mais maintenant avec une polyligne 2D pourquoi ce lisp ne marche pas ?

Il me retourne erreur: type d'argument

incorrect: lentityp nil

 (defun c:tblpoly2d (/ ht ts pt pti bdent typent ent ent1 bdent1 typent1 code10 xentit yentit xtxt ytxt i)
(command "_osnap" "auc")
(setq ts (getvar "TEXTSIZE"))
(setq ht (* 1.5 ts))
(setq ent (car (entsel "\nCliquez la polyligne 2D:")))
(setq bdent (entget ent))
(setq typent (cdr (assoc 0 bdent)))
(setq pt (getpoint
"\nSpécifiez le point d'insertion des coordonnées: "
)
)
(if (= typent "LWPOLYLINE")
(progn
(setq i 1)
(setq ent1 (entnext ent))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))
(while (= typent1 "VERTEX")
(setq code10 (cdr (assoc 10 bdent1)))
(setq xentit (car code10))
(setq yentit (cadr code10))
(setq itxt (strcat (rtos i 2 0)))
(setq xtxt (strcat (rtos xentit 2 2)))
(setq ytxt (strcat (rtos yentit 2 2)))
(command "_text" "c" pt ts "100" itxt)
(command "_text" "c" (list (+ (car pt) (* 6 ts)) (cadr pt)) ts "100" xtxt)
(command "_text" "c" (list (+ (car pt) (* 15 ts)) (cadr pt)) ts "100" ytxt)
(setq pt (list (car pt) (- (cadr pt) ht)))
(setq ent1 (entnext ent1))
(setq bdent1 (entget ent1))
(setq typent1 (cdr (assoc 0 bdent1)))
(setq i (+ i 1))
)
)

(alert "L'objet séléctionné n'est pas une polyligne 2d.")
)
(prin1)
)

Je pense qu'il consiédère encore la polyligne sélectionné comme une 3D mais je ne vois pas quelle partie du code faut modifier.

Merci par avance de votre aide.

John.

bonuscad · le 19 janvier 2009

La LWPOLYLINE (polyligne optimisée) n'a pas du tout la même définition/structure que la POLYLINE classique 2D ou 3D.

La LWPOLYLINE n'a pas de sous-entité VERTEX.

Donc (entnext) est invalide et il n'y a pas besoin de faire une boucle pour extraire les sommets.

Un (entget (car (entsel))) sur une LWPOLYLINE te retournera toutes les infos DXF disponibles.

Tu peux avoir tous les sommets avec cette ligne de code bien connue et beaucoup utilisé pour les LWPOLYLINE.

(mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel)))))

onossa · le 22 janvier 2009

Je vois que cette requête rejoint en partie mon post...

Merci pour ton aide bonuscad

(ce qui m'interesse c'est justement les polyligne 2d, même si ça ne me dérangerai vraiment pas qu'il puisse traiter les deux !

Je t'invite à voir mon post, chris_mtp

(je suis novice et je sais pas créer un lien ici...)

chris_mtp · le 24 janvier 2009

Merci Bonuscad pour cette info et merci onossa pour ta réponse.

Si la commande permet de récupérer tous les sommets d'une polyligne,

Comment extraire puis écrire les coordonnées X Y et surtout comment savoir le nombre de sommet de la polyligne sélectionné ?

J'ai modifié ce lisp donc comme suit mais il me manque un truc.....

(defun c:tblpoly2d (/ ht ts pt pti bdent typent entsel code10 xentit yentit xtxt ytxt i)
(command "_osnap" "auc")
(setq ts (getvar "TEXTSIZE"))
(setq ht (* 1.5 ts))
(mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel)))))
(setq bdent (entget entsel))
(setq typent (cdr (assoc 0 bdent)))
(setq code10 (cdr (assoc 10 bdent1)))
(setq pt (getpoint
"\nSpécifiez le point d'insertion des coordonnées: "
)
)
(if (= typent "LWPOLYLINE")
(progn
(setq i 1)
(setq xentit (car code10))
(setq yentit (cadr code10))
(setq itxt (strcat (rtos i 2 0)))
(setq xtxt (strcat (rtos xentit 2 2)))
(setq ytxt (strcat (rtos yentit 2 2)))
(command "_text" "c" pt ts "100" itxt)
(command "_text" "c" (list (+ (car pt) (* 6 ts)) (cadr pt)) ts "100" xtxt)
(command "_text" "c" (list (+ (car pt) (* 15 ts)) (cadr pt)) ts "100" ytxt)
(setq pt (list (car pt) (- (cadr pt) ht)))

(setq i (+ i 1))
)

(alert "L'objet séléctionné n'est pas une polyligne 2d.")
)
(prin1)
)

Et surtout ce qui m'intéresse, commet extraire les coordonnées de 3 points à la suite pour avoir la valeur de l'angle de chaque sommet de la LWPOLYLIGNE?

J'ai essayé la fonction polar mais ca marche pas....

Merci par avance de votre aide.

John.

chris_mtp · le 24 janvier 2009

C'est bon j'ai modifié le lips précédent pour avoir un listing N° X Y d'une LWPOLYLIGN

Voici le code

 (defun c:tblang (/ ht ts pt pti ent bdent typent entit codeentit xentit yentit xtxt ytxt atxt i a)
(command "_osnap" "auc")
(setq ts (getvar "TEXTSIZE"))
(setq ht (* 1.5 ts))
(setq ent (car (entsel "\nCliquez une polyligne :")))
(setq bdent (entget ent))
(setq typent (cdr (assoc 0 bdent)))
(if (= typent "LWPOLYLINE")
(progn
(setq pt (getpoint
"\nSpécifiez le point d'insertion des coordonnées: "
)
)
(setq i 1)
(setq a 1)
(repeat (length bdent)
(setq entit (nth i bdent))
(setq codeentit (car entit))
(if (= codeentit 10)
(progn
(setq xentit (car (cdr entit)))
(setq yentit (cadr (cdr entit)))
(setq atxt (strcat (rtos a 2 0)))
(setq xtxt (strcat (rtos xentit 2 2)))
(setq ytxt (strcat (rtos yentit 2 2)))
(command "_text" "c" (list (+ (car pt) 2.5) (cadr pt)) ts "100" atxt)
(command "_text" "c" (list (+ (car pt) (* 6.25 ts)) (cadr pt)) ts "100" xtxt)
(command "_text" "c" (list (+ (car pt) (* 15 ts)) (cadr pt)) ts "100" ytxt)
(setq pt (list (car pt) (- (cadr pt) ht)))
(setq a (+ a 1))
)
)
(setq i (+ i 1))

)
)
(alert "L'objet séléctionné n'est pas une polyligne 2d.")
)
(prin1)
)

Mais maintenant pour déterminer la valeur de l"angle de chaque sommet, j'ai essayé la fonction angle qui marche bien mais je ne sais pas choisir le point suivant de la polylign.

En fait il me faudrait insérer deux colonnes supplémentaires, une pour l'angle de chaque sommet et une autre pour le gisement.

Si vous avez une idée.

Merci par avance de votre aide.

John.

(gile) · le 24 janvier 2009

Salut,

Quelques petites suggestions :

Pour l'accrochage aux objets,

plutôt que :

(command "_osnap" "auc")

tu peux utiliser la variable système OSMODE :

(setq osm (getvar "OSMODE")) ; sauvegarder la valeur initiale
(setvar "OSMODE" 0) ; désactiver les accrochages

et à la fin du code :

(setvar "OSMODE" osm) ; restaurer la valeur initiale

Pour la rotation des textes,

ta routine ne fonctionne que dans un environnement en grades, rotation horaire et 0 au nord.

Pour un fonctionnement cohérent dans tous les environnements, tu peux utiliser la fonction angtos qui convertit un angle exprimé en nombre réel (radians) en une chaîne (unité angulaire courante et prise en compte des variables ANGDIR et ANGBASE).

Tu peux donc faire, au début du code :

(setq rot (angtos (angle '(0 0) '(1 0)) (getvar "AUNITS") 14)

puis :

(command "_text" "c" (list (+ (car pt) 2.5) (cadr pt)) ts [b]rot[/b] atxt)

La fonction angtos servira aussi pour écrire l'angle d'un segment (valeurs courantes de AUNITS et AUPREC) :

(setq angtxt (angtos (angle p1 p2))

Pour pouvoir récupérer les angles, il est plus commode de récupérer la liste des sommets :

(setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) bdent)))

Ensuite tu boucles sur cette liste pour récupérer les coordonnées et, à partir du second sommet, tu peux récupérer l'angle (gisement) du premier segment (i = 1) :

(angtos (angle (nth (1- i) ptlst) (nth i ptlst)))

chris_mtp · le 25 janvier 2009

Gile meric pour tes petites suggestions.

J'ai fait ce petit lisp mais je manque de connaissances sur les listes.

Je pense que la première est la seconde liste se confonde.

Du coup, je n'ai pas tous les sommets de la polyligne.

 (defun c:tblang (/ gitxt ptgi ptag agtxt ptlst osm rot ht ts pt pti ent bdent typent entit codeentit xentit yentit xtxt ytxt atxt i a)
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setvar "TEXTSTYLE" "STANDARD")
(setq ts (getvar "TEXTSIZE"))
(setvar "AUNITS" 2)
(setvar "ANGDIR" 1)
(setvar "AUPREC" 3)
(setvar "ANGBASE" 0)
(setq rot (angtos (angle '(0 0) '(1 0)) (getvar "AUNITS") 14))
(setq ht (* 1.5 ts))
(setq ent (car (entsel "\nCliquez une polyligne :")))
(setq bdent (entget ent))
(setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) bdent)))
(setq typent (cdr (assoc 0 bdent)))
(if (= typent "LWPOLYLINE")
(progn
(setq pt (getpoint
"\nSpécifiez le point d'insertion des coordonnées: "
)
)
(setq i 1)
(setq a 1)
(repeat (length bdent)
(setq entit (nth i bdent))
(setq codeentit (car entit))
(if (= codeentit 10)
(progn
(setq xentit (car (cdr entit)))
(setq yentit (cadr (cdr entit)))
(setq atxt (strcat (rtos a 2 0)))
(setq xtxt (strcat (rtos xentit 2 2)))
(setq ytxt (strcat (rtos yentit 2 2)))
(command "_text" "c" (list (+ (car pt) 2.5) (cadr pt)) ts rot atxt)
(command "_text" "c" (list (+ (car pt) (* 6.25 ts)) (cadr pt)) ts rot xtxt)
(command "_text" "c" (list (+ (car pt) (* 15 ts)) (cadr pt)) ts rot ytxt)
(setq a (+ a 1))
(setq agtxt (angtos (angle (nth (1- i) ptlst) (nth i ptlst))))
(setq gitxt (angtos (angle (nth (1- i) ptlst) (nth i ptlst))))
(setq ptag (list (+ (car pt) (* 23 ts)) (cadr pt)))
(setq ptgi (list (+ (car pt) (* 30 ts)) (cadr pt)))
(command "_text" "c" ptag ts rot agtxt)
(command "_text" "c" ptgi ts rot gitxt)
(setq pt (list (car pt) (- (cadr pt) ht)))
)
)
(setq i (+ i 1))

)
)
(alert "L'objet séléctionné n'est pas une polyligne 2d.")
)
(setvar "OSMODE" osm)
(prin1)
)

Il faut certainement compiler les deux listes pour en faire une seule mais comment ?

De plus, l'angle retourné dans la variable agtxt correspond non pas au gisement mais à un autre angle lequel ??????

Et pour le gisement, on peut le calculer à partir de l'angle de deux sommets consécutifs mais comment récupérer la valeur de l'angle suivant ?

Merci par avance de votre aide.

John.

(gile) · le 25 janvier 2009

Salut,

Tu n'as pas besoin de "compiler les deux listes. PtLst est la liste des sommets de la polyligne, on ne se sert que de cette liste pour récupérer coordonnées et angles.

Évite de forcer les variables système (AUNITS, ANGDIR, AUPREC, ANGBASE) si tu ne restaure pas leur valeurs initiales en fin de code.

Le plus "propre" à mon sens, est de retourner les résultats dans les unités courantes.

(defun c:tblang	(/	gitxt  ptgi   ptag   agtxt  ptlst  osm
	 rot	ht     ts     pt     pti    ent	   bdent
	 typent	entit  codeentit     xentit yentit xtxt
	 ytxt	atxt   i      a
	)
 (setq osm (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setvar "TEXTSTYLE" "STANDARD")
 (setq ts (getvar "TEXTSIZE"))
 (setq rot (angtos (angle '(0 0) '(1 0)) (getvar "AUNITS") 14))
 (setq ht (* 1.5 ts))
 (setq ent (car (entsel "\nCliquez une polyligne :")))
 (setq bdent (entget ent))
 (setq	ptlst
 (mapcar 'cdr
	 (vl-remove-if-not '(lambda (x) (= (car x) 10)) bdent)
 )
 )
 (setq typent (cdr (assoc 0 bdent)))
 (if (= typent "LWPOLYLINE")
   (progn
     (setq pt (getpoint
	 "\nSpécifiez le point d'insertion des coordonnées: "
       )
     )
     (setq i 0)
     (setq a 1)
     (repeat (length ptlst)
(setq entit (nth i ptlst))
(setq xentit (car entit))
(setq yentit (cadr entit))
(setq atxt (itoa a))
(setq xtxt (rtos xentit 2 2))
(setq ytxt (rtos yentit 2 2))
(command "_text"
	 "c"
	 (list (+ (car pt) 2.5) (cadr pt))
	 ts
	 rot
	 atxt
)
(command "_text"
	 "c"
	 (list (+ (car pt) (* 6.25 ts)) (cadr pt))
	 ts
	 rot
	 xtxt
)
(command "_text"
	 "c"
	 (list (+ (car pt) (* 15 ts)) (cadr pt))
	 ts
	 rot
	 ytxt
)
;; angle 
(if (	  (progn
    (setq
      agtxt (angtos (angle (nth (1- i) ptlst) (nth i ptlst)))
    )
    (setq ptag (list (+ (car pt) (* 23 ts)) (+ (cadr pt) ht)))
    (command "_text" "c" ptag ts rot agtxt)
  )
)
(setq pt (list (car pt) (- (cadr pt) ht)))
(setq a (+ a 1))
(setq i (+ i 1))
     )

     ;; si la polyligne est fermée
     (if (= 1 (logand 1 (cdr (assoc 70 bdent))))
(command
  "_text"
  "c"
  (list (+ (car pt) (* 23 ts)) (+ (cadr pt) ht))
  ts
  rot
  (angtos (angle (nth (1- i) ptlst) (nth 0 ptlst)))
  )
)
   )
   (alert "L'objet séléctionné n'est pas une polyligne 2d.")
 )
 (setvar "OSMODE" osm)
 (prin1)
)

chris_mtp · le 25 janvier 2009

Merci Gile pour ta réponse.

En effet, dans les cas généraux, il ne faut pas changer les variables si on ne les restaure pas après mais vu que je travaille chaque fois dans le format d'unités, j'ai insérer ces variables selon mes besoins.

Par contre, si j'ai bien compris, il n'existe pas de fonction AutoCAD qui permet de récupérer l'angle d'un sommet d'une polyligne formé par deux cotés.

Seulement le gisement d'un vecteur.

Merci de ton aide.

John.

(gile) · le 25 janvier 2009

Re,

Non, il n'existe pas de fonction AutoLISP prédéfinie pour retourner l'angle entre deux segments de polyligne, mais il suffit d'en écrire une et de l'appeler dans la fonction principale :

(defun ang2d (p1 p2 p3 / ang)
 (setq ang (- (angle p2 p3) (angle p2 p1)))
 (if (minusp ang)
   (setq ang (+ ang (* 2 pi)))
 )
 (if (    (setq ang (- (* 2 pi) ang))
 )
 ang
)

;;; Fonction principale

(defun c:tblang	(/	gitxt  ptgi   ptag   agtxt  ptlst  osm
	 rot	ht     ts     pt     pti    ent	   bdent
	 typent	entit  codeentit     xentit yentit xtxt
	 ytxt	atxt   i      a
	)
 (setq osm (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setvar "TEXTSTYLE" "STANDARD")
 (setq ts (getvar "TEXTSIZE"))
 (setq rot (angtos (angle '(0 0) '(1 0)) (getvar "AUNITS") 14))
 (setq ht (* 1.5 ts))
 (setq ent (car (entsel "\nCliquez une polyligne :")))
 (setq bdent (entget ent))
 (setq	ptlst
 (mapcar 'cdr
	 (vl-remove-if-not '(lambda (x) (= (car x) 10)) bdent)
 )
 )
 (setq typent (cdr (assoc 0 bdent)))
 (if (= typent "LWPOLYLINE")
   (progn
     (setq pt (getpoint
	 "\nSpécifiez le point d'insertion des coordonnées: "
       )
     )
     (setq i 0)
     (setq a 1)
     (repeat (length ptlst)
(setq entit (nth i ptlst))
(setq xentit (car entit))
(setq yentit (cadr entit))
(setq atxt (itoa a))
(setq xtxt (rtos xentit 2 2))
(setq ytxt (rtos yentit 2 2))
(command "_text"
	 "c"
	 (list (+ (car pt) 2.5) (cadr pt))
	 ts
	 rot
	 atxt
)
(command "_text"
	 "c"
	 (list (+ (car pt) (* 6.25 ts)) (cadr pt))
	 ts
	 rot
	 xtxt
)
(command "_text"
	 "c"
	 (list (+ (car pt) (* 15 ts)) (cadr pt))
	 ts
	 rot
	 ytxt
)
(if (	  (progn
    (setq ptag (list (+ (car pt) (* 23 ts)) (cadr pt)))
    (setq ptgi (list (+ (car pt) (* 30 ts)) (+ (cadr pt) ht)))
    ;; angle au sommet
    (if	(	      (command "_text"
	       "c"
	       ptag
	       ts
	       rot
	       (angtos (ang2d (nth (1- i) ptlst)
			      (nth i ptlst)
			      (nth (1+ i) ptlst)
		       )
	       )
      )
    )
    ;; gisement
    (setq
      gitxt (angtos (angle (nth (1- i) ptlst) (nth i ptlst)))
    )
    (command "_text" "c" ptgi ts rot gitxt)
  )
  (if (= 1 (logand 1 (cdr (assoc 70 bdent)))) ; polyligne fermée
    (command
      "_text"
      "c"
      (list (+ (car pt) (* 23 ts)) (cadr pt))
      ts
      rot
      (angtos
	(ang2d (last ptlst) (nth i ptlst) (nth (1+ i) ptlst))
      )
    )
  )
)
(setq pt (list (car pt) (- (cadr pt) ht)))
(setq a (+ a 1))
(setq i (+ i 1))
     )

     ;; si la polyligne est fermée
     (if (= 1 (logand 1 (cdr (assoc 70 bdent))))
(command
  "_text"
  "c"
  (list (+ (car pt) (* 23 ts)) (+ (cadr pt) ht))
  ts
  rot
  (angtos (ang2d (nth (- i 2) ptlst) (nth (1- i) ptlst) (car ptlst))
  )
  "_text"
  "c"
  (list (+ (car pt) (* 30 ts)) (+ (cadr pt) ht))
  ts
  rot
  (angtos (angle (nth (1- i) ptlst) (nth 0 ptlst)))
)
     )
   )
   (alert "L'objet séléctionné n'est pas une polyligne 2d.")
 )
 (setvar "OSMODE" osm)
 (prin1)
)

chris_mtp · le 26 janvier 2009

[Edité le 26/1/2009 par chris_mtp]

chris_mtp · le 26 janvier 2009

Merci Gile pour ta réponse mais il ya des bugs.

Bonuscad sur l'autre post a fait un lisp identique au tien.

J'ai testé les deux en profondeur avec des polylignes dans tous les sens.

J'ai essayé d'intégrer les variables ANGBASE à 0 et ANGDIR à 100 mais il ne retourne que les angles à gauche de la polyligne hors lorque l'angle est supérieur à 200 gr il faut indiquer son complément à 400.

J'ai réussi à le modifier pour avoir les angles à droite mais pas pour avoir le complément à 400gr.

En tout cas, merci quand même de ton aide.

John.

chris_mtp · le 30 janvier 2009

Bonjour Gile

Ne serait il pas possible de soustraire la valeur de l'angle à 500gr ?

Pourquoi ? Je sais pas mais constamment et ceci sur plusieurs dessins, en sousttriyant la valeur de l'angle donnée à 500gr, le résultat est celui escompté..

J'ai essayé de modifier le lisp mais je ne comprends pas très bien la fonction ang2d.

Merci par avance de ton aide.

John

(gile) · le 30 janvier 2009

Salut

Essaye en remplaçant ang2d par cette version, ça devrait fonctionner quelles que soient les valeurs de ANGBASE et ANGDIR

(defun ang2d (p1 p2 p3 / base ang)
 (setq base (getvar "ANGBASE"))
 (setq ang (abs (- (angle p2 p1) (angle p2 p3))))
 (if (    (setq ang (- (* 2 pi) ang))
 )
 (if (zerop (getvar "ANGDIR"))
   (+ base ang)
   (- base ang)
 )
)

chris_mtp · le 31 janvier 2009

Merci Gile ca marche nickel maintenant.

Par contre, il faut quand même configurer la variable ANGDIR à 1 et ANGBASE 100 pour avoir les angles corrects style topo.

John

(gile) · le 31 janvier 2009

Par contre, il faut quand même configurer la variable ANGDIR à 1 et ANGBASE 100 pour avoir les angles corrects style topo.

Bien sûr, l'idée est de faire une routine qui fonctionne quelque soit la configuration.

L'expression LISP (setq ang (angle p1 p2)) retourne l'angle du segment p1 p2 par rapport à l'axe X du SCU courant, dans le sens trigonométrique et en radians quelles que soient les valeurs de AUNITS ANGDIR et ANGBASE.

L'expression (angtos ang), au delà de traduire un nombre en chaîne, convertit l'angle dans les unités angulaire courante en prenant en compte les valeurs de ANGDIR et ANGBASE.

Exemple avec un angle de pi/8 radians (50gr)

(setq ang (/ pi 8))

avec ANGDIR = 0 et ANGBASE = 0

(angtos ang) retourne "25g"

avec ANGDIR = 1 et ANGBASE = 100

(angtos ang) retourne "75g"

Il faut donc, avant de passer ang à la fonction angtos, le soustraire (ou l'ajouter suivant ANGDIR) à la valeur de ANGBASE.

(setq ang (- (getvar "ANGBASE") (/ pi 8)))

avec ANGDIR = 0 et ANGBASE = 0

(angtos ang) retourne "375g" (400 - 25)

avec ANGDIR = 1 et ANGBASE = 100

(angtos ang) retourne "25g"

La routine ang2d écrite un peu différemment

(defun ang2d (p1 p2 p3 / ang)
 (if (    (setq ang (- (* 2 pi) ang))
 )
 (if (zerop (getvar "ANGDIR"))
   (+ (getvar "ANGBASE") ang)
   (- (getvar "ANGBASE") ang)
 )
)

Modification de lisp.

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante