Aller au contenu
Problème de lien d'inscription (résolu ?) ×

creation tableau d\'après polyligne

onossa

Par onossa
dans Routines LISP

 Partager

Messages recommandés

philous2 Newbie

philous2

Posté(e)
Posté(e)

Slt Bruno,

J'ai effectivement testé lamacro sur ma version perso 2009 et cela fonctionne j'ai les écriture nickel par contre j'ai voului sectionner plusieurs pollylignes pas moyens il ne prend qu'une seule est-ce normal !

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

j'ai voului sectionner plusieurs pollylignes pas moyens il ne prend qu'une seule est-ce normal !

 

Oui, un seul tableau par polyligne sélectionnée de façon unique.

Je pense pas que rendre cette fonction multiple soit nécessaire.

Trop d'informations dans un dessin peut tuer l'information et devenir indigeste... (ce n'est que mon avis)

Donc répéter la commande pour avoir quelques tableaux me semble plus sage, on ne choisi que les polylignes essentielles.

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

  • 1 mois après...
onossa Newbie

onossa

Posté(e)
  • Auteur
Posté(e)

Et me revoilà, avec un peu de temps pour me penché son ce lisp, qui génère un tableau (un vrai) d'après les points de controle d'une polyligne.

J'ai repris le lisp excellent de Bonuscad, et essayé de le mettre conforme à mes besoins:

- Ajout d'une colonne pour les longueurs cumulées,

- style de texte prédéfini (tahoma)

- Layer 0 pour le tableau

- Hauteur de texte, lignes et colonnes de tableau prédéfinies (je souhaite une mise en forme figée)

Le seul point qui coince, et que je n'arrive pas à résoudre, est que j'aimerai avoir des précisions différentes en fonction de la colonne concernée:

la colonne GAP doit avoir une décimale de précision, et HEADING deux décimales. les autres colonnes à 0 décimales. Or, comme je m'appui sur les précisions courantes...

J'ai essayé de mettre en place ces précisions dans la ligne de mapcar 'rtos, mais je dois me planter quelque part...

Si vous avez la solution.... Merci encore Bonuscad pour ton lisp.

(vl-load-com)
(defun c:track ( / js obj ename AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_rad all_path j end_pos id_path fonts_path file_shx
nw_style dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha oldim oldlay h_t w_c ename_cell n_row n_column)
(princ "\nSélectionner une polyligne.")
(while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
(princ "\nSélection vide, ou n''est pas une polyligne valable! lancez CONVERT > Polyline...")
)
(setq
obj (ssname js 0)
ename (vlax-ename->vla-object obj)
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
pr -1
nb 0
lst_id-seg '()
lst_pt '()
lst_cpl '(0.0)
lst_length '(0.0)
lst_alpha '(0.0)
lst_rad '(0.0)
)
(cond
((null (tblsearch "LAYER" "0"))
(vla-add (vla-get-layers AcDoc) "0")
)
)
(cond
((null (tblsearch "STYLE" "Tahoma_Table"))
;(setq all_path (getenv "ACAD") j 0)
;(while (setq end_pos (vl-string-position (ascii ";") all_path))
;(setq id_path (substr all_path 1 end_pos))
;(if (wcmatch (strcase id_path) "*FONTS*")
;(setq fonts_path (strcat id_path "\\"))
;)
;(setq all_path (substr all_path (+ 2 end_pos)))
;)
;(setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8))
(if (not file_shx)
(setq file_shx "Tahoma")
)
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Tahoma_Table"))
(mapcar
'(lambda (pr )
(vlax-put nw_style pr )
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
;(command "_.ddunits"
;(while (not (zerop (getvar "cmdactive")))
;(command pause)
)
)
(setq cpl (atof "0"))
(repeat (fix (vlax-curve-getEndParam ename))
(setq
dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
pt_start (vlax-curve-GetPointAtParam ename pr)
pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
seg_len (- dist_end dist_start)
cpl (+ cpl seg_len)
seg_bulge (vla-GetBulge ename pr)
rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
lst_id-seg (cons nb lst_id-seg)
lst_pt (cons pt_start lst_pt)
lst_length (cons seg_len lst_length)
lst_cpl (cons cpl lst_cpl)
lst_rad (cons (abs rad) lst_rad)
lst_alpha (cons alpha lst_alpha)
nb (1+ nb)
)
;(princ lst_cpl)
;(princ lst_length)
)
(setq
lst_id-seg (cons nb lst_id-seg)
lst_pt (cons pt_end lst_pt)
oldim (getvar "dimzin")
oldlay (getvar "clayer")
)
(setvar "dimzin" 0) (setvar "clayer" "0")
(initget 9)
(setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))
(initget 6)
;(setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
(setq h_t (atof "35"))
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(initget 7)
;(setq w_c (getdist ins_pt_cell "\nLargeur des cellules: "))
(setq w_c (atof "280"))
(vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 nb) 7 (+ h_t (* h_t 0.75)) w_c)
(setq ename_cell (vlax-ename->vla-object (entlast)) n_row (+ 2 nb) n_column -1)
(vla-SetCellValue ename_cell 0 0
(vlax-make-variant
(strcat
;" Objet: " (cdr (assoc 0 (entget obj)))
(cdr (assoc 8 (entget obj)))
;" Longueur totale = " (rtos (vlax-get ename 'Length))
)
8
)
)
(vla-SetCellTextStyle ename_cell 0 0 "Tahoma_Table")
(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
(foreach n
(mapcar'list
(append (mapcar 'itoa lst_id-seg) '("POINT"))
[b] ;;; Je pensais mettre ici la précision de la conversion réel / string
;;; (append (mapcar 'rtos lst_cpl 2 0) '("CPL"))
(append (mapcar 'rtos lst_cpl) '("CPL"))[/b]
(append (mapcar 'rtos (mapcar 'car lst_pt)) '("EASTING"))
(append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("NORTHING"))
(append (mapcar 'rtos lst_length) '("GAP"))
(append (mapcar 'angtos lst_alpha) '("HEADING"))
(append (mapcar 'rtos lst_rad) '("RADIUS"))
)
(mapcar
'(lambda (el)
(vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column))
(if (or (eq (rtos 0.0) el) (eq (angtos 0.0) el)) (vlax-make-variant "-" 8) (vlax-make-variant el 8))
;(if (eq (rtos 0.0) el) (vlax-make-variant "-" 8) (vlax-make-variant el 8))
)
(vla-SetCellTextStyle ename_cell n_row n_column "Tahoma_Table")
(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
)
n
)
(setq n_row (1- n_row) n_column -1)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(prin1)
)

 

L'expérience est une lanterne qui n'éclaire que celui qui la porte... (Confucius)

onossa Newbie

onossa

Posté(e)
  • Auteur
Posté(e)

J'ai réussi à trouver: une pettie fonction qui défini la précision avant chaque mappage.

Le HIC qui reste: dans la colonne des RADIUS (dernière colonne), je souhaitais que les valeurs "0" soient remplacées par un tiret "-" . Le hic c'est que les autres colonnes sont succeptibles d'avoir le meme type de valeur "0", et que je souahiterai là les conserver...

Comment ne balayer que la dernière colonne pour tester et remplacer les "0" gênants par des "-"

Merci pour votre aide...

 

 (vl-load-com)
(defun c:track ( / js obj ename AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_rad all_path j end_pos id_path fonts_path file_shx
nw_style dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha oldim oldlay h_t w_c ename_cell n_row n_column)
(princ "\nSélectionner une polyligne.")
(while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
(princ "\nSélection vide, ou n''est pas une polyligne valable! lancez CONVERT > Polyline...")
)
(setq
obj (ssname js 0)
ename (vlax-ename->vla-object obj)
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
pr -1
nb 0
lst_id-seg '()
lst_pt '()
lst_cpl '(0.0)
lst_length '(0.0)
lst_alpha '(0.0)
lst_rad '(0.0)
)
(cond
((null (tblsearch "LAYER" "0"))
(vla-add (vla-get-layers AcDoc) "0")
)
)
(cond
((null (tblsearch "STYLE" "Tahoma_Table"))
;(setq all_path (getenv "ACAD") j 0)
;(while (setq end_pos (vl-string-position (ascii ";") all_path))
;(setq id_path (substr all_path 1 end_pos))
;(if (wcmatch (strcase id_path) "*FONTS*")
;(setq fonts_path (strcat id_path "\\"))
;)
;(setq all_path (substr all_path (+ 2 end_pos)))
;)
;(setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8))
(if (not file_shx)
(setq file_shx "Tahoma")
)
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Tahoma_Table"))
(mapcar
'(lambda (pr )
(vlax-put nw_style pr )
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
;(command "_.ddunits"
;(while (not (zerop (getvar "cmdactive")))
;(command pause)
)
)
(setq cpl (atof "0"))
(repeat (fix (vlax-curve-getEndParam ename))
(setq
dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
pt_start (vlax-curve-GetPointAtParam ename pr)
pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
seg_len (- dist_end dist_start)
cpl (+ cpl seg_len)
seg_bulge (vla-GetBulge ename pr)
rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
lst_id-seg (cons nb lst_id-seg)
lst_pt (cons pt_start lst_pt)
lst_length (cons seg_len lst_length)
lst_cpl (cons cpl lst_cpl)
lst_rad (cons (abs rad) lst_rad)
lst_alpha (cons alpha lst_alpha)
nb (1+ nb)
)
;(princ lst_cpl)
;(princ lst_length)
)
(setq
lst_id-seg (cons nb lst_id-seg)
lst_pt (cons pt_end lst_pt)
oldim (getvar "dimzin")
oldlay (getvar "clayer")
)
(setvar "dimzin" 0) (setvar "clayer" "0")
(initget 9)
(setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))
(initget 6)
;(setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
(setq h_t (atof "35"))
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(initget 7)
;(setq w_c (getdist ins_pt_cell "\nLargeur des cellules: "))
(setq w_c (atof "280"))
(vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 nb) 7 (+ h_t (* h_t 0.75)) w_c)
(setq ename_cell (vlax-ename->vla-object (entlast)) n_row (+ 2 nb) n_column -1)
(vla-SetCellValue ename_cell 0 0
(vlax-make-variant
(strcat
;" Objet: " (cdr (assoc 0 (entget obj)))
(cdr (assoc 8 (entget obj)))
;" Longueur totale = " (rtos (vlax-get ename 'Length))
)
8
)
)
(defun rtos0 (n0)(rtos n0 2 0))
(defun rtos1 (n1)(rtos n1 2 1))
(defun angtos2 (n2)(angtos n2 0 2))

(vla-SetCellTextStyle ename_cell 0 0 "Tahoma_Table")
(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
(foreach n
(mapcar'list
(append (mapcar 'itoa lst_id-seg) '("POINT"))
(append (mapcar 'rtos0 lst_cpl) '("CPL"))
(append (mapcar 'rtos0 (mapcar 'car lst_pt)) '("EASTING"))
(append (mapcar 'rtos0 (mapcar 'cadr lst_pt)) '("NORTHING"))
(append (mapcar 'rtos1 lst_length) '("GAP"))
(append (mapcar 'angtos2 lst_alpha) '("HEADING"))
(append (mapcar 'rtos0 lst_rad) '("RADIUS"))
)
(mapcar
'(lambda (el)
(vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column))
;(if (or (eq (rtos0 0.0) el) (eq (angtos2 0.0) el)) (vlax-make-variant "-" 8) (vlax-make-variant el 8))
(if (eq (angtos2 0.0) el) (vlax-make-variant "-" 8) (vlax-make-variant el 8))
)
(vla-SetCellTextStyle ename_cell n_row n_column "Tahoma_Table")
(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
)
n
)
(setq n_row (1- n_row) n_column -1)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(prin1)
)

 

 

L'expérience est une lanterne qui n'éclaire que celui qui la porte... (Confucius)

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Une correction rapide avec suppression de lignes inutiles.

Avec ton souhait, il est plus simple d'agir sur la liste des rayons, une erreur sur l'établissement du style créait une erreur.

 

(vl-load-com)
(defun c:track (/	   js	      obj	 ename	    AcDoc
	Space	   pr	      nb	 lst_id-seg lst_pt
	lst_length lst_alpha  lst_rad	 all_path   j
	end_pos	   id_path    fonts_path file_shx   nw_style
	dist_start dist_end   pt_start	 pt_end	    seg_len
	seg_bulge  rad	      alpha	 oldim	    oldlay
	h_t	   w_c	      ename_cell n_row	    n_column 
       )
 (princ "\nSélectionner une polyligne.")
 (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
   (princ
     "\nSélection vide, ou n''est pas une polyligne valable! lancez CONVERT > Polyline..."
   )
 )
 (setq
   obj	       (ssname js 0)
   ename      (vlax-ename->vla-object obj)
   AcDoc      (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
       (if (= 1 (getvar "CVPORT"))
	 (vla-get-PaperSpace AcDoc)
	 (vla-get-ModelSpace AcDoc)
       )
   pr	       -1
   nb	       0
   lst_id-seg '()
   lst_pt     '()
   lst_cpl    '(0.0)
   lst_length '(0.0)
   lst_alpha  '(0.0)
   lst_rad    '("-")
 )
 (cond
   ((null (tblsearch "STYLE" "Tahoma_Table"))
    (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Tahoma_Table"))
    (mapcar
      '(lambda	(pr val)
  (vlax-put nw_style pr val)
)
      (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
      (list "C:\\WINDOWS\\Fonts\\TAHOMA.TTF" 0.0 0.0 1.0 0.0)
    )
  )
 )
 (setq cpl (atof "0"))
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
     dist_end	 (vlax-curve-GetDistAtParam ename (1+ pr))
     pt_start	 (vlax-curve-GetPointAtParam ename pr)
     pt_end	 (vlax-curve-GetPointAtParam ename (1+ pr))
     seg_len	 (- dist_end dist_start)
     cpl	 (+ cpl seg_len)
     seg_bulge	 (vla-GetBulge ename pr)
     rad	 (if (zerop seg_bulge)
   0.0
   (/ seg_len (* 4.0 (atan seg_bulge)))
 )
     alpha	 (if (zerop seg_bulge)
	   (angle pt_start pt_end)
	   0.0
	 )
     lst_id-seg (cons nb lst_id-seg)
     lst_pt	 (cons pt_start lst_pt)
     lst_length (cons seg_len lst_length)
     lst_cpl	 (cons cpl lst_cpl)
     lst_rad	 (cons (if (not (zerop (abs rad))) (rtos (abs rad) 2 0) "-") lst_rad)
     lst_alpha	 (cons alpha lst_alpha)
     nb	 (1+ nb)
   )
 )
 (setq
   lst_id-seg (cons nb lst_id-seg)
   lst_pt     (cons pt_end lst_pt)
   oldim      (getvar "dimzin")
   oldlay     (getvar "clayer")
 )
 (setvar "dimzin" 0)
(setvar "clayer" "0")
 (initget 9)
 (setq	ins_pt_cell
 (getpoint "\nPoint d'insertion haut gauche du tableau: "
 )
 )
 (setq h_t (atof "35"))
 (setvar "textsize" h_t)
 (setq w_c (atof "280"))
 (vla-addTable
   Space
   (vlax-3d-point ins_pt_cell)
   (+ 3 nb)
   7
   (+ h_t (* h_t 0.75))
   w_c
 )
 (setq	ename_cell
 (vlax-ename->vla-object (entlast))
n_row (+ 2 nb)
n_column -1
 )
 (vla-SetCellValue
   ename_cell
   0
   0
   (vlax-make-variant
(cdr (assoc 8 (entget obj)))
     8
   )
 )
 (defun rtos0 (n0) (rtos n0 2 0))
 (defun rtos1 (n1) (rtos n1 2 1))
 (defun angtos2 (n2) (angtos n2 0 2))
 (vla-SetCellTextStyle ename_cell 0 0 "Tahoma_Table")
 (vla-SetCellTextHeight
   ename_cell
   0
   0
   (vlax-make-variant h_t 5)
 )
 (foreach n
   (mapcar
     'list
     (append (mapcar 'itoa lst_id-seg) '("POINT"))
     (append (mapcar 'rtos0 lst_cpl) '("CPL"))
     (append (mapcar 'rtos0 (mapcar 'car lst_pt)) '("EASTING"))
     (append (mapcar 'rtos0 (mapcar 'cadr lst_pt))
	     '("NORTHING")
     )
     (append (mapcar 'rtos1 lst_length) '("GAP"))
     (append (mapcar 'angtos2 lst_alpha) '("HEADING"))
     (append lst_rad '("RADIUS"))
   )
   (mapcar
     '(lambda (el)
 (vla-SetCellValue
   ename_cell
   n_row
   (setq n_column (1+ n_column))
				(vlax-make-variant el 8)
 )
 (vla-SetCellTextStyle
   ename_cell
   n_row
   n_column
   "Tahoma_Table"
 )
 (vla-SetCellTextHeight
   ename_cell
   n_row
   n_column
   (vlax-make-variant h_t 5)
 )
      )
     n
   )
   (setq n_row	   (1- n_row)
  n_column -1
   )
 )
 (setvar "dimzin" oldim)
 (setvar "clayer" oldlay)
 (prin1)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

onossa Newbie

onossa

Posté(e)
  • Auteur
Posté(e)

merci une fois de plus bonuscad !

- a quel niveau pourrais-je mettre en place une condition qui testerai par exemple un valeur non nulle de radius afin de nommer de façon particulière le POINT de laligne concernée ? (il s'agirai d'avoir des point de tangeance en entrée et sortie d'arc de polyligne qui s'appelerai TP1 puis TP2, et pour l'arc suivan TP4 et TP5 ?

 

- est il possible de récupérer le centre de chaque arc de la pline,, afin d'encréer des lignes supplémentairs avec les coordonnées desdits centres ?

Merci encore pour ton aide !

 

 

[Edité le 25/3/2009 par onossa]

L'expérience est une lanterne qui n'éclaire que celui qui la porte... (Confucius)

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité