Ecriture de propriété sur lwpolylignes

fabcad · le 4 février 2010

Bonjour,

Je sollicite les "Lucky Luke" de la programmation !

SVP je desire un programme Lisp/VLisp qui travaille au niveau des lwpolylignes fermées ou non fermées.

=== Questions / Parametres ===
- Selection AutoCAD classique (par choix des objets) avec comme filtre les lwpolylignes.

=== Traitement ===
Dans une routine globale : parcourir les lwpolylignes et sur chaque lwpolyligne :

Condition 1 - Si la lwpolyligne ne possède que deux points début et fin,
trouver le milieu et faire appel à la sous-routine pour écrire avec un mtexte (largeur à 0) le nom de calque en prenant l'angle de ces deux points
en ayant la lecture la plus aisée.

Condition 2 - Si la lwpolyligne possède plus que deux points,
trouver le milieu et chercher le segment qui se trouve sur ce milieu car c'est sur ce segment que je voudrais faire appel à la sous-routine
de recherche du calque de la polyligne en cours pour écrire avec un mtexte (largeur à 0) le nom de calque en prenant l'angle de ces deux points
en ayant la lecture la plus aisée.

Condition 3 - Si la lwpolyligne est fermée alors placer au centroide le mtexte (largeur à 0) le nom de calque avec un angle de 0.

Condition 4 - l'objet mtexte sera sur le calque de la lwpolyligne.

=== Sous-routine ===
Pourquoi - Car l'interet de cette fonction est de récupérer une valeur de champ de table de données d'objets AutoCAD MAP,
que je ferais, mais pour la routine, commencer par le calque me semble judicieux pour les personnes qui ne possèdent pas AutoCAD MAP.

Merci d'avance de votre aide,

[Edité le 11/2/2010 par fabcad]

lecrabe · le 4 février 2010

Hello Fab

Tres bien ton CDC/CCTP, je suis preneur avec une petite amelioration / Question

Le texte genere sera :

- soit le nom du calque des Polylignes, ( comme tu le demandes)

- soit un texte quelconque saisi prealablement dans une question

Qu'en penses tu ?

Bien entendu, je suis preneur ulterieurement de la routine modifiee qui transferera la contenu (index) du texte dans un champ de table de donnees d'objet sur la polyligne !

Le Decapode (A fond sur MAP 2006 en ce moment)

lecrabe · le 4 février 2010

ReHello

L'autre probleme c les centroids qui se trouvent a l'exterieur de la polyligne (close ou pas)

Polygones (clos ou non) en forme de U ou de L par exemple

Comment les detecter ? (sans parler des croisement ou papillons) ??

Gilles (je crois) avait fait une routine (je ne sais plus laquelle) qui ecrivait un texte dans le triangle des 3 premiers points d'une polyligne DONC on etait forcement a l'interieur !

Qu'en penses tu ?

Le Decapode (A fond dans le POSPLU)

fabcad · le 4 février 2010

Bonjour,

Je savais que tu serais preneur mon ami LeCrabe,

J'ai noté ceci à la fin :

=== Sous-routine ===
Pourquoi - Car l'interet de cette fonction est de récupérer une valeur de champ de table de données d'objets AutoCAD MAP,
que je ferais, mais pour la routine, commencer par le calque me semble judicieux pour les personnes qui ne possèdent pas AutoCAD MAP.

En effet, pour le centroïde nous souhaiterions plutôt le point Center de MAP mais déjà ce programme serait la bienvenue.

A+

Patrick_35 · le 4 février 2010

Hello

Un premier jet

(defun c:ctxt(/ ang doc ent jus tot pt1 pt2 ptm reg)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (if (ssget (list (cons 0 "LWPOLYLINE")))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(if (eq (vla-get-closed ent) :vlax-true)
  (progn
    (setq reg (vlax-invoke (if (= (getvar "CVPORT") 1)
			     (vla-get-paperspace doc)
			     (vla-get-modelspace doc)
			   )
			   'addregion
			   (list ent)
	      )
	  ptm (append (vlax-get (car reg) 'centroid) (list (getvar "thickness")))
	  ang 0
	  jus 2
    )
    (vla-delete (car reg))
  )
  (progn
    (setq tot 0)
    (while (< (vlax-curve-getdistatparam ent tot) (/ (vla-get-length ent) 2))
      (setq tot (1+ tot))
    )
    (setq pt1 (vlax-curve-getpointatparam ent (1- tot))
	  pt2 (vlax-curve-getpointatparam ent tot)
	  ptm (polar pt1 (setq ang (angle pt1 pt2)) (/ (distance pt1 pt2) 2))
	  jus 1
    )
  )
)
(entmake (list	(cons   0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons   1 (vla-get-layer ent))
		(cons   7 (getvar "dimstyle"))
		(cons   8 (vla-get-layer ent))
		(cons  10 ptm)
		(cons  11 ptm)
		(cons  40 (getvar "textsize"))
		(cons  50 ang)
		(cons  72 1)
		(cons  73 jus)
	 )
)
(vla-delete sel)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

@+

lecrabe · le 4 février 2010

Hello

Sur MAP 2006 ou MAP 2008, j'ai un probleme :

Commande: _appload CTXT.lsp correctement chargé(s)

Commande: ; erreur: type d'argument incorrect: numberp: nil

Le Decapode

lecrabe · le 4 février 2010

Hello

Sorry j'avais rate une parenthese dans le copier / coller (quelle truffe)

maintenant je n'ai plus d'erreur au chargement !

Par contre je selectionne des polylignes ouvertes ou closes, et il ne se passe RIEN !

Le Decapode

(gile) · le 4 février 2010

Salut,

Je suis content que Patrick_35 réponde, j'ai trop de trucs sur le feu actuellement...

Pour le centroid des polylignes, j'avais fait une routine ici, qui est plus efficace que l'utilisation d'une région (pas d'utilisation des DLL de modeler).

fabcad · le 4 février 2010

Pareil pour moi, je pensais au style de texte donc j'ai affecté une valeur de 5 unités au lieu de zéro mais non plus pas de textes à l'horizon.

A+

fabcad · le 4 février 2010

Voilou Voilou,

Ça marche maintenant avec des cons en apostrophes et dimstyle remplacé par textstyle.

Mais sur une selection de plusieurs lwpolylignes il y en a qu'une qui marche. En faisant une par une ca fonctionne , il semble que la boucle ne fonctionne pas.

(defun c:ctxt(/ ang doc ent jus tot pt1 pt2 ptm reg)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (ssget (list (cons 0 "LWPOLYLINE")))
(progn
	(vlax-for ent (setq sel (vla-get-activeselectionset doc))
		(if (eq (vla-get-closed ent) :vlax-true)
			(progn
				(setq reg
				(vlax-invoke
					(if (= (getvar "CVPORT") 1)
						(vla-get-paperspace doc)
						(vla-get-modelspace doc)
					)
				'addregion
				(list ent)
				)
				ptm (append (vlax-get (car reg) 'centroid) (list (getvar "thickness")))
				ang 0
				jus 2
				);fin setq
(vla-delete (car reg))
);fin progn
(progn
	(setq tot 0)
		(while (< (vlax-curve-getdistatparam ent tot) (/ (vla-get-length ent) 2))
		(setq tot (1+ tot))
		)
		(setq pt1 (vlax-curve-getpointatparam ent (1- tot))
		pt2 (vlax-curve-getpointatparam ent tot)
		ptm (polar pt1 (setq ang (angle pt1 pt2)) (/ (distance pt1 pt2) 2))
		jus 1
		)
)
		)
		(setq hauteur_texte 5)
		(princ (strcat (vla-get-layer ent) " et " (angtos ang 0 2) " Degré"))
(entmake (list '(0 . "TEXT")
		'(100 . "AcDbEntity")
		'(100 . "AcDbText")
		(cons   1 (vla-get-layer ent))
		(cons   7 (getvar "TEXTSTYLE"))
		(cons   8 (vla-get-layer ent))
		(cons  10 ptm)
		(cons  11 ptm)
		;(cons  40 (getvar "textsize"))
		(cons  40 hauteur_texte)
		(cons  50 ang)
		(cons  71 0)
		(cons  72 1)
		(cons  73 2)
	 )
)
(vla-delete sel)
)
)
)
(vla-endundomark doc)
(princ)
)

[Edité le 4/2/2010 par fabcad]

Patrick_35 · le 4 février 2010

grumf.. :question:

Je dois être fatigué.

Une erreur de variable qu'a vu fabcad + l'effacement du jeu de sélection dans la boucle :o

Le lisp corrigé

(defun c:ctxt(/ ang doc ent jus tot pt1 pt2 ptm reg txt)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (and (eq (setq txt (getstring T "\n\tTexte à générer (Défaut = Nom du calque) : ")) "")
   (setq txt nil)
 )
 (if (ssget (list (cons 0 "LWPOLYLINE")))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(if (eq (vla-get-closed ent) :vlax-true)
  (progn
    (setq reg (vlax-invoke (if (= (getvar "CVPORT") 1)
			     (vla-get-paperspace doc)
			     (vla-get-modelspace doc)
			   )
			   'addregion
			   (list ent)
	      )
	  ptm (append (vlax-get (car reg) 'centroid) (list (getvar "thickness")))
	  ang 0
	  jus 2
    )
    (vla-delete (car reg))
  )
  (progn
    (setq tot 0)
    (while (< (vlax-curve-getdistatparam ent tot) (/ (vla-get-length ent) 2))
      (setq tot (1+ tot))
    )
    (setq pt1 (vlax-curve-getpointatparam ent (1- tot))
	  pt2 (vlax-curve-getpointatparam ent tot)
	  ptm (polar pt1 (setq ang (angle pt1 pt2)) (/ (distance pt1 pt2) 2))
	  jus 1
    )
  )
)
(and (> ang (/ pi 2)) (< ang (+ pi (/ pi 2)))
  (setq ang (+ ang pi))
)
(entmake (list	(cons   0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(if txt
		  (cons   1 txt)
		  (cons   1 (vla-get-layer ent))
		)
		(cons   7 (getvar "textstyle"))
		(cons   8 (vla-get-layer ent))
		(cons  10 ptm)
		(cons  11 ptm)
		(cons  40 (getvar "textsize"))
		(cons  50 ang)
		(cons  72 1)
		(cons  73 jus)
	 )
)
     )
     (vla-delete sel)
   )
 )
 (vla-endundomark doc)
 (princ)
)

(gile) :

Je suis content que Patrick_35 réponde

On est plusieurs sur Cadxp à pouvoir répondre :D

j'avais fait une routine

Je vais regarder de plus près, merci

@+

[Edité le 4/2/2010 par Patrick_35]

(gile) · le 4 février 2010

Un truc comme ça ?

(defun c:PrintLayer (/ ss ins ang txt)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
 (if (ssget '((0 . "LWPOLYLINE")))
   (progn
     (setq space (if (= 1 (getvar 'cvport))
	     (vla-get-PaperSpace *acdoc*)
	     (vla-get-ModelSpace *acdoc*)
	   )
     )
     (vlax-for	pl (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(if (= (vla-get-Closed pl) :vlax-false)
  (progn
    (setq ins (vlax-curve-getPointAtDist
		pl
		(/ (vla-get-Length pl) 2.)
	      )
	  ang (angle '(0. 0. 0.)
		     (vlax-curve-getFirstDeriv
		       pl
		       (vlax-curve-getParamAtPoint pl ins)
		     )
	      )
    )
    (and (minusp (cos ang)) (setq ang (+ ang pi)))
    (setq txt
	   (vla-addMtext
	     space
	     (vlax-3d-point ins)
	     0.0
	     (vla-get-Layer pl)
	   )
    )
    (vla-put-Rotation txt ang)
    (vla-put-AttachmentPoint txt acAttachmentPointBottomCenter)
    (vla-put-InsertionPoint txt (vlax-3d-point ins))
  )
  (progn
    (setq ins (pline-centroid (vlax-vla-object->ename pl))
	  txt
	   (vla-addMtext
	     space
	     (vlax-3d-point ins)
	     0.0
	     (vla-get-Layer pl)
	   )
    )
    (vla-put-AttachmentPoint txt acAttachmentPointMiddleCenter)
    (vla-put-InsertionPoint txt (vlax-3d-point ins))
  )
)
     )
     (vla-delete ss)
   )
 )
 (princ)
)

;; ALGEB-AREA
;; Retourne l'aire algébrique du triangle défini par 3 points 2D
;; l'aire est négative si les points sont en sens horaire

(defun algeb-area (p1 p2 p3)
 (/ (-	(* (- (car p2) (car p1))
   (- (cadr p3) (cadr p1))
)
(* (- (car p3) (car p1))
   (- (cadr p2) (cadr p1))
)
    )
    2.0
 )
)

;; TRIANGLE-CENTROID
;; Retourne le centre de gravité d'un triangle défini par 3 points

(defun triangle-centroid (p1 p2 p3)
 (mapcar (function (lambda (x1 x2 x3)
	      (/ (+ x1 x2 x3) 3.0)
	    )
  )
  p1
  p2
  p3
 )
)

;; POLYARC-CENTROID
;; Retourne une liste dont le premier élément est le centre de gravité du polyarc
;; et le second son aire algébrique (négative si la courbure est en sens horaire)
;;
;; Arguments
;; bu : la courbure du polyarc (bulge)
;; p1 : le sommet de départ
;; p2 : le sommet de fin

(defun polyarc-centroid	(bu p1 p2 / ang rad cen area cg)
 (setq	ang  (* 2 (atan bu))
rad  (/	(distance p1 p2)
	(* 2 (sin ang))
     )
cen  (polar p1
	    (+ (angle p1 p2) (- (/ pi 2) ang))
	    rad
     )
area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
cg   (polar cen
	    (- (angle p1 p2) (/ pi 2))
	    (/ (expt (distance p1 p2) 3) (* 12 area))
     )
 )
 (list cg area)
)

;; PLINE-CENTROID
;; Retourne le centre de gravité d'une polyligne (coordonnées SCG)
;;
;; Argument
;; pl : nom d'entité de la polyligne (ename)

(defun pline-centroid (pl / elst lst tot cen p0 p-c cen area)
 (setq elst (entget pl))
 (while (setq elst (member (assoc 10 elst) elst))
   (setq lst  (cons (cons (cdar elst) (cdr (cadddr elst))) lst)
  elst (cdr elst)
   )
 )
 (setq	lst (reverse lst)
tot 0.0
cen '(0.0 0.0)
p0  (caar lst)
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
  cen (mapcar (function (lambda (x) (* x (cadr p-c)))) (car p-c))
  tot (cadr p-c)
   )
 )
 (setq lst (cdr lst))
 (if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
 )
 (while (cadr lst)
   (setq area (algeb-area p0 (caar lst) (caadr lst))
  cen  (mapcar (function (lambda (x1 x2) (+ x1 (* x2 area))))
	       cen
	       (triangle-centroid p0 (caar lst) (caadr lst))
       )
  tot  (+ area tot)
   )
   (if	(/= 0 (cdar lst))
     (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))
    cen	(mapcar	(function (lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))))
		cen
		(car p-c)
	)
    tot	(+ tot (cadr p-c))
     )
   )
   (setq lst (cdr lst))
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
  cen (mapcar (function (lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))))
	      cen
	      (car p-c)
      )
  tot (+ tot (cadr p-c))
   )
 )
 (trans (list (/ (car cen) tot)
       (/ (cadr cen) tot)
       (cdr (assoc 38 (entget pl)))
 )
 pl
 0
 )
)

fabcad · le 4 février 2010

La même mais avec la création d'un mtext et de la justification milieu centre.

(defun c:cmtxt(/ ang doc ent jus tot pt1 pt2 ptm reg)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (ssget (list (cons 0 "LWPOLYLINE")))
(progn
	(vlax-for ent (setq sel (vla-get-activeselectionset doc))
		(if (eq (vla-get-closed ent) :vlax-true)
			(progn
				(setq reg
				(vlax-invoke
					(if (= (getvar "CVPORT") 1)
						(vla-get-paperspace doc)
						(vla-get-modelspace doc)
					)
				'addregion
				(list ent)
				)
				ptm (append (vlax-get (car reg) 'centroid) (list (getvar "thickness")))
				ang 0
				jus 2
				);fin setq
(vla-delete (car reg))
);fin progn
(progn
	(setq tot 0)
		(while (< (vlax-curve-getdistatparam ent tot) (/ (vla-get-length ent) 2))
		(setq tot (1+ tot))
		)
		(setq pt1 (vlax-curve-getpointatparam ent (1- tot))
		pt2 (vlax-curve-getpointatparam ent tot)
		ptm (polar pt1 (setq ang (angle pt1 pt2)) (/ (distance pt1 pt2) 2))
		jus 1
		)
)
		)
		(setq hauteur_texte 5)
		(princ (strcat (vla-get-layer ent) " et " (angtos ang 0 2) " Degré"))
(entmake (list '(0 . "MTEXT")
		'(100 . "AcDbEntity")
		'(100 . "AcDbMText")
		(cons   1 (vla-get-layer ent))
		(cons   7 (getvar "TEXTSTYLE"))
		(cons   8 (vla-get-layer ent))
		(cons  10 ptm)
		(cons  11 ptm)
		;(cons  40 (getvar "textsize"))
		(cons  40 hauteur_texte)
		(cons  50 ang)
		(cons  71 5)
		(cons  72 5)
		(cons  73 1)
	 )
)
(vla-delete sel)
)
)
)
(vla-endundomark doc)
(princ)
)

lecrabe · le 4 février 2010

Hello le Trio

Resultat des courses (Tests sous MAP 2006)

(gile) : OK avec les MTEXT mais il y a un probleme de PI/2 et de rotation du texte suivant le sens de dessin de la polyligne NON Close (OK avec les polylignes closes)

Patrick_35 : OK avec les TEXT mais il y a un probleme de rotation du texte (il manque +/- 180degres) suivant le sens de dessin de la polyligne NON Close (OK avec les polylignes closes)

Fabcad : la routine ne dessine RIEN

SVP pourriez vous rajouter la question optionnelle du texte a generer

(si bien sur on ne veut pas generer le nom du calque)

Merci d'avance, Le Decapode (Testeur sous MAP 2006)

fabcad · le 4 février 2010

Merci Gile et Patrick_35,

- A part la boucle cela fonctionne avec les modifs de textstyle et les CONS par apostrophes et points pour les paires pointées avec des chaines de caractères et une hauteur définie si le style de texte à une hauteur de zéro,

- Il est vrai comme dit Lecrabe (Sigiste de Première Classe) que l'on pourrait demander à l'utilisateur un paramètre d'écriture (calque, xdatas et données d'objets.

- Avec la fonction de Gile j'ai remplacé (vla-get-Layer pl) par (recup_pub_nom pl) qui récupère la valeur du champ de donnée d'objet PUB_NOM voici la sous routine recup_pub_nom :

(defun recup_pub_nom (objet_en_cours /)
		;;; Recupération du nom de la table de Données d'Objets
		(setq nom_de_la_table (ade_odgettables (vlax-vla-object->ename objet_en_cours)))
		;;; Recupération de la valeur du champ PUB_NOM de la table de Données d'Objets
		(setq index_pub_nom (vl-string-left-trim " " (ade_odgetfield (vlax-vla-object->ename objet_en_cours) nom_de_la_table "PUB_NOM" 0)))
		;;; Vérification si le champ est vide alors mettre "Pas de valeur"
		(if (/= index_pub_nom "") (setq index_pub_nom index_pub_nom) (setq index_pub_nom "Pas de valeur"))
index_pub_nom
)

A améliorer,

Merci

Fabrice

[Edité le 4/2/2010 par fabcad]

Patrick_35 · le 4 février 2010

Fabcad, j'avais corrigé mon code pour l'erreur avec la variable d'environnement et celle de la boucle

Lecrabe, j'ai modifié le lisp (message 10) pour ne plus tenir compte du sens de la poly et avoir un texte entre 0 et 180°

@+

lecrabe · le 4 février 2010

Hello P35

Super merci beaucoup, cela marche bien ! :)

et SVP puis je te redemander la petite modif "du Crabe" :

Texte a generer (Defaut = Nom du calque) :

Si Return/Entree directement on met toujours le nom du calque ...

Merci d'avance, Le Decapode

Patrick_35 · le 4 février 2010

C'est fait LeCrabe (message 10)

@+

lecrabe · le 4 février 2010

Hello

Merci beaucoup ca marche parfaitement ! :)

Maintenant je vais pouvoir etiqueter joliment mes polylignes,

soit avec le nom du calque,

soit avec un texte saisi librement ! :D

Le Decapode (qui serre "delicatement" la Pince de P35)

Patrick_35 · le 4 février 2010

C'est un plaisir LeCrabe.

Patrick_35 qui prend la pince "délicatement" entre deux doigts pour la serrer tout en rangeant discrètement la mayo.

@+

lecrabe · le 4 février 2010

Hello

OK tu as range la mayo MAIS tu as laisse sur la table :

le pain, le beurre, le muscadet, le casse noix, etc

DONC je vais etre tres prudent !

Merci & Bonne soiree, Le Decapode

fabcad · le 5 février 2010

Bonjour en ce matin ensoleillé à Rennes.

Merci a vous deux,

Un grand bravo pour la réactivité, le calque était la clé entre AutoCAD et les données d'Objets d'AutoCAD MAP.

Quand aux paramètres demandés par le décapode, je pense qu'il serait plus judicieux via une case de dialogue avoir le choix entre :

- des propriétés AutoCadiennes (peut etre de passer par les champs AutoCAD)

- une sélection en pointant sur un textuel (texte, mtexte, attributs).

- les xdatas et les données d'objets.

Cela servirait a beaucoup de personnes dans la VRD, le SIG, le SIB.

Merci

NB si vous venez sur Saint Malo, les fruits de mer sont excellents.

Pas de probleme pour vous préparer un plateau de dégustation.

bonuscad · le 5 février 2010

Bonjour,

Un code (pour une autre demande) que j'ai adapté rapidement.

Il crée des champs dynamiques au lieu de MText simple.

(vl-load-com)
(defun c:Label_Side ( / js n htx AcDoc Space nw_style obj ename pr pt deriv rtx  nw_obj)
 (princ "\nSélectionnez une polyligne.")
 (setq
   js
   (ssget
     '((-4 . "        (-4 . "          (0 . "POLYLINE")
         (-4 . "            (-4 . "&") (70 . 124)
         (-4 . "NOT>")
       (-4 . "AND>")
       (0 . "LWPOLYLINE,ARC")
       (-4 . "OR>"))
   )
   n -1
 )
 (cond
   (js
     (initget 6)
     (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
     (if htx (setvar "TEXTSIZE" htx))
     (setq
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (cond
       ((null (tblsearch "STYLE" "Romand-Label"))
         (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
         (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)
         )
       )
     )
     (repeat (sslength js)
       (setq
         obj (ssname js (setq n (1+ n)))
         ename (vlax-ename->vla-object obj)
         pr (* (vlax-curve-getEndParam ename) 0.5)
       )
       (if (eq (vla-get-closed ename) :vlax-true)
         (progn
           (vlax-invoke Space 'addRegion (list ename))
           (setq pt (append (vlax-get (vlax-ename->vla-object (entlast)) 'Centroid) '(0.0)) rtx (angle '(0 0 0) (getvar "UCSXDIR")))
           (entdel (entlast))
         )
         (setq
           pt (vlax-curve-GetpointAtParam ename pr)
           deriv (vlax-curve-getFirstDeriv ename pr)
           rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
         )
       )
       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
       (setq nw_obj
         (vla-addMtext Space
           (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
           0.0
             (strcat
               "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
               (itoa (vla-get-ObjectID ename))
               ">%).Layer>%"
             )
         )
       )
       (mapcar
         '(lambda (pr val)
           (vlax-put nw_obj pr val)
         )
         (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
         (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" (vla-get-Layer ename) rtx)
       )
     )
   )
 )
 (prin1)
)

lecrabe · le 5 février 2010

Hello Mr Bonuscad (et Gilles et Patrick_35)

Magnifique cela marche nickel-chrome avec MAP 2006 !

Je me posais une ou deux question(s) mais je crois que cela n'est pas possible !?

1) Si par exemple le nom du calque est du genre : POSPLU__UA, POSPLU__UA1, POSPLU__UB, POSPLU__NA, POSPLU__AU1, POSPLU__AU2, POSPLU__1AUac, POSPLU__2AUab, etc

ne pourrait-on pas etiqueter / labeliser avec seulement ce qui est a droite des caracteres "__"

SVP si ce n'est pas possible avec les champs dynamiques (ce que j'imagine),

en texte avec une routine Lisp/VLisp ...

Avec MAP/CIVIL, on peut bidouiller "plus ou moins bien" (surtout moins bien que les routines presentees dans ce sujet) mais avec un simple AutoCAD (ou A D T) tout seul !

2) Idem si on rouve une application XDATA registree (avec un nom PRECIS) et une chaine du meme type ...

ne pourrait-on pas etiqueter / labeliser avec seulement ce qui est a droite des caracteres "__"

Encore merci aux Lucky Luke de la programmation !

Bon WE, Le Decapode

bonuscad · le 5 février 2010

Salut,

Alors le même code avec suppression par la gauche jusqu'au "underscore"

Plus de champs :(

(vl-load-com)
(defun c:Label_Side ( / js n htx AcDoc Space nw_style obj ename pr pt deriv rtx lay_name nw_obj)
 (princ "\nSélectionnez une polyligne.")
 (setq
   js
   (ssget
     '((-4 . "        (-4 . "          (0 . "POLYLINE")
         (-4 . "            (-4 . "&") (70 . 124)
         (-4 . "NOT>")
       (-4 . "AND>")
       (0 . "LWPOLYLINE,ARC")
       (-4 . "OR>"))
   )
   n -1
 )
 (cond
   (js
     (initget 6)
     (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
     (if htx (setvar "TEXTSIZE" htx))
     (setq
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (cond
       ((null (tblsearch "STYLE" "Romand-Label"))
         (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
         (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)
         )
       )
     )
     (repeat (sslength js)
       (setq
         obj (ssname js (setq n (1+ n)))
         ename (vlax-ename->vla-object obj)
         pr (* (vlax-curve-getEndParam ename) 0.5)
       )
       (if (eq (vla-get-closed ename) :vlax-true)
         (progn
           (vlax-invoke Space 'addRegion (list ename))
           (setq pt (append (vlax-get (vlax-ename->vla-object (entlast)) 'Centroid) '(0.0)) rtx (angle '(0 0 0) (getvar "UCSXDIR")))
           (entdel (entlast))
         )
         (setq
           pt (vlax-curve-GetpointAtParam ename pr)
           deriv (vlax-curve-getFirstDeriv ename pr)
           rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
         )
       )
       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
       (setq lay_name (vla-get-Layer ename))
       (if (wcmatch lay_name "*_*") (setq lay_name (substr lay_name (+ 2 (vl-string-position 95 lay_name 0 T)))))
       (setq nw_obj
         (vla-addMtext Space
           (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
           0.0
           lay_name
         )
       )
       (mapcar
         '(lambda (pr val)
           (vlax-put nw_obj pr val)
         )
         (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
         (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" (vla-get-Layer ename) rtx)
       )
     )
   )
 )
 (prin1)
)

Ecriture de propriété sur lwpolylignes

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