Remplacer Arc/Cercle par polygone regulier

[lecrabe]

 

Hello

 

Dans le cadre d'échange avec d'autres logiciels qui ne supportent pas bien les arcs et/ou cercles AutoCAD, je désire SVP une "petite routine" ... :P

 

J'ai deja une routine qui dessine des polygones réguliers de N cotés centrés sur les cercles selectionnés, avec le rayon du cercle et un nombre de segment paramétrable ! :)

 

Mais elle a un manque : pas de transfert des éventuels XDATAs ou Liens ASE-SQL !!!

 

Mais je n'ai pas de routines qui traitent les arcs simples et surtout les arcs à l'intérieur des polylignes closes ou non ! :o

 

Donc je désire 3 routines l'une qui traite les arcs et les cercles et surtout une autre spécifique pour les polylignes closes ou non !!!

( pour les arcs/cercles, je pense que c'est assez simple )

 

Paramètres : nombre de segments du polygone régulier qui simule les arcs

 

Sélection AutoCAD classique ...

 

SVP je désire que les éventuels XDATAs et/ou Liens ASE-SQL présents sur les arcs ou cercles soient transféres sur les nouveaux polygones réguliers !

 

La routine (Lisp ou plutôt V-Lisp) peut etre unique avec 3 commandes ou bien en 3 routines

ARC2POL, CER2POL,ARCPOL2POL

 

Fonctionnement si possible depuis AutoCAD 2004 ou sinon depuis AutoCAD 2007

 

Les éventuels nouveaux objets sont dessinés sur le calque courant

 

Merci d'avance de votre aide, Le Decapode

 

 

 

 

[(gile)]

Salut,

 

Voilà déjà pour les arcs et les cercles, j'ai juste rafraichi un truc que j'avais déjà donné ici.

 

Les Xdatas sont copiées dans la nouvelle polyligne.

Pour les liens, je ne sais pas où ils se cachent, je n'utilise pas de BD.

 

(defun c:ac2pg (/ space ss n_seg obj dist pt_lst nb)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-Activedocument (vlax-get-acad-object)))
 )
 (setq	space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
 (initget 7)
 (setq n_seg (getint "\nNombre de segments pour un cercle: "))
 (prompt
   "\nSélectionner les arcs ou cercles à transformer ou [b]."
 )
 (if
   (or	(setq ss (ssget '((0 . "ARC,CIRCLE"))))
(setq ss (ssget "_X" '((0 . "ARC,CIRCLE"))))
   )
    (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
      (if (= (vla-get-ObjectName obj) "AcDbCircle")
 (setq nb n_seg
       pt_lst nil
 )
 (setq nb     (fix (* n_seg
		      (/ (- (vla-get-EndAngle obj)
			    (vla-get-StartAngle obj)
			 )
			 (* 2 pi)
		      )
		   )
	      )
       pt_lst (list (vlax-curve-getEndPoint obj))
 )
      )
      (setq dist (/ (vlax-curve-getDistAtParam
	       obj
	       (vlax-curve-getEndParam obj)
	     )
	     nb
	  )
     norm (vlax-get obj 'Normal)
      )
      (repeat nb
 (setq
   pt_lst (cons	(vlax-curve-getPointAtDist
		  obj
		  (* dist (setq nb (1- nb)))
		)
		pt_lst
	  )
 )
      )
      (setq elev   (- (caddr (trans (car pt_lst) 0 norm))
	       (caddr (trans '(0 0) 0 norm))
	    )
     pt_lst (apply 'append
		   (mapcar '(lambda (pt)
			      (setq pt (trans pt 0 norm))
			      (list (car pt) (cadr pt))
			    )
			   pt_lst
		   )
	    )
      )
      (setq pline
      (vlax-invoke
	space
	'addLightWeightPolyline
	pt_lst
      )
      )
      (vlax-put pline 'Normal norm)
      (vla-put-elevation pline elev)
      (if (= (vla-get-ObjectName obj) "AcDbCircle")
 (vla-put-closed pline :vlax-true)
      )
      (vla-GetXData obj "" 'dtype 'dvalue)
      (and dtype (vla-SetXData pline dtype dvalue))
      (vla-delete obj)
    )
 )
 (princ)
) 

[lecrabe]

 

Hello Gilles

 

Merci :) :D

 

=== 1er test avec AutoCAD 2006 ===

 

OK pour les cercles et OK pour le transfert des XDATAs

 

NOK pour les arcs >>>

Choix des objets:

; erreur: AutoCAD.Application: Argument coordinates incorrect dans Coordinates

property

 

Commande:

 

Je vais tester avec un AutoCAD 2008 ...

 

Petit ajout SVP : Poser la question " Voulez effacer les objets originaux : (Defaut = Non)

 

Le Decapode

 

 

[lecrabe]

 

ReHello

 

Meme erreur sur les Arcs avec AutoCAD 2008 ! :o

 

SVP Petite amélioration : proposer une valeur par défaut (=64) pour le nbr de segments

et si on relance le programme, récupérer la dernière valeur utilisée !

 

Merci d'avance, Le Decapode

 

[rebcao]

Il est gonflé avec ses grosses PINCEs le Crabeleux !!!

 

il en demande toujours plus... ;)

 

Méfies-toi Gilles...

 

Christian

 

 

 

[Edité le 7/11/2008 par rebcao]

[lecrabe]

Hello Gilles

 

Je t'envoie par MP un DWG avec des liens ASE-SQL + le fichier Access MDB qui va avec ... :)

 

Ces liens ASE-SQL semblent être en fait des XDATAs un peu spéciaux, tu verras ?

 

Voici ce que me donne sur la parcelle No 194 (et non pas 7), la routine XDA.lsp :

 

Appli : DCO15

1071 Entier 32 bits : 1

1071 Entier 32 bits : 1

1000 Chaine : NOPARC

1004 Binaire : C2000000

 

Donc peut etre que la simple copie de tous les XDATAs,

transfère aussi en fait les liens ASE-SQL ... A voir ...

 

Le Decapode (qui hait les Cercles et Arcs en ce moment)

 

PS: J'ai corrigé, c la parcelle No 194 en fait ! :o

 

 

 

[Edité le 7/11/2008 par lecrabe]

[(gile)]

Salut

 

Il est gonflé avec ses grosses PINCEs le Crabeleux !!!

 

il en demande toujours plus... ;)

 

Méfies-toi Gilles...

 

C'est vrai ;) , mais ce qu'il demande en plus ne me coute vraiment pas grand chose, je ne l'avais pas fait juste par flemme.

 

Et puis c'est un testeur hors pair, et ça, c'est précieux.

 

lecrabe,

 

Je ne comprends pas pourquoi la première routine ne fonctionne pas chez toi, chez moi, ça marche.

 

Les liens ASE-SQL semblent effectivement être stockés dans des XDatas.

 

Voilà en une seule routine (AutoLISP, ça change) pour les arcs, cercles, et polyarcs.

Le nombre de segment entré est enregistré dans la base de registre pour être rproposé au prochain lancement (même dans un autre dessin).

Possibilité de conserver ou supprimer les objets source.

Les XDatas sont transférées.

 

;;; ARC2SEG (gile)
;;; Transforme les arcs, cercles et polyarcs en polylignes constituées de segments droits

(defun c:Arc2Seg (/ arc2pol pol2pol seg del org ss n ent elst)

 ;; Retourne la liste dxf de la polyligne (d'après un arc ou un cercle)
 (defun arc2pol
 (elst seg org / closed alpha delta cen elv rad lay nlst)
   (and (= (cdr (assoc 0 elst)) "CIRCLE") (setq closed T))
   (setq alpha	(if closed
	  (* pi 2)
	  (cdr (assoc 51 elst))
	)
  delta	(if closed
	  (/ alpha seg)
	  (/ (ang		)
  cen	(cdr (assoc 10 elst))
  elv	(caddr cen)
  cen	(list (car cen) (cadr cen))
  rad	(cdr (assoc 40 elst))
  lay	(if org
	  (assoc 8 elst)
	  (cons 8 (getvar "CLAYER"))
	)
  nlst	(vl-remove-if-not
	  (function (lambda (x) (member (car x) '(210 -3))))
	  elst
	)
  nlst	(cons (cons 10 (polar cen alpha rad)) nlst)
   )
   (repeat (if	closed
      (1- seg)
      seg
    )
     (setq
nlst (cons (cons 10
		 (polar cen (setq alpha (- alpha delta)) rad)
	   )
	   nlst
     )
     )
   )
   (setq nlst
   (cons '(0 . "LWPOLYLINE")
	 (cons '(100 . "AcDbEntity")
	       (cons (cons 410 (getvar "CTAB"))
		     (cons lay
			   (cons '(100 . "AcDbPolyline")
				 (cons (cons 90
					     (if closed
					       seg
					       (1+ seg)
					     )
				       )
				       (cons (cons 70
						   (if closed
						     1
						     0
						   )
					     )
					     (cons (cons 38 elv) nlst)
				       )
				 )
			   )
		     )
	       )
	 )
   )
   )
 )

 ;; Retourne la liste dxf de la polyligne modifiée (d'après une polyligne)
 (defun pol2pol (elst	seg   org   /	  cnt	closed	    nlst  p0
	  p1	p2    bu    larg  inc	bdata delta cen	  rad
	  alpha	n
	 )
   (setq closed (logand 1 (cdr (assoc 70 elst)))
  cnt	 0
   )
   (and (= closed 1) (setq p0 (cdr (assoc 10 elst))))
   (while elst
     (if (= (caar elst) 10)
(progn
  (setq	p1 (cdar elst)
	p2 (cdr (assoc 10 (cdr elst)))
	bu (cdr (assoc 42 elst))
  )
  (if (or (= 0 bu)
	  (and (zerop closed) (null p2))
      )
    (setq nlst (cons (cadddr elst)
		     (cons (caddr elst)
			   (cons (cadr elst)
				 (cons (car elst) nlst)
			   )
		     )
	       )
	  elst (cddddr elst)
    )
    (progn
      (and (not p2) (= closed 1) (setq p2 p0))
      (setq larg  (cdr (assoc 40 elst))
	    inc	  (/ (- (cdr (assoc 41 elst)) larg) seg)
	    bdata (BulgeData bu p1 p2)
	    delta (/ (car bdata) seg)
	    rad	  (abs (cadr bdata))
	    cen	  (caddr bdata)
	    alpha (angle cen p1)
	    n	  0
	    cnt	  (+ cnt seg -1)
      )
      (while (		(setq nlst (cons
		     (cons 10
			   (polar cen
				  (+ alpha (* delta n))
				  rad
			   )
		     )
		     nlst
		   )
	      nlst (cons (cons 40 larg) nlst)
	      nlst (cons (cons 41 (setq larg (+ larg inc))) nlst)
	      nlst (cons '(42 . 0.0) nlst)
	      n	   (1+ n)
	)
      )
      (setq elst (cddddr elst))
    )
  )
)
(setq nlst (cons (car elst) nlst)
      elst (cdr elst)
)
     )
   )
   (or	org
(setq nlst (subst (cons 8 (getvar "CLAYER")) (assoc 8 nlst) nlst))
   )
   ((lambda (dxf90)
      (subst (cons 90 (+ (cdr dxf90) cnt))
      dxf90
      (reverse (subst '(42 . 0.0) (assoc 42 nlst) nlst))
      )
    )
     (assoc 90 nlst)
   )
 )

 ;; Fonction principale

 (or (getenv "SegmentsNumberPerCircle")
     (setenv "SegmentsNumberPerCircle" "64")
 )
 (initget 6)
 (if
   (setq seg (getint
	(strcat	"\nNombre de segments par arc 			(getenv "SegmentsNumberPerCircle")
		">: "
	)
      )
   )
    (setenv "SegmentsNumberPerCircle" (itoa seg))
    (setq seg (atoi (getenv "SegmentsNumberPerCircle")))
 )
 (initget "Oui Non")
 (if (= "Oui"
 (getkword "\nEffacer les objets source [Oui/Non] ? [b]: ")
     )
   (setq del T)
 )
 (initget "Courant Origine")
 (if (= "Origine"
 (getkword
   "\nCalque des nouveaux objets [Courant/Origine] ? [b]: "
 )
     )
   (setq org T)
 )
 (prompt
   "\nSélectionner les objets à traiter ou [b]."
 )
 (and
   (or	(setq ss (ssget '((0 . "ARC,CIRCLE,LWPOLYLINE"))))
(setq ss (ssget "_X" '((0 . "ARC,CIRCLE,LWPOLYLINE"))))
   )
   (setq n 0)
   (while (setq ent (ssname ss n))
     (setq elst (entget ent '("*")))
     (if (= (cdr (assoc 0 elst)) "LWPOLYLINE")
((if del
   entmod
   entmake
 )	   (pol2pol elst seg org)
)
(progn
  (entmake (arc2pol elst seg org))
  (and del (entdel ent))
)
     )
     (setq n (1+ n))
   )
 )
 (princ)
)


;; BulgeData
;; Retourne les données d'un polyarc (angle rayon centre)
(defun BulgeData (bu p1 p2 / alpha rad cen)
 (setq	alpha (* 2 (atan bu))
rad   (/ (distance p1 p2)
	 (* 2 (sin alpha))
      )
cen   (polar p1
	     (+ (angle p1 p2) (- (/ pi 2) alpha))
	     rad
      )
 )
 (list (* alpha 2.0) rad cen)
)

;;; Ang;;; Retourne l'angle, à 2*k*pi près, compris entre 0 et 2*pi

(defun ang  (if (and (    ang
   (ang  )
) 

[lecrabe]

 

Hello Gilles

 

Qq tests rapides sous MAP 2006 : cela semble OK (Cercles & Polylignes) sauf pour les arcs !

 

qui se reconstruisent soit comme des cercles, soit se reconstruisent en miroir ! :o

 

Tests à approfondir sous 2008/2009 , je te tiens au courant ...

 

Merci, Le Decapode (qui triture ses arcs et cercles)

 

[lecrabe]

 

Hello

 

Le comportement semble légèrement différent avec MAP 2009 :

Cercles et Polylignes semblent OK

 

Arcs qui se transforment en cercles ou miroir !! :casstet:

(pas tout à fait de la même façon)

 

Cela est peut être lié au sens de construction des arcs

et/ou au fait qu'ils dépassent les 180 degrés (pas sur du tout)

 

Je dois approfondir ce problème des Arcs simples !!!

Alors que tout semble OK sur les polyarcs ! Etonnant !!

 

Le Decapode "tétu"

 

[(gile)]

Oupss !!!

 

Je suis un bien piètre testeur, je n'avais pas essayé avec des arcs de plus de 180° :P

 

C'est réparé, il suffisait d'utiliser ang

[lecrabe]

 

Hello

 

Test ultra-rapide sous MAP 2006, les Arcs sont OK ! :) :D :cool:

 

Il faudra que j'approfondisse un peu plus ... ;)

 

surtout au niveau des XDATAs ...

mais bon c sans doute BETON la recopie des XDATAs éventuels ???

 

D'autrepart, je n'ai rien testé si il y a des variations de largeurs physiques

dans la polyligne sur les segments et/ou arcs ??

 

Ca ne gène pas ta routine lors de la reconstruction des segments par rapport à un arc

qui a une largeur physique NON NULLE ?

 

Pour simplifier, si il y a une largeur physique au DEPART de l'arc,

SVP tu gardes cette largeur pour les N segments générés

(On se fout d'une éventuele autre largeur physique en FIN d'Arc)

 

Mille mercis Gilles, Le Decapode

 

[(gile)]

Pour les XDatas, soit je copie tout dans la nouvelle entité soit, dans le cas des polylignes avec suppression, je ne fais que modifier les sommets de la polyligne.

 

J'ai peaufiné le traitement des largeurs, si la largeur de départ et la largeur de fin diffèrent celle des segments changera aussi proportionnellement.

 

http://img517.imageshack.us/img517/69/arc2segwr0.png

[lecrabe]

 

Hello Gilles

 

Que dire ? Comme d'habitude, ta routine est TIP-TOP !!! :) :D

 

Etant un peu perfectionniste, SVP je te sollicite encore pour ajouter une autre question (non demandée dans le CDC original, SORRY !) au départ de la routine :

 

Voulez vous créer les objets sur le calque courant (Défaut)

ou bien sur le calque d'origine de chaque entité ?

 

Ainsi je pense que la routine sera "parfaite" :cool:

 

SVP si tu peux la publier et la renvoyer aussi par MP, je serais "comblé" temporairement ...

 

Encore Merci, Bon WE, Le Decapode "Linéarisateur suprème" grâce à Gilles

 

 

[(gile)]

Voilà, Patrice, c'est fait, le code est modifié.