creation tableau d\'après polyligne

[onossa]

Bonjour, j'ai un problème qui me bloque ! C'est le récent constat de deux bugs: j'utilise un lisp qui génère un tableau sur Autocad, d'après les points constituants une polyligne sélectionnée.

Le hic:

- impossible d'avoir un segment arc en début de polyligne

- imopssible d'avoir une succession de 2 segments arc: le second est considéré comme segment ligne...

 

Je suis bloqué, j'ai pensé à la courbure code 42, mais j'arrive pas bien à trouver où ça coince...

Si quelqu'un peu m'aider... MErci d'avance !

 

Le code lisp que l'utilise( désolé c un peu long...):

 

 ; It makes a table with Route details from a picked POLYLINE (ROUTE). 
 ; The polyline should by the original one, the one before converted
 ; by QUICKSURF. The program calculates centerpoints, radius,
 ; tangent points,intersection points, bearings and the length along
 ; the polyline.
 ; The program ask you to pick a polyline. After calculation the program
 ; ask for the insertion point for the table, an scalefactor for the
 ; coordinates,an offset value for the coordinates.After the tabel is 
 ; drawn you vil be asked for a scale factor and rotations angel for
 ; the hole tabel.
 ; To load the program write at "command:" (load "rutetbl"), 
 ; and start the program with command "TABEL".
 ; The program consider that the coordinate system has 0 degr. at 
 ; 90 degr. in the WCS of AutoCAD, and the angeles are clockwise.
 ;
 ; God Luck !!


(Defun RTD (Vin) (* 180.0 (/ vin pi))) ; Radian to Degees
(Defun DTR (vin) (* pi (/ vin 180.0))) ; Degees to Radian


(Defun Closedown ();restaure l'etat
 (setvar "OSMODE" oldosmode)
 (setvar "plinetype" oldplinetype)
 (setvar "PLINEWID" oldpwid)
 (setvar "DIMZIN" olddimzin)
 (setvar "cmdecho" ocmd)
 (setvar "ANGBASE" angb)
 (setvar "ANGDIR" angd)
 (setvar "HIGHLIGHT" high)
 (setq *error* olderror)
 (princ)
) ;_ Fin de Defun


(defun Myerror (s)
 (if (/= s "Fonction annulée!")
   (princ (strcat "\nErreur: " s))
 ) ;_ Fin de if
 (closedown)
) ;_ Fin de defun



;function d'initialisation de variable et test sur calque
(Defun Starttbl	()
 (setq olderror *error*)
 (setq *error* myerror)
 (setq oldosmode (getvar "OSMODE"))
 (setq oldplinetype (getvar "PLINETYPE"))
 (setq oldpwid (getvar "PLINEWID"))
 (setq olddimzin (getvar "DIMZIN"))
 (setq angB (Getvar "Angbase"))
 (setq AngD (Getvar "AngDir"))
 (setq high (Getvar "Highlight"))
 (setq ocmd (GetVar "CMDECHO"))
 (if (= (tblsearch "LAYER" "TEXTE") nil)
   (COMMAND "_LAYER" "New" "TEXTE" "ON" "TEXTE" "");si existe pas on crée "Nouv" et le rends actif "AC" (pour "ACtif")
   (Command "_LAYER" "ON" "TEXTE" "");si existe on le rend actif
 ) ;_ Fin de if
 ;init de quelques variables
 (setvar "OSMODE" 0)
 (setvar "plinetype" 0)
 (setvar "PLINEWID" 0)
 (setvar "DIMZIN" 0)
 (SetVar "ANGBASE" 0)
 (SetVar "ANGDIR" 0)
 (SetVAR "HIGHLIGHT" 0)
) ;_ Fin de Defun




(Defun ArcSeg ()
 ; distance & Angle between two vertices
 (setq dvv (distance (cdr (assoc 10 v1)) (cdr (assoc 10 el))))
 (setq avv (angle (cdr (assoc 10 v1)) (cdr (assoc 10 el))))

 ; Included angle as calculated by bulge factor
 (setq ang (* (atan (cdr (assoc 42 v1))) 4))

 ; Calculate angle opposite included angle.
 (if (< (abs ang) pi)
   (setq ang2 (/ (- pi (abs ang)) 2)) ;<180
   (setq ang2 (/ (- pi (- (* 2 pi) (abs ang))) 2)) ;>180
 ) ;_ Fin de if

 ; Calculate radius of arc
 (setq r (/ (* (sin ang2) dvv) (abs (sin ang))))

 ; Angle From V1 to Centre
 (if (> ang 0)
 ; Condition for ccw arc
   (if	(< ang pi)
     (setq aca (+ avv ang2)) ;arc < 180
     (setq aca (- avv ang2)) ;arc > 180
   ) ;_ Fin de if
 ; Condition for cw arc
   (if	(< (abs ang) pi)
     (setq aca (- avv ang2)) ;arc < 180
     (setq aca (+ avv ang2)) ;arc < 180
   ) ;_ Fin de if
 ) ;_ Fin de if
 ; Calculate centre of arc
 (setq vcen (polar (cdr (assoc 10 v1)) aca r))
) ;_ Fin de Defun

;*************************************************************************************************************************
;fonction principale
(DEFUN C:table_tracks ()
 (starttbl);appel de la function starttlb
 (setq PKtListe nil)
 (setq	TPteller 0
IPTeller 1
 ) ;_ Fin de setq
 (alert "ENTREZ L'INTITULE DE LA COLONNE DE LA DISTANCE RELATIVE : 'K.P.' (Kilometric Point) ou 'C.P.L.' (Cumulative Projected Length) : ")
 (setq kpoucpl (getstring "ENTREZ L'INTITULE DE LA COLONNE DE LA DISTANCE RELATIVE : 'K.P.' (Kilometric Point) ou 'C.P.L.' (Cumulative Projected Length) : "))
 (Setq elem (car (EntSel "\nSelectionner une polyligne : ")))
 (command "CONVERTpoly" "H" elem "" "_redraw")
 (while (not (AND (/= elem nil)
	   (OR (= (cdr (Assoc 0 (entget elem))) "POLYLINE")
	       ;(= (cdr (Assoc 0 (entget elem))) "LWPOLYLINE")
	   ) ;_ Fin de OR
      ) ;_ Fin de OR
 ) ;_ Fin de not
   (Setq elem (car (EntSel "\nSelectionner une polyligne : ")))
 ) ;_ Fin de while
 (progn
   (setq el (entget elem))
   (setq elem (entnext elem))
   (setq el (entget elem))
   (setq v0 el
  v1 el
   ) ;_ Fin de setq

   (while (not	(AND (/= elem nil)(= (cdr (Assoc 0 (entget elem))) "SEQEND")
;;;		     (OR (= (cdr (Assoc 0 (entget elem))) "POLYLINE")
;;;			 (= (cdr (Assoc 0 (entget elem))) "LWPOLYLINE")
;;;		     ) ;_ Fin de OR
	) ;_ Fin de OR
   ) ;_ Fin de not
     (If (/= (cdr (Assoc 42 el)) 0.0) ; teste si on est sur un arc ou une ligne  clé 42 rayon de courbure du segment 0 -> segment droit
(progn;segment courbe
  (Setq v1 el)
  (setq elem (Entnext Elem))
  (setq el (Entget elem))
  (ArcSeg)
  (setq pkten (cdr (assoc 10 v1)))

  (if (= TPteller 0)
    (setq TPnr "START UP")
    (setq TPnr (Strcat "TP" (itoa TPteller)))
  ) ;_ Fin de if
  (if (/= (Distance (cdr (Assoc 10 v1))
		    (cdr (assoc 10 el))
	  ) ;_ Fin de Distance
	  0.0
      ) ;_ Fin de /=
    (setq Dpkt (Distance (cdr (Assoc 10 v0))
			 (cdr (assoc 10 v1))
	       ) ;_ Fin de Distance
    ) ;_ Fin de setq
    (if	(= TPteller 0)
      (setq Dpkt 0.000)
      (setq Dpkt nil)
    ) ;_ Fin de if
  ) ;_ Fin de if


  (setq	NyLinje
	 (List TPnr (Car pkten) (cadr pkten) Dpkt nil nil)
  ) ;_ Fin de setq
  (if (= PktListe nil)
    (setq PktListe (list NyLinje nil))
    (setq PktListe (cons NyLinje pktListe))
  ) ;_ Fin de if
  (setq el2 (polar (cdr (assoc 10 v1)) avv (/ dvv 2)))
  (setq	IP (inters (cdr (assoc 10 v0))
		   (cdr (assoc 10 v1))
		   vcen
		   el2
		   nil
	   ) ;_ Fin de inters
  ) ;_ Fin de setq
  (setq Tpnr (Strcat "IP" (ITOA IPteller)))
  (setq	NyLinje	(List TPnr
		      (Car IP) ; IP + angel
		      (Cadr IP)
		      nil
		      (Rtd (angle (cdr (assoc 10 v0))
				  (cdr (assoc 10 v1))
			   ) ;_ Fin de angle
		      ) ;_ Fin de Rtd
		      nil
		) ;_ Fin de List
  ) ;_ Fin de setq
  (setq PktListe (cons NyLinje pktListe))
  (setq Tpnr (Strcat "CP" (ITOA IPteller)))
  (setq	NyLinje	(List Tpnr
		      (Car vcen) ;CP+R
		      (Cadr vcen)
		      nil
		      nil
		      r
		) ;_ Fin de List
  ) ;_ Fin de setq
  (setq PktListe (cons NyLinje pktListe))
  (setq pkten (cdr (assoc 10 el)))
  (setq TPteller (+ TPteller 1))
  (setq TPnr (StrCat "TP" (itoa TPteller)))
  (setq	NyLinje	(List TPnr
		      (Car pkten) ;TPb
		      (Cadr pkten)
		      (* (ABS Ang) r)
		      nil
		      nil
		) ;_ Fin de List
  ) ;_ Fin de setq
  (setq PktListe (cons NyLinje pktListe))
  (setq	v0 el
	v1 el
  ) ;_ Fin de setq
  (setq elem (Entnext Elem))
  (if (/= elem nil)
    (progn
      (setq el (Entget elem))
      (setq TPteller (+ TPteller 1))
      (setq IPteller (+ IPteller 1))
    ) ;_ Fin de progn
  ) ;_ Fin de if
) ;_ Fin de progn

(progn;segment droit
  (setq pkten (cdr (assoc 10 el)))
  (if (= TPteller 0)
    (setq TPnr "START UP")
    (setq TPnr (Strcat "TP" (itoa TPteller)))
  ) ;_ Fin de if
  (if (/= (Distance (cdr (Assoc 10 v1))
		    (cdr (assoc 10 el))
	  ) ;_ Fin de Distance
	  0.0
      ) ;_ Fin de /=
    (setq Dpkt (Distance (cdr (Assoc 10 v1))
			 (cdr (assoc 10 el))
	       ) ;_ Fin de Distance
    ) ;_ Fin de setq
    (if	(= TPteller 0)
      (setq Dpkt 0.000)
      (setq Dpkt nil)
    ) ;_ Fin de if
  ) ;_ Fin de if


  (setq	NyLinje
	 (List Tpnr (Car pkten) (cadr pkten) Dpkt nil nil)
  ) ;_ Fin de setq
  (if (= PktListe nil)
    (setq PktListe (list NyLinje nil))
    (setq PktListe (cons NyLinje pktListe))
  ) ;_ Fin de if
  (setq	v0 el
	v1 el
  ) ;_ Fin de setq
  (setq elem (Entnext Elem))
  (if (/= elem nil)
    (progn
      (setq el (Entget elem))
      (setq TPteller (+ TPteller 1))
    ) ;_ Fin de progn
  ) ;_ Fin de if
) ;progn
     ) ;if                           
   ) ;while

   (setq nylinje (car pktliste))
   (setq pktliste (cdr pktliste))
   (setq oldlinje (car pktliste))
   (setq v0 (list (cadr oldlinje) (caddr oldlinje)))
   (setq v1 (list (cadr nylinje) (caddr nylinje)))
   (Rtd (Angle v0 v1))
   (setq oldlinje (Cdr nylinje))
   (setq nylinje (List	"LAY DOWN"
		(Car oldlinje)
		(cadr oldlinje)
		(Caddr oldlinje)
		(Rtd (Angle v0 v1))
		nil
	  ) ;_ Fin de List
   ) ;_ Fin de setq
   (setq pktliste (Cons nylinje pktliste))
   (setq pktliste (reverse pktliste))
   (lagTabel)
 ) ;progn

 (closeDown)
) ;_ Fin de DEFUN


(Defun LagFrame	() ;Draws up the main frame of tabel
 (setq pk2 (polar stpkt 0.0 170))
 (setq pk3 (polar pk2 (/ pi 2) (* (+ (* ant 5) 14) -1)))
 (setq pk4 (polar pk3 pi 170))
 (Command "_PLINE" stpkt pk2 pk3 pk4 "C")
 (setq elliste (ssadd (entlast)))

 (Setq pk2 (List (+ (car stpkt) 85) (- (Cadr stpkt) 5.5)))
 (Command "_TEXT" "C" pk2 4.0 (RTD orient) streng)
 (setq elliste (ssadd (entlast) elliste))

 (setq pk2 (List (car stpkt) (- (Cadr stpkt) 7)))
 (setq pk3 (List (+ (Car stpkt) 170) (- (Cadr stpkt) 7)))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))

 (setq pk2 (List (car stpkt) (- (Cadr stpkt) 14)))
 (setq pk3 (List (+ (Car stpkt) 170) (- (Cadr stpkt) 14)))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))

 (Setq y1 (- (Cadr stpkt) 12.5))
 (Setq pk2 (List (+ (Car stpkt) 11) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "POINT")
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 28) y1))

;Added line below user name for KP or CPL column

 (Command "_TEXT" "C" pk2 "3.0" "0" kpoucpl)
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 49) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "EASTING")
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 81) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "NORTHING")
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 109) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "LENGTH")
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 132.5) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "BEARING")
 (setq elliste (ssadd (entlast) elliste))

 (Setq pk2 (List (+ (Car stpkt) 157.5) y1))
 (Command "_TEXT" "C" pk2 "3.0" "0" "RADIUS")
 (setq elliste (ssadd (entlast) elliste))

 (setq y1 (- (Cadr stpkt) 7))
 (setq y2 (- (Cadr stpkt) (+ 14 (* ant 5))))
 (setq pk2 (List (+ (Car stpkt) 22) y1))
 (setq pk3 (List (+ (Car stpkt) 22) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))

 (setq pk2 (List (+ (Car stpkt) 34) y1))
 (setq pk3 (List (+ (Car stpkt) 34) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))

 (setq pk2 (List (+ (Car stpkt) 64) y1))
 (setq pk3 (List (+ (Car stpkt) 64) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))
 (setq pk2 (List (+ (Car stpkt) 98) y1))
 (setq pk3 (List (+ (Car stpkt) 98) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))
 (setq pk2 (List (+ (Car stpkt) 120) y1))
 (setq pk3 (List (+ (Car stpkt) 120) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))
 (setq pk2 (List (+ (Car stpkt) 145) y1))
 (setq pk3 (List (+ (Car stpkt) 145) y2))
 (Command "_LINE" pk2 pk3 "")
 (setq elliste (ssadd (entlast) elliste))
) ;_ Fin de Defun

 ; Converts a string (6123456.123 to 6 123 456.123)

(Defun KoordStr	(nyord / tull delord1 delord2 delord3)
 (setq tull 1)
 (setq delord1 "")
 (if (/= (vl-string-search nyord ".") nil)
   (while (/= (Substr nyord tull 1) ".")
     (setq delord1 (Strcat delord1 (Substr nyord tull 1)))
     (setq tull (+ tull 1))
   ) ;_ Fin de while
 ) ;_ Fin de if
 (setq nyord (Substr nyord tull))
 (setq tull (- tull 1))
 (while (> tull 3)
   (progn
     (setq delord2 (Substr delord1 (- tull 2) tull))
     (setq delord1 (Substr delord1 1 (- tull 3)))
     (setq delord3 (strcat " " delord2 nyord))
     (setq nyord delord3)
     (setq tull (- tull 3))
   ) ;_ Fin de progn
 ) ;_ Fin de while
 (setq delord3 (StrCat delord1 nyord))
 (setq nyord delord3)
) ;_ Fin de Defun




(Defun LagTabel	()
 (setq enLinje (car pktliste))
 (if (= enLinje nil)
   (progn
     (setq Pktliste (Cdr pktliste))
     (setq enLinje (Car pktliste))
     (setq Pktliste (Cdr pktliste))
   ) ;_ Fin de progn
 ) ;_ Fin de if
 (setq ant (+ (Length pktliste) 1))
 (setq elListe nil)
 (initget 1)
 (setq stpkt (Getpoint "\nCoin supérieur gauche de la table : "))
 (setq orient 0.0)
 (setq scala 1)
 (initget 1)
 (Setq streng (GetString "\nNom de la table : "))
 (LagFrame)

 (setq teller 1)
 (setq Tdist 0.000)
 (setq off1 0.000)
 (setq off2 0.000)
 (setq TPscale 1)

 (Print (Strcat "La valeur est " (RTOS (caddr enLinje) 2 3)))
 (Setq	Tpscale
 (Getreal "\nFacteur d'echelle des valeurs <1.0>: ")
 ) ;_ Fin de Setq
 (if (/= (numberp Tpscale) T)
   (setq Tpscale 1.0)
 ) ;_ Fin de if

 (Print (Strcat "La valeur en EST est "
	 (RTOS (* TPscale (cadr enLinje)) 2 2)
 ) ;_ Fin de Strcat
 ) ;_ Fin de Print
 (initget (+ 1 8))
 (Setq off1 (Getreal "\nDécalage sur l'axe des X <0.0>: "))
 (if (= off1 nil)
   (setq off1 0.0)
 ) ;_ Fin de if
 (Print (Strcat "La valeur en NORD est "
	 (RTOS (* TPscale (caddr enLinje)) 2 2)
 ) ;_ Fin de Strcat
 ) ;_ Fin de Print
 (initget (+ 1 8))
 (Setq off2 (Getreal "\nDécalage sur l'axe Y <0.0>: "))
 (if (= off2 nil)
   (setq off2 0.0)
 ) ;_ Fin de if


 ;Fill in tabel
 (While (<= teller ant)
   (setq y1 (- (cadr stpkt) (+ (* teller 5) 14)))
   (setq pk2 (list (Car stpkt) y1))
   (setq pk3 (List (+ (Car stpkt) 170) y1))
   (Command "_LINE" pk2 pk3 "")
   (setq elliste (ssadd (entlast) elliste))
   (setq y1 (- (cadr stpkt) (+ (* teller 5) 12.5)))
   (setq pk2 (list (+ (Car stpkt) 11) y1))

   (setq tpnr (Car enLinje))
   (setq enlinje (Cdr enlinje))

   (setq Epkt (+ (* TPscale (Car Enlinje)) off1))
   (setq enlinje (Cdr enlinje))
   (setq Npkt (+ (* TPscale (Car Enlinje)) off2))
   (setq enlinje (Cdr enlinje))
   (setq Dpkt (Car Enlinje))
   (setq enlinje (Cdr enlinje))
   (setq Bpkt (Car Enlinje))
   (setq enlinje (Cdr enlinje))
   (setq Rpkt (Car Enlinje))
   (setq enlinje (Cdr enlinje))
   (setq enLinje (car pktliste))
   (Setq Pktliste (cdr Pktliste))

   (Command "_TEXT" "C" pk2 "2.5" 0.0 Tpnr)

   (setq elliste (ssadd (entlast) elliste))
   (setq pk2 (list (+ (Car stpkt) 28) y1))
   (if	(/= Dpkt nil)
     (progn
(setq Tdist (+ Tdist (* TPscale Dpkt)))
(setq Streng (RTOS (/ TDist 1000) 2 3))
(Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
(setq elliste (ssadd (entlast) elliste))
     ) ;_ Fin de progn
   ) ;_ Fin de if

   (setq pk2 (list (+ (Car stpkt) 49) y1))
   (setq Streng (RTOS Epkt 2 2))
   (setq streng (KoordStr streng))


   (Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
   (setq elliste (ssadd (entlast) elliste))

   (setq pk2 (list (+ (Car stpkt) 81) y1))
   (setq Streng (RTOS Npkt 2 2))
   (setq Streng (KoordStr streng))

   (Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
   (setq elliste (ssadd (entlast) elliste))

   (setq pk2 (list (+ (Car stpkt) 109) y1))
   (If	(/= Dpkt nil)
     (progn
(setq Dpkt (* Tpscale Dpkt))
(setq Streng (RTOS Dpkt 2 2))
(Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
(setq elliste (ssadd (entlast) elliste))
     ) ;_ Fin de progn
   ) ;_ Fin de If
   (setq pk2 (list (+ (Car stpkt) 132.5) y1))
   (if	(/= Bpkt nil)
     (progn
(setq Bpkt (- 90.000 Bpkt))
(if (< Bpkt 0)
  (setq Bpkt (+ 360 Bpkt))
) ;_ Fin de if
(setq Streng (strcat (RTOS Bpkt 2 2) "%%D"))
(Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
(setq elliste (ssadd (entlast) elliste))
     ) ;_ Fin de progn
   ) ;_ Fin de if
   (setq pk2 (list (+ (Car stpkt) 157.5) y1))
   (if	(/= Rpkt nil)
     (progn
(setq Rpkt (* TPscale Rpkt))
(setq Streng (StrCat (rtos Rpkt 2 0) "m"))
(Command "_TEXT" "C" pk2 "2.5" 0.0 streng)
(setq elliste (ssadd (entlast) elliste))
     ) ;_ Fin de progn
   ) ;_ Fin de if
   (setq teller (+ teller 1))
 ) ;while

 (setq scala (GetReal "\nEchelle <1.0>: "))
 (if (= scala nil)
   (setq scala 1.0)
 ) ;_ Fin de if
 (Command "_SCALE" elliste "" stpkt scala)
 (setq orient (Getangle stpkt "\nAngle de rotation <0.0>: "))
 (if (= orient nil)
   (setq orient 0.0)
 ) ;_ Fin de if
 (Command "_ROTATE" elliste "" stpkt (rtD orient))
) ;_ Fin de Defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[bonuscad]

Le code lisp que l'utilise( désolé c un peu long...):

 

En effet, pas trop envi de le décortiquer.

En conséquence je te propose une équivalence:

(vl-load-com)
(defun c:info_po ( / js obj dxf_10 dxf_42 ename pr nb dist_start dist_end seg_len rad alpha oldim
                    lst_length lst_id-seg lst_rad lst_alpha lst_msg file_name cle f_open key_sep str_sep)
(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!")
)
 (setq
   obj (ssname js 0)
   dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
   dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget obj)))
   ename (vlax-ename->vla-object obj)
   pr -1
   nb 0
   lst_id-seg (list nb)
   lst_length '(0.0)
   lst_alpha '(0.0)
   lst_rad '(0.0)
 )
 (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv" 37))
(if (null file_name) (exit))
(if (findfile file_name)
	(progn
		(prompt "\nFichier éxiste déjà!")
		(initget "Ajoute Remplace annUler _Add Replace Undo")
		(setq cle
			(getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] [b]<[/b]R[b]>[/b]: ")
		)
		(cond
			((eq cle "Add")
				(setq cle "a")
			)
			((or (eq cle "Replace") (eq cle ()))
				(setq cle "w")
			)
			(T (exit))
		)
		(setq f_open (open file_name cle))
	)
	(setq f_open (open file_name "w"))
)
 (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation")
(setq key_sep (getkword "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? [b]<[/b]Point-virgule[b]>[/b]: "))
(cond
   ((eq key_sep "SPpace") (setq str_sep " "))
   ((eq key_sep "Comma") (setq str_sep ","))
   ((eq key_sep "Tabulation") (setq str_sep "\t"))
   (T (setq str_sep ";"))
 )
 (setq lst_msg (list str_sep))
 (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))
     seg_len (- dist_end dist_start)
     rad (if (zerop (nth nb dxf_42)) 0.0 (/ seg_len (* 4.0 (atan (nth nb dxf_42)))))
     alpha (if (zerop (nth nb dxf_42)) (angle (nth nb dxf_10) (nth (1+ nb) dxf_10)) 0.0)
     nb (1+ nb)
     lst_length (cons seg_len lst_length)
     lst_id-seg (cons nb lst_id-seg)
     lst_rad (cons rad lst_rad)
     lst_alpha (cons alpha lst_alpha)
     lst_msg (cons str_sep lst_msg)
   )
 )
 (setq oldim (getvar "dimzin"))
 (setvar "dimzin" 0)
 (write-line (strcat "N°" str_sep "Coordonnées X" str_sep "Coordonnées Y" str_sep "Longueurs" str_sep "Directions" str_sep "Rayons") f_open)
 (foreach n
   (mapcar'strcat
     (reverse (mapcar 'itoa lst_id-seg))
     lst_msg
     (mapcar 'rtos (mapcar 'car dxf_10))
     lst_msg
     (mapcar 'rtos (mapcar 'cadr dxf_10))
     lst_msg
     (reverse (mapcar 'rtos lst_length))
     lst_msg
     (reverse (mapcar 'angtos lst_alpha))
     lst_msg
     (reverse (mapcar 'rtos lst_rad))
   )
   (write-line n f_open)
 )
 (write-line "" f_open)
(close f_open)
 (setvar "dimzin" oldim)
 (prin1)
)

 

Avant utilisation, bien régler tes unités et précision avec la commande DDUNITS

Lancer la routine et sélectionner une "LWPOLYLINE"

Il te sera proposé de créer un fichier CSV (fichier lisible par excel)

Bien choisir ton séparateur de données.

Une fois le fichier ouvert dans Excel tu peux copier ton tableau et le coller dans Autocad.

Pour ceci, dans Autocad passe par le menu "Edition" et "Collage spécial", tu choisis l'option "entité autocad" et tu obtiendra un tableau avec cellule, tout ceci indépendant d'excel

 

[Edité le 15/1/2009 par bonuscad]

[onossa]

Merci beaucoup Bonucad.

Il y a deux choses qui m'embêtent (que je suis pinailleur...). C'est que la routine que j'ai posté avant, est utilisée par plusieurs dessinateurs, et hormis ses 2 limitations, permettait d'avoir un tableau (même si pas un "vrai" tableau), toujours formatté à l'identique, permettant ainsi des présentations homogènes... De plus, la polyligne évoluant souvent, ce genre d'aller-retour AutoCAD Excel n'est pas merveilleux dans mon utilisation quotidienne... Enfin, ce que je prévoyais de faire (avec un peu de temps) était de faire en sorte que cette routine utilise un tableau AutoCAD tels qu'ils sont sur les versions récentes, avec des fields afin de le rendre interactif (dans la mesure où les segments restent au même nombre...).

Donc, tout ça pour dire que si au moins on pouvait me confirmer que le test de condition d'un segment droit ou pas du code 42 est incriminé dans ces deux "bugs", cela m'aiderait beaucoup...

Merci pour votre aide.

 

[bonuscad]

avec des fields afin de le rendre interactif

 

Dans cette réponse , j'ai fais quelque chose (une présentation sommaire en tableau) qui utilise les champs dynamiques.

 

Si cela peut te donner une base de départ pour ta réflexion.

 

Je pense quand même qu'il sera beaucoup plus ardu de faire quelque chose de plus évolué. (obtenir les rayon, interdistances.... qui resteraient liés)

[onossa]

Merci une fois de plus pour ton aide. J'ai testé ton programme, et il fonctionne très bien. Effectivement, avec la céation de points aux sommets, on se permet l'utilisation des champs. Cela répond à une question que je me posais: peut-on aller "taper" dans les segments d'une polyligne avec les champs. La réponse est non, à mon grand regret...

Je changerai donc mon fusil d'épaule en restant sur ma toute première idée: corriger les 2 limitations de mon lisp initial... Ce ne sera pas chose aisée, étant donné que j'utilise des lisps quotidiennement, mais les nouvelles choses à faire et donc raisons de développer de nouvelles choses, sont rares et me laissent à un niveau bien modeste...

Tout ça pour crier à l'aide !

 

Toute aide sera la bienvenue...

MErci encore bonuscad !

[onossa]

Je reviens donc sur mon post initial.

Je suis toujours aussi bloqué, avec une avancée:

Une connaissance (thanks Aleksandr !!) m'a envoyé ces quelques lignes:

 

 

(defun c:test(/ cPl cInd cDis oLst)
 
 (vl-load-com)
 
 (if(setq cPl(entsel "\nSelect polyline > "))
   (progn
     (setq cInd 0
    cPl(car cPl)
    ); end setq
     (while(setq cPt(vlax-curve-GetPointAtParam cPl cInd))
(if(/= cInd 0)
  (setq cDis(-(vlax-curve-GetDistAtParam cPl cInd)
	       (vlax-curve-GetDistAtParam cPl(1- cInd)))
	); end setq
  (setq cDis 0.0)
  ); end if
(setq oLst(cons(list cInd cPt cDis) oLst)
      cInd(1+ cInd)
      ); end if
); end while
     (setq oLst(append(reverse oLst)
	       (list(vlax-curve-GetDistAtParam cPl
		      (1- cInd)))))
     ); end progn
   ); end if
 ); end of c:test

 

 

Ce lisp renvoi une liste des points constituant la polyligne: coordonnées, longueur du segment, longueur totale. Pour la longueur cumulée, je n'aurai pas de probleme je pense. Egalement pour ce qui est de le placer dans un tableau. Je n'ai pas trouvé de doc sur vlax-curve dans l'aide d'AutoCAD !

Ce qu'il me reste à trouver, et je sollicite votre aide: c'est la direction du segment (vlax-curve-getFirstDeriv semblerai répondre à ma demande ? j'essayerai !), le radius dans le cas d'un segment arc, les coodonnées de centre dudit segment arc, ainsi que les coordonnes de l'intersection virtuelle de deux segments droits de chaque coté du segment arc...

Merci aux virtuoses !

 

[(gile)]

Salut,

 

Tout d'abord, pour que tes message soient plus lisibles, quand tu postes du code, essaye de penser à le mettre entre des balises bbcode :

[code] le code ici [/code]

 

Les fonctions vlax-curve-* sont renseignées dans l'aide aux développeurs > AutoLISP Reference > AutoLISP Functions > V Functions.

 

vlax-curve-getFirstDeriv retourne le vecteur directeur de la tangente à la courbe au paramètre spécifié.

 

Pour les segments en arc, tu peux récupérer la courbure (bulge) du segment à l'index (paramètre) spécifié.

Le bulge correspond à la tangente du quart de l'angle décrit par l'arc, autrement dit, le rapport entre la flèche et la demie corde. Il est négatif si l'arc est dans le sens horaire.

 

Il peut être récupéré en AutoLISP avec le code DXF 42 de la liste entget de la polyligne :

;; pline = ename de la polyligne
(cdr (assoc  42 (entget pline)))

ou, en Visual LISP avec la propriété Bulge du vla-object, en spécifiant l'index du segment :

(vla-get-Bulge (vlax-ename->vla-object pline) index)

 

Une fois récupéré le bulge d'un segment, tu peux utiliser cette petite routine qui retourne une liste contenant le centre de l'arc, son rayon et l'angle décrit.

 

;;; Polyarc-data
;;; Retourne la liste des données d'un arc de polyligne (centre rayon angle).

(defun polyarc-data (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
    )
 )
 (list cen (abs rad) ang)
)

[onossa]

Merci (Gile)

Je vois que tu es bien matinal !

Il ne me reste "plus qu'à" ! grâce à votre aide, je pense avoir les éléments nécessaires.

Je ne manquerai pas de poster le résultat, afin d'avoir vos commentaires et pourqsuoi pas, aider ceux pour qui cela pourrait servir !

Excellente journée à toi, et à tous !

[bonuscad]

Bonsoir,

 

J'ai remanié ma précédente proposition.

Dans cette nouvelle version, je ne passe plus par Excel, je génère directement un vrai tableau sous Autocad.

 

Si cela t'intéresse, je pense qu'il est fonctionnel, mais des améliorations sont toujours possibles.

 

(vl-load-com)
(defun c:info_po2cell ( / 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!")
)
 (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_length '(0.0)
   lst_alpha '(0.0)
   lst_rad '(0.0)
 )
 (cond
   ((null (tblsearch "LAYER" "Tableau-Polyligne"))
     (vla-add (vla-get-layers AcDoc) "Tableau-Polyligne")
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Texte-Cell"))
     (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 "txt.shx")
     )
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Cell"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (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)
       )
     )
   )
 )
 (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)
     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_rad (cons (abs rad) 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" "Tableau-Polyligne")
 (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")) ">: ")))
 (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: "))
 (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 nb) 6 (+ h_t (* h_t 0.25)) 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)))
       " sur le Calque: " (cdr (assoc 8 (entget obj)))
       " Longueur totale = " (rtos (vlax-get ename 'Length))
     )
     8
   )
 )
 (vla-SetCellTextStyle ename_cell 0 0 "Texte-Cell")
 (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
 (foreach n
   (mapcar'list
     (append (mapcar 'itoa lst_id-seg) '("N°"))
     (append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordonnées X"))
     (append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordonnées Y"))
     (append (mapcar 'rtos lst_length) '("Longueurs"))
     (append (mapcar 'angtos lst_alpha) '("Directions"))
     (append (mapcar 'rtos lst_rad) '("Rayons"))
   )
   (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))
       )
       (vla-SetCellTextStyle ename_cell n_row n_column "Texte-Cell")
       (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)
)

 

[Edité le 25/1/2009 par bonuscad]

[onossa]

C'est absolument excellent bonuscad !

La seule remarque est d'avoir des rayons négatifs. ca doit pouvoir se corriger avec la valeur absolue de "rad". et les rayons de 0 en début de polyligne et segments droits. Il doit etre possible de conditionner la mise en place de ces textes à des valeurs non nulles.

 

Merci encore bonuscad !

 

[bonuscad]

La seule remarque est d'avoir des rayons négatifs. ca doit pouvoir se corriger avec la valeur absolue de "rad". et les rayons de 0 en début de polyligne et segments droits. Il doit etre possible de conditionner la mise en place de ces textes à des valeurs non nulles.

 

Le code à été corrigé, et quelques affinements apportés.

[chris_mtp]

Bonjour,

 

En effet, comme m'a dit onossa, ce post renvoie sur le mien.

Bonuscad, si on met la variable ANGDIR à 1 et ANGBASE à 0.

On a dans la colonne Directions qui en fait représente le gisement la valeur de celui ajouté de +100.

 

En définissant le Nord à 0, on devrait avoir la valeur de gisement -100.

J'ai essayé de modifier ton lisp selon mes besoins par

 

(setvar "ANGBASE" 100) 

 

ou bien

 

 alpha (if (zerop seg_bulge) (- (angle pt_start pt_end) 100) 0.0)

 

mais aucunes des deux ne marchent.

De plus, au lieu d'avoir la colonne rayon, comme ma polyligne est constitué de segments droits, j'ai modifié cette colonne pour avoir la valeur de l'angle du sommet correspondant.

Comment puis je faire ?

 

Merci par avance de ton aide.

John.

[chris_mtp]

Bonuscad, c'est bon.

Pour le gisement.

Il ne faut pas en fait modifier la variable ANGBASE mais simplement indiquer le Nord à 300g.

Par contre, ce qui est de l'angle d'un sommet de LWPOLYLINE formé par deux cotés, c'est possible de la calculé.

 

Merci par avance.

John

[bonuscad]

Il ne faut pas en fait modifier la variable ANGBASE mais simplement indiquer le Nord à 300g.

 

????

 

Lors de la première utilisation j'appelle la commande "_DDUNITS" ou tu pourras régler la précision à utiliser et les modes d'unités employer. (angtos) et (rtos) dans le lisp utiliserons alors les paramètres définis.

 

Si tu veux travailler en grade et avoir les gisements, dans la boite de dialogue il suffit de mettre l'origine au Nord (ANGBASE = pi/2, 90°, 100gr) et non 300gr, ET régler la direction dans le SENS HORAIRE. (ANGDIR)

 

Bon je n'ai pas encore fait de test en profondeur, il se peut que des erreurs subsistent.

 

Par contre, ce qui est de l'angle d'un sommet de LWPOLYLINE formé par deux cotés, c'est possible de la calculé.

 

Comme te l'a expliqué (gile) dans l'autre post, il faut transposer sa réponse dans ce lisp.

[bonuscad]

Bon j'ai eu quelques difficultés avec les angles intérieurs avec le système topographique (en grade dans le sens horaire et l'axe d'origine au nord)

 

Ce n'était pas aussi simple que je le pensais :P

 

Néanmoins pour John (chris_tmp), je pense avoir réussi à satisfaire sa demande. Des tests restent néanmoins indispensables pour s'assurer que cela fonctionne vraiment.

 

NB:Les polylignes avec des arc sont écartées.

 

(vl-load-com)
(defun c:listing_po2cell ( / js obj ename AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_avtx 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 lst_bulge avtx alpha oldim oldlay h_t w_c ename_cell n_row n_column)
 (defun ang_int ( px p1 p2 / l_pt l_d p ang)
   (setq
     l_pt (list px p1 p2)
		l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt))))
		p (/ (apply '+ l_d) 2.0)
		ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0)
	)
)
(defun angtos-bis (m_a / a_base a_dir str_a)
   (setq
     a_base (getvar "ANGBASE")
     a_dir (getvar "ANGDIR")
   )
   (setvar "ANGBASE" 0)
   (setvar "ANGDIR" 0)
   (setq str_a (angtos m_a))
   (setvar "ANGBASE" a_base)
   (setvar "ANGDIR" a_dir)
   str_a
)
(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!")
)
 (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_length '(0.0)
   lst_alpha '(0.0)
   lst_avtx '()
 )
 (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)
     seg_bulge (vla-GetBulge ename pr)
     avtx
       (if (and (car lst_pt) pt_end)
         (ang_int pt_start (car lst_pt) pt_end)
         0.0
       )
     alpha (if pt_end (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_bulge (cons seg_bulge lst_bulge)
     lst_avtx (cons (abs avtx) lst_avtx)
     lst_alpha (cons alpha lst_alpha)
     nb (1+ nb)
   )
 )
(cond
 ((null (vl-remove 0.0 lst_bulge))
 (cond
   ((null (tblsearch "LAYER" "Tableau-Polyligne"))
     (vla-add (vla-get-layers AcDoc) "Tableau-Polyligne")
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Texte-Cell"))
     (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 "txt.shx")
     )
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Cell"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (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
   lst_id-seg (cons nb lst_id-seg)
   lst_pt (cons pt_end lst_pt)
   lst_avtx (cons 0.0 lst_avtx)
   oldim (getvar "dimzin")
   oldlay (getvar "clayer")
 )
 (setvar "dimzin" 0) (setvar "clayer" "Tableau-Polyligne")
 (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")) ">: ")))
 (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: "))
 (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 nb) 6 (+ h_t (* h_t 0.25)) 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)))
       " sur le Calque: " (cdr (assoc 8 (entget obj)))
       " Longueur totale = " (rtos (vlax-get ename 'Length))
     )
     8
   )
 )
 (vla-SetCellTextStyle ename_cell 0 0 "Texte-Cell")
 (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
 (foreach n
   (mapcar'list
     (append (mapcar 'itoa lst_id-seg) '("N°"))
     (append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordonnées X"))
     (append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordonnées Y"))
     (append (mapcar 'rtos lst_length) '("Longueurs"))
     (append (mapcar 'angtos lst_alpha) '("Gisements"))
     (append (mapcar 'angtos-bis lst_avtx) '("Angles aux sommets"))
   )
   (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))
       )
       (vla-SetCellTextStyle ename_cell n_row n_column "Texte-Cell")
       (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)
 )
 (T (princ "\nLa commande ne traite pas des polylignes comportant des arcs"))
)
 (prin1)
)

[chris_mtp]

Merci bonuscad pour ce lisp.

C'est exactement ce que j'essayé de faire avec le peu de connaissances que j'ai.

J'ai fait plusieurs tests. Il n'y a oas de coquilles apparelent.

Le lisp est fiable.

C'est vrai pour la valeur du gisement. IL ne faut pas mettre le Nord à 300 gr sinon le lisp affiche les angles complémentaires à +200.

 

Merci encore.

John.

[onossa]

Merci Bonuscad pour ta réponse N°10 et ton aide.

 

Je tâcherai de me faire violence et de peaufiner ton code afin qu'il réponde exactement à mes besoins:

- Utilisation du style de texte courant

- Utilisation des unités et précisions courantes

- Ajout d'un condition afin d'appeler le premier point d'un segment arc "TP" pour tangent point

- Ajout d'un nouveau point "IP" intersection point indiquant les coordonnées de l'intersection virtuelle de deux segments droits avant et après le segment arc (c'est là que je risque de bloquer...)

- Ajout d'un condition afin d'appeler le premier point d'un segment arc "TP" pour tangent point

- Enfin, ajout d'une colonne avec les longueurs cumulés des segments, au fil des lignes du tableau.

 

Donc, encore du boulot pour parfaire ce tableau !

[philous2]

Bjr,

 

J'ai essayé le slisp en question et je dois avoir un petit problème car apèrs avoir saisi les objets on me demande tht écriture et largeur cellule, là pas de soucis et c'est ttt, ensuite je valide et il ne fait que le tabkeau ss rien à l'intérieur (vide).

Est-ce du à la police choisie , j'ai pris bold.shx, et comment faire pour changer cette police ds le lisp ?

[bonuscad]

Salut,

 

Quelle version d'Autocad?

Testé sur une 2008-2009, pour les autres versions antérieures, je ne sais pas.

 

Tu es sur de ne pas avoir une hauteur de texte minuscule par rapport à la largeur de cellule.

 

Dans le code ce qui concerne la définition du style de texte, cela se passe par là:

 

 (cond
   ((null (tblsearch "STYLE" "Texte-Cell"))
......
......
   )
 )

 

pourrait par exemple devenir en simplifié:

 

 (cond
   ((null (tblsearch "STYLE" "Texte-Cell"))
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Cell"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list "Simplex.shx" 0.0 0.0 1.0 0.0)
     )
   )
 )

 

Ici j'ai mis Simplex.shx comme fonte, tu peux en choisir une autre.

[philous2]

Slt,

 

Ben par défaut ma taille d'écriture était 2.5 ensuite j'ai mis 4.0 idem rien.

Autrement ma version autocad au boulot est 2006 Map

[bonuscad]

Ne pouvant reproduire la situation...

 

Que donne en retour ce qui suit en ligne de commande en cliquant sur le tableau vide.

(vla-GetCellTextStyle (vlax-ename->vla-object (car (entsel))) 0 0)

 

puis celle-ci

(vla-GetCellTextHeight (vlax-ename->vla-object (car (entsel))) 0 0)

[philous2]

pas trop compris c eque tu m'as dit déslé.

voilà ce que j'ai rentré comme commnde

 

 Commande: LISTING_PO2CELL
Sélectionner une polyligne.
Choix des objets:
Point d'insertion haut gauche du tableau:
Hauteur du texte <3.0000>:
Largeur des cellules: 40
Commande

:

 

et c'es ttt, le tableau apparait mais vide.

Je t'indique que j'ai dessiné une suite d eployligne avec la commande _pline.

A mon avis il y a un truc que je n'ai pas du faire correctement mais quoi.

Qd tu me dis ce que j'ai en retour en cliquant sur le tableau vide , ben qd je clique sur le tableau vide il me mets rein juste ça

 

 Commande: Spécifiez le coin opposé:

c'est tt

 

[bonuscad]

pas trop compris ce que tu m'as dit désolé.

 

Tu copies-colle la ligne de code en ligne de commande et tu valides. (1er parenthèse à dernière parenthèse)

Au message "Choix de l'objet", tu cliques sur une entité du tableau (n'importe la quelque; ligne du tableau par exemple)

Et tu devrais avoir un retour de la ligne de code.

[philous2]

J'ai bien copeir la ligne de commande

 

(vla-GetCellTextStyle (vlax-ename->vla-object (car (entsel))) 0 0)

j'ai ensuite valider , je'ia eue ensuite "choix d el'objet" j'ai fait comme tu dis cliqué sur une entité de mon tableau vide et j'ai pas grand chose en final

 

Commande: (vla-GetCellTextStyle (vlax-ename->vla-object (car (entsel))) 0 0)

Choix de l'objet: "Standard"

 

Il y a un truc

[bonuscad]

citation extraite du message original:

Commande: (vla-GetCellTextStyle (vlax-ename->vla-object (car (entsel))) 0 0)

Choix de l'objet: "Standard"

 

 

Il y a un truc

 

Effectivement, cela aurait du retourner-> Choix de l'objet: "Texte-Cell"

 

Pas trop de suggestions

Tu peux essayer de virer la partie

 

(cond

((null (tblsearch "STYLE" "Texte-Cell"))

......

......

)

)

ainsi que les 2 lignes que tu pourras trouver plus loin dans le code

(vla-SetCellTextStyle ename_cell 0 0 "Texte-Cell")

(vla-SetCellTextStyle ename_cell n_row n_column "Texte-Cell")

 

Si ça ne fonctionne toujours pas c'est que le code n'est pas compatible avec 2006.

Si ça fonctionne, ce sera avec le style courant par défaut...