Raccord Arc-Arc-Ligne

[kallain]

Bonjour,

J'ai trouvé ce site très intéressant

http:// http://new.cadalyst.com/

ce lisp qui permet de créer un arc tangent à 2 entités quelles soient ligne, arc, cercle ou polyligne. Super non ?

 

Les problèmes:

1- je suis nul en lisp :P

2- le programme me renvoie des commandes inconnues : UNDO, MARK, BACK :casstet:

3- le raccordement de fait à l'envers (essayez, vous comprendrez) :casstet:

4 -mes accrochages objets sont désactivés. :casstet:

 

Je sais qu'il y a des super lispeurs qui résoudront ces problèmes et je les remercie par avance.

 

PS : je suis sur 2004

 

;;;

;;; TAN-ARCS.LSP A program to construct an arc that

;;; is tangent to any combination of two entities of

;;; type line, arc, circle, or polyline. The user

;;; indicates the approximate tangent locations.

 

(defun err (s)

(if (= s "Function cancelled")

(princ "\nTAN-ARCS - cancelled: ")

(progn (princ "\nTAN-ARCS - Error: ") (princ s)

(terpri))

); if

(resetting)

(princ "SYSTEM VARIABLES have been reset\n")

(princ)

); err

(defun setv (systvar newval)

(setq x (read (strcat systvar "1")))

(set x (getvar systvar))

(setvar systvar newval)

); setv

(defun setting ()

(setq oerr *error*)

(setq *error* err)

(setv "CMDECHO" 0)

(setv "BLIPMODE" 0)

); end of setting

(defun rsetv (systvar)

(setq x (read (strcat systvar "1")))

(setvar systvar (eval x))

); restv

(defun resetting ()

(rsetv "CMDECHO")

(rsetv "BLIPMODE")

(setq *error* oerr)

); end of resetting

 

(defun dxf (code ename)

(cdr (assoc code (entget ename)))

); dxf

 

(defun tanarc ()

(command "UNDO" "MARK")

(convplne) ;; converts to old-style polylines

(setq tadata (get-data) ;; gets tangents & rad

tp1 (cadr (nth 0 tadata))

tp2 (cadr (nth 1 tadata))

rad (nth 2 tadata)

) ; setq

(command "_CIRCLE" "TTR" tp1 tp2 rad)

(setq en (entlast)

cenp (dxf 10 en)

); setq

(entdel en)

(setq sp (getp cenp tp1))

(setq ep (getp cenp tp2))

(command "UNDO" "BACK")

(command "ARC" sp "C" cenp ep)

(princ)

) ; tanarc

 

(defun convplne ()

(setq i (- 1))

(setq ss (ssget "X" '((0 . "LWPOLYLINE"))))

(if ss

(progn

(repeat (sslength ss)

(setq ename (ssname ss (setq i (1+ i)))

elist (entget ename)

num-vert (cdr (assoc 90 elist))

flag-bit (cdr (assoc 70 elist))

elev (cdr (assoc 38 elist))

lyr (cdr (assoc 8 elist))

thick (cdr (assoc 39 elist))

const-wid (cdr (assoc 43 elist))

elist (member (assoc 10 elist) elist)

); setq

(setv "THICKNESS" thick)

(entmake (list '(0 . "POLYLINE")

'(66 . 1)

(cons 8 lyr)

(list 10 0.0 0.0 elev)

(cons 70 flag-bit)

); list

); entmake

(repeat num-vert

(setq vl10 (cdr (assoc 10 elist)))

(setq vl40 (cdr (assoc 40 elist)))

(setq vl41 (cdr (assoc 41 elist)))

(setq vl42 (cdr (assoc 42 elist)))

(setq elist (cdr elist)

elist (member (assoc 10 elist) elist)

); setq

(entmake (list '(0 . "VERTEX")

(cons 10 vl10)

(cons 40 vl40)

(cons 41 vl41)

(cons 42 vl42)

); list

); entmake

); repeat num-vert

(entmake '((0 . "SEQEND")))

(entdel ename)

(rsetv "THICKNESS")

); repeat sslength

); progn lwpolyline

); if

(princ)

); convplne

 

(defun get-data ()

(setvar "OSMODE" 512)

(setq p1 (getpoint "\nFirst tangent point: ")

p2 (getpoint "\nSecond tangent point: ")

rad (getreal "\nArc radius: ")

ent1 (nentselp p1)

ent2 (nentselp p2)

endata (list ent1 ent2 rad)

) ;_ end of setq

(setvar "OSMODE" 0)

endata

) ;_ end of defun

 

(defun getp (cenp tp)

(command "_LINE" cenp "PER" tp "")

(setq en (entlast)

p (dxf 11 en)

); setq

p

); getp

 

(defun c:tac ()

(setting)

(tanarc)

(resetting)

(princ)

); c:tac

 

(prompt "\nCopyright © 2000, Tony Hotchkiss")

(prompt "\nEnter TAC to start")

[Tramber]

2- le programme me renvoie des commandes inconnues : UNDO, MARK, BACK :casstet:

 

Normal, les américains se contrefichent généralement des utilisateurs internationaux. Mets un "_" devant tous les termes employés dans les appels de fonctions COMMAND.

 

(command "_UNDO" "_BACK") est mieux par exemple

 

Bonjour,

J'ai trouvé ce site très intéressant

 

Achète des programmes, tu vas criser ! La plupart de ceux qui sont en lisp ne sont pas traduits pour les version internationales.

 

le raccordement de fait à l'envers (essayez, vous comprendrez)

 

A voir, en effet, d'autant que le lisp n'a pas l'air d'utiliser la commande raccord.

 

Tes accrobj sont desactivés car une erreur s'est produite,....et comme UNDO est mal traduite (il faut mettre _UNDO comme dit plus haut), tes accrobjs sont perdus.

 

 

 

 

[kallain]

Merci Bertrand,

Voila le point 2 résolu. ;)

 

Le point 3

3- le raccordement de fait à l'envers

En fait le programme dessine 1 des 2 raccordements possibles, suivant les points approchés de tangentes choisis :

Mais je ne comprends pas comment les choisir correctement

1 fois ça marche, d'autres fois c'est pas le bon raccordement, et

les rayons sont tracés ou pas : Mystère.

 

Le point 4 n'est résolu.

 

 

[bonuscad]

Je pense que le problème vient de :

 

Outre les points approchés de tangentes choisis, il te faut tenir compte de l'ordre de saisie de tes points de tangence en tenant compte du parcours TOUJOURS dans le sens trigonométrique (sens inverse des aiguille d'une montre).

 

Je n'ai pas fait de test mais je pense avoir bon :P

[kallain]

ben voilà, on avance,

C'est bien la solution au problème 3, Merci Bonuscad :D

 

mais je découvre un autre problème : Ce lisp ne marche que si l'on est dans le SCU général.

[(gile)]

Salut,

 

Voilà, un peu tardivement, une version francisée pour les invites, internationalisée pour les commandes et [surligneur]universalisée[/surligneur] pour les SCU (les objets doivent être coplanaires et dans un plan parallèle au plan XY du SCU courant)

 

;;;
;;; TAN-ARCS.LSP A program to construct an arc that
;;; is tangent to any combination of two entities of
;;; type line, arc, circle, or polyline. The user
;;; indicates the approximate tangent locations.

(defun err (s)
 (if (= s "Fonction annulée")
   (princ "\nTAN-ARCS - annulé: ")
   (progn (princ "\nTAN-ARCS - Erreur: ")
   (princ s)
   (terpri)
   )
 ) ;_ if
 (resetting)
 (princ "les VARIABLES SYSTEME ont été restaurées.\n")
 (princ)
) ;_ err


(defun setv (systvar newval)
 (setq x (read (strcat systvar "1")))
 (set x (getvar systvar))
 (setvar systvar newval)
) ;_ setv


(defun setting ()
 (setq oerr *error*)
 (setq *error* err)
 (setv "CMDECHO" 0)
 (setv "BLIPMODE" 0)
) ;_ end of setting


(defun rsetv (systvar)
 (setq x (read (strcat systvar "1")))
 (setvar systvar (eval x))
) ;_ restv


(defun resetting ()
 (rsetv "CMDECHO")
 (rsetv "BLIPMODE")
 (setq *error* oerr)
) ;_ end of resetting


(defun dxf (code ename)
 (cdr (assoc code (entget ename)))
) ;_ dxf


(defun tanarc ()
 (command "_UNDO" "_MARK")
 (convplne)
 ;; converts to old-style polylines
 (setq	tadata (get-data)
;; gets tangents & rad
tp1    (cadr (nth 0 tadata))
tp2    (cadr (nth 1 tadata))
rad    (nth 2 tadata)
 ) ;_ setq
 (command "_CIRCLE" "_TTR" tp1 tp2 rad)
 (setq	en   (entlast)
cenp [surligneur](trans (dxf 10 en) en 1)[/surligneur]
 ) ;_ setq
 (entdel en)
 (setq sp (getp cenp tp1))
 (setq ep (getp cenp tp2))
 (command "_UNDO" "_BACK")
 (command "_ARC" [surligneur]"_NON"[/surligneur] sp "_C" [surligneur]"_NON"[/surligneur] cenp [surligneur]"_NON"[/surligneur] ep)
 (princ)
) ;_ tanarc


(defun convplne	()
 (setq i (- 1))
 (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
 (if ss
   (progn
     (repeat (sslength ss)
(setq ename	(ssname ss (setq i (1+ i)))
      elist	(entget ename)
      num-vert	(cdr (assoc 90 elist))
      flag-bit	(cdr (assoc 70 elist))
      elev	(cdr (assoc 38 elist))
      lyr	(cdr (assoc 8 elist))
      thick	(cdr (assoc 39 elist))
      const-wid	(cdr (assoc 43 elist))
      elist	(member (assoc 10 elist) elist)
) ;_ setq
(setv "THICKNESS" thick)
(entmake (list '(0 . "POLYLINE")
	       '(66 . 1)
	       (cons 8 lyr)
	       (list 10 0.0 0.0 elev)
	       (cons 70 flag-bit)
	 ) ;_ list
) ;_ entmake
(repeat	num-vert
  (setq vl10 (cdr (assoc 10 elist)))
  (setq vl40 (cdr (assoc 40 elist)))
  (setq vl41 (cdr (assoc 41 elist)))
  (setq vl42 (cdr (assoc 42 elist)))
  (setq	elist (cdr elist)
	elist (member (assoc 10 elist) elist)
  ) ;_ setq
  (entmake (list '(0 . "VERTEX")
		 (cons 10 vl10)
		 (cons 40 vl40)
		 (cons 41 vl41)
		 (cons 42 vl42)
	   ) ;_ list
  ) ;_ entmake
) ;_ repeat num-vert
(entmake '((0 . "SEQEND")))
(entdel ename)
(rsetv "THICKNESS")
     ) ;_ repeat sslength
   ) ;_ progn lwpolyline
 ) ;_ if
 (princ)
) ;_ convplne


(defun get-data	()
 (setvar "OSMODE" 512)
 (setq	p1     (getpoint "\nPremier point tangent: ")
p2     (getpoint "\nSecond point tangent: ")
rad    (getreal "\nRayon de l'arc: ")
ent1   (nentselp p1)
ent2   (nentselp p2)
endata (list ent1 ent2 rad)
 ) ;_ end of setq
 (setvar "OSMODE" 0)
 endata
) ;_ end of defun


(defun getp (cenp tp)
 (command "_LINE" cenp "_PER" tp "")
 (setq	en (entlast)
p  [surligneur](trans (dxf 11 en) 0 1)[/surligneur]
 ) ;_ setq
 p
) ;_ getp


(defun c:tac ()
 (setting)
 (tanarc)
 (resetting)
 (princ)
) ;_ c:tac


(prompt "\nCopyright (c) 2000, Tony Hotchkiss")
(prompt "\nTaper TAC pour démarrer") 

 

PS : j'ai rajouté aussi des [surligneur]"_NON"[/surligneur] pour aucun accrochage aux objets lors de la création de l'arc de cercle.

 

[Edité le 10/3/2006 par (gile)]

[kallain]

Bonjour (gile)

 

C'est en suivant ton fil de discussion que tu as donné dans

"J'ai bcp de mal avec entnext entlast" que je suis retombé sur le sujet que j'avais lancé

et dont je n'avais pas vu ta réponse (week-end chargé).

 

Je te remercie infiniment, ;) voilà une routine qui va m'être très utile.

 

PS ; je m'engage à faire une donation là pour toute réponse pertinente à mes questions. :D

 

 

 

[Edité le 14/3/2006 par kallain]

[(gile)]

Salut,

 

Merci, mais je n'ai fait qu'un peu de traduction, et désactivé ponctuellement les accrochages aux objets.

 

Je ne trouve pas cette routine très aboutie, à mon goût, il manque des contrôles, elle change systématiquement toutes les lwpolylignes du dessin en polylignes 2D (old-style), en cas d'erreur pendant l'exécution d'une des sous-routines l'accrochages aux objets ne sera pas réactivé (tu en as fait l'expérience) ...

[kallain]

elle change systématiquement toutes les lwpolylignes du dessin en polylignes 2D (old-style)

 

Bin justement, ça tombe bien,

Peux-tu m'expliquer les différences entre polyligne, polyligne(2d) et lwpolyligne ?

[Tramber]

LW date de longtemps, en remplacement de la polyligne.

LW signifie Light Weight. L'écriture par le programme en DXF (ou en DWG si tu veux) est plus simple et plus efficace.

 

La poly que nous créons tous les jours est une LW.

L'ancienne fonctionne sur le mode la poly3D, c'est à dire en une série de segments possédant chacun une entrée DXF.

CONVERT permet de convertir les anciennes en nouvelles.

 

L'inverse n'est pas possible je crois.