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

Afficher le périmètre de l\'objet

(gile)

Par (gile)
dans Programmer en s'amusant

 Partager

Messages recommandés

(gile) Proficient

(gile)

Posté(e)
Posté(e)

Salut,

 

Je me suis un peu amusé avec la fonction LISP grread.

 

GEOM permet d'afficher certaines propriétés géométriques de l'objet qui se trouve sous le curseur.

 

On boucle sur les différentes propriétés avec un clic gauche:

- mode 1 : périmètre (arc, cercle, ellipse, ligne, polyligne (tous types), région, spline mpolygon)

- mode 2 : longueur du segment (polyligne tous types) ou rayon (arc, cercle)

- mode 3 : aire (arc, cercle, ellipse, hachure, ligne, polyligne (sauf 3d), région, spline plane, mpolygon).

 

Le texte s'affiche à côté du curseur, son apparence est indépendante du zoom, de la vue, du SCU...

 

On sort de la commande avec un clic droit ou n'importe quelle touche du clavier.

 

;;; GEOM (gile)
;;; Affiche le périmètre, la longueur du segment ou le rayon, l'aire
;;; de l'objet sous le cuseur.

(defun c:geom (/ *error* makeString loop gr ent text ent str vs norm)
 (vl-load-com)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (and text (entdel text))
   (and ent (redraw ent 4))
   (princ)
 )

 (defun makeString (ent pt flag / obj oName p1 pa str)
   (setq obj (vlax-ename->vla-object ent)
  oName (vla-get-ObjectName obj))
   (cond
     ((= 0 flag)
(if (/= oName "AcDbHatch")
  (if (member oName '("AcDbRegion" "AcDbMPolygon"))
    (strcat "Périmètre : " (rtos (vla-get-Perimeter obj)))
    (strcat "Périmètre : "
	    (rtos
	      (vlax-curve-getDistAtParam
		obj
		(vlax-curve-getEndParam obj)
	      )
	    )
    )
  )
)
     )
     ((= 1 flag)
(cond
  ((wcmatch oName "*Polyline")
   (if (= oName "AcDb2dPolyline")
     (setq p1 (vlax-curve-getClosestPointToProjection
		obj
		(trans pt 1 0)
		(trans '(0 0 1) 2 0 T)
	      )
     )
     (setq p1 (trans (osnap pt "_nea") 1 0))
   )
   (if (setq par (vlax-curve-getParamAtPoint obj p1))
     (strcat
       "Segment : "
       (rtos
	 (- (vlax-curve-getDistAtParam obj (1+ (fix par)))
	    (vlax-curve-getDistAtParam obj (fix par))
	 )
       )
     )
   )
  )
  ((member oName '("AcDbArc" "AcDbCircle"))
   (strcat "Rayon : " (rtos (vla-get-Radius obj)))
  )
  ((= oName "AcDbLine")
   (strcat "Segment : "
	   (rtos
	     (vlax-curve-getDistAtParam
	       obj
	       (vlax-curve-getEndParam obj)
	     )
	   )
   )
  )
)
     )
     ((= 2 flag)
      (if
 (not
   (or (member oName '("AcDbLine" "AcDb3dPolyline"))
       (and
	 (= oName "AcDbSpline")
	 (= oName :vlax-false)
       )
   )
 )
  (strcat "Aire : " (rtos (vla-get-Area obj)))
      )
     )
   )
 )

 (setq	loop T
flag 0
 )
 (while (and (setq gr (grread T 14 2)) loop)
   (and text (entdel text) (setq text nil))
   (and ent (redraw ent 4))
   (setq pt (cadr gr))
   (cond
     ((= (car gr) 5)
      (if
 (and
   (setq ent
	  (ssget
	    pt
	    '((0
	       .
	       "ARC,CIRCLE,ELLIPSE,LINE,HATCH,*POLYLINE,REGION,SPLINE,MPOLYGON"
	      )
	      (-4 . "		      (-4 . "&")
	      (70 . 112)
	      (-4 . "NOT>")
	     )
	  )
   )
   (setq ent (ssname ent 0))
   (setq str (makeString ent pt flag))
 )
  (progn
    (redraw ent 3)
    (setq size (/ (getvar "VIEWSIZE") 80.)
	  norm (trans '(0 0 1) 2 0 t)
	  text (entmakex
		 (list
		   '(0 . "TEXT")
		   '(62 . 7)
		   (cons 1 str)
		   (cons
		     10
		     (polar (trans pt 1 norm) (/ pi 4) size)
		   )
		   (cons 40 size)
		   (cons 7 (getvar "TEXTSTYLE"))
		   (cons 50 (- (getvar "VIEWTWIST")))
		   (cons 210 norm)
		 )
	       )
    )
  )
      )
     )
     ((= 3 (car gr))
      (setq flag (rem (1+ flag) 3))
     )
     (T (setq loop nil))
   )
 )
 (and text (entdel text))
 (and ent (redraw ent 4))
 (princ)
)

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

phil_vsd Newbie

phil_vsd

Posté(e)
Posté(e)

Salut (Gile),

 

Je teste ton lisp mais j'ai un message d'erreur que je n'arrive pas à corriger avec le formatage : "Formatage interompu, unbalanced token"

 

Puis lorsque je fais sous VLISP un Ctrl+Alt+E j'ai le message :

 

"cdrs supplémentaire dans la paire pointée en entrée"

 

 

Je suis sur 2009 full power. T'as une idée ?

 

Merci !!

 

 

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

 

Hello

 

Je confirme l'erreur "cdrs supplémentaire dans la paire pointée en entrée"

sous MAP 2009 & sous MAP 2006 :o

 

So wait and see ... :P

 

le Decapode

 

Autodesk Expert Elite Team

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

On boucle sur les différentes propriétés avec un clic gauche:

 

Sympa ce mode par clic gauche ! ;)

Outil de renseignement graphique polyvalent intéressant.

Merci

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

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

 

Hello

 

Rigolo en effet ce programme ... Testé sur 2009 & 2004 !

 

En testant la Spline, je viens de m'apercevoir que le périmètre de la Spline n'était pas fourni alors que bien sur GEOM et la commande LISTE l'affiche ! :o

 

Le fait d'afficher la longueur d'un segment ou arc de polyligne est interessant ;)

 

Le Decapode

 

Autodesk Expert Elite Team

(gile) Proficient

(gile)

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

En testant la Spline, je viens de m'apercevoir que le périmètre de la Spline n'était pas fourni alors que bien sur GEOM et la commande LISTE l'affiche !

:exclam: :casstet: :o

 

Normalement le périmètre de tout type de splines est affiché ainsi que l"aire des splines planes.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

 

Hello

 

Je n'ai pas la propriété de longueur ou périmètre dans mon MAP 2004 ou 2009

sur les objets de type SPLINE et vous ?

 

Je parle de la case de dialogue des propriétés !

 

LISTE et la routine GEOM me donne bien cette info !!

 

Le Decapode

 

Autodesk Expert Elite Team

  • 1 mois après...
onossa Newbie

onossa

Posté(e)
Posté(e)

Bonjour ou bonsoir (Gile)

 

Cette fonction est trè intéressante et a des similitudes avec une fonctionnalité que je cherche à obtenir:

 

J'ai un lisp qui permet de dessiner un tableau en récupérant les propriétés de chacun des segment d'une polyligne choisie.

Ce code a deux "problèmes":

- La polyligne ne peut pas démarrer par un segment (dxf code 42 incriminé ??)

- Il ne peut y avoir deux segments arcs contigus (le second ne me semble pas considéré comme un segment arc...)

 

Le code est ci-après... Déolé s'il est loin d'être agréable, mais si quelqu'un pouvait m'aider à mettre le doisgt sur ce qui m'empêche qu'il fonctionne sans ses deux "bémols", ce serai le bonheur !!!

 

Merci d'avance si vous pouvez m'aider...

 

 

 

; 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 "table_tracks".

; 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

 

 

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

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

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

J'ai un lisp qui permet de dessiner un tableau en récupérant les propriétés de chacun des segment d'une polyligne choisie.

 

Disons que tu as su trouver un lisp sur le net, tu pourrais peut être retrouver l'auteur et le contacter...

 

D'autre part polluer d'autres fils de discussion pour essayer d'avoir une réponse :casstet:

Continue sur ton 1er post quitte à faire un "Up" si tu penses qu'on t'a zappé.

 

Personnellement je n'ai pas envie de décortiquer ce lisp pour le corriger.

 

Mais je vais être bon prince et te dire exactement où ça coince, à toi de trouver la solution pour corriger.

 

(setq IP (inters (cdr (assoc 10 v0))

(cdr (assoc 10 v1))

vcen

el2

nil

) ;_ Fin de inters

) ;_ Fin de setq

IP se retrouve à nil car il cherche une intersection sur deux lignes de longueur nulle

 

Temporairement j'ai rajouter cette ligne juste après pour voir si il y avait d'autre problème bloquant

(if (null ip) (setq ip (getvar "lastpoint")))

 

Là il ne se bloque plus, mais les données dans le tableau s'en retrouve faussées.

 

Tu travailles sur une version US? Car il y a des oublis de traduction qui font planter sur une version Francaise.

(if (= (tblsearch "LAYER" "TEXTE") nil)

(COMMAND "_LAYER" "[surligneur]_[/surligneur]New" "TEXTE" "[surligneur]_[/surligneur]ON" "TEXTE" "");si existe pas on crée "Nouv" et le rends actif "AC" (pour "ACtif")

(Command "_LAYER" "[surligneur]_[/surligneur]ON" "TEXTE" "");si existe on le rend actif

) ;_ Fin de if

 

(command "CONVERTpoly" "[surligneur]_[/surligneur]H" elem "" "_redraw")

 

Et sur un forum US ça donne quoi comme retour à ta question?

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

onossa Newbie

onossa

Posté(e)
Posté(e)

Premièrement Bonuscad, merci pour avoir eu la gentillesse de me répondre.

Néanmoins, petite mise au point:

- Je n'ai jamais dit avoir écrit ce lisp (même si j'en ai écris quelques uns et récupéré bien d'autres)

- J'ai essayé de retrouver l'auteur sans succès

- Je suis tout nouveau sur le site et c'est le premier forum où je m'inscris, et suis étonné de voir cette réaction pour le moins accusatrice. Si c'est une accusation, je plaide coupable, car je récupère autant de lisp que j'ai su en créer. Des modestes, certes, mais qui répondaient toujours à un besoin précis. Lisps que j'ai d'ailleurs également distribué autour de moi, même si pas par forums.

Ceci étant dit, je suis aujourd'hui dans une situation nouvelle: contrairement au passé, où à de nombreuses reprises j'ai eu le temps de me pencher longtemps sur un problème pour en trouver la solution, aujourd'hui ma situation perso et pro ne m'en donne très sincèrement pas le temps. Alors:

OUI j'ai opté pour cette facilité.

OUI, j'ai peut etre "pollué" ce sujet dans l'intention d'avoir les lumières de toi ou (Giles) ou autre passionné plein de talent, mais je pensais trouver de l'entraide. Et apparament je ne me suis pas totalement trompé vu l'aide que tu m'apporte. Même si je n'ai pas bien compris le problème: IP étant "intersection point": intersection étendue (virtuelle) de segments de la polyligne dont on rcupère les coordonnées et que l'on place dans le tableau...

Je tâcherai de voir si on peut me prêter un ordi portable ou alors printer le lisp comme ça j'aurai le temps dans le RER de comprendre...!

Je vois aujourd'hui que le visual lisp est largement utilisé voir privilégié au lisp standard... Je vais chercher aussi dans ce sens. Tout ceci dès que j'aurai un moment !

En attendant ce moment:

Bien sur que j'aimerai que l'on m'aide là dessus.

Bien sur que non: je ne sais aps comment faire un UP de mon sujet initial... Quelqu'un m'affranchit sur ce sujet également ?

Enfin, oui c'est une vesion US et c'st là que l'on voit que j'ai pas créé ce lisp, car bossant sur les deux versions, j'ai adapté MES principaux lisp pour qu'ils tournent sur les deux...

Tout ceci dit, merci encore et longue vie à vous virtuoses du lisp, et merci d'avance pour les bons princes qui éclaireront mes pas...

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

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Bonjour Onossa,

 

OUI j'ai opté pour cette facilité.

OUI, j'ai peut être "pollué" ce sujet

 

On ne peut que pardonner ;)

 

ma situation perso et pro ne m'en donne très sincèrement pas le temps

Je veux bien te croire, mais cela nous en donnes pas plus à nous pour autant.

 

je ne sais pas comment faire un UP de mon sujet initial

Si tu es l'initiateur du sujet comme ici, tu as en bas de ton message 2 flèches bleu enroulées qui te permettent de réactualiser ton sujet, c'est dans ce même 1er message que tu peut aussi le mettre en résolu (ampoule), le déclarer comme un bug (petite bête noire)

Tu peux aussi te répondre à toi même en signalant que ton sujet n'est toujours pas résolu.

 

Pour en revenir au sujet, décortiquer le programme d'un autre n'est pas toujours aisé, cela peut prendre autant de temps (si ce n'est plus) que de le réécrire.

 

D'ailleurs le début de solution que je t'ai donné a l'avantage de fonctionner. Je suis presque sur, par exemple, que Patrick_35 pourrait nous aider pour automatiser la partie concernant Excel afin d'avoir directement le tableau dans Autocad au lieu des étapes manuelles que je proposais.

 

On peut aussi faire le tableau comme dans ton lisp US proposé, mais je préfère pour ma part le résultat sous un tableau Autocad.

 

Rendez-vous dans ton post initial.

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - 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é