Cercle en Polygone régulier

[lecrabe]

 

Hello

 

SVP j'aurais besoin d'une routine qui transforme une sélection de cercles en polygones réguliers AutoCAD (Polylignes closes en fait).

 

Question à poser : Nombre de cotés du polygone : xxx

 

Attention: si il y a des XDATAs d'AutoCAD ou des OBJECT DATA de MAP (ou CIVIL)

sur le cercle d'origine, il faut les copier sur le polygone résultant.

 

Les cercles ne sont pas effacés, on crée simplement N nouvels objets graphiques

à partir des N cercles sélectionnés sur le calque courant !

 

Les outils de nettoyage de dessins de MAP (ou CIVIL° ne me conviennent pas tout à fait,

car ils transforment les cercles en un magnifique POLYARC

mais je désire un polygone régulier (composés de segments)

et non pas 2 POLYARC de 180 degres (= idem ANNEAU)

 

Merci d'avance, Le Decapode

 

[(gile)]

Salut,

 

Voilà, ça devrait fonctionner quelque soit le SCO et l'élévation des cercles et le SCU courant.

Les XDatas sont copiées dans le polygone.

Pour les "ObjectDatas", je ne sais ni ce que c'est, ni comment les récupérer...

 

;;; C2PG (gile)
;;; Transforme les cercles sélectionnés en polygones.

(defun c:c2pg (/ space nb ss n dist nor pt lst pline xdatatype xdatavalue)
 (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*)
      )
 )
 (if (ssget '((0 . "CIRCLE")))
   (progn
     (initget 6)
     (or
     (setq nb (getint "\nEntrez le nombre de segments [b]: "))
     (setq nb 32)
     )
     (vla-StartUndoMark *acdoc*)
     (vlax-for	obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq dist (/ (vlax-curve-getDistAtParam
		obj
		(vlax-curve-getEndParam obj)
	      )
	      nb
	   )
      nor (vlax-get obj 'Normal)
      lst nil
      n	   0
)
(repeat	nb
  (setq
    lst
     (cons
       (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
       lst
     )
  )
)
(setq lst (apply 'append
		 (mapcar
		   '(lambda (x)
		      (setq x (trans x 0 nor))
		      (list (car x) (cadr x))
		    )
		   (reverse lst)
		 )
	  )
)
(setq pline (vlax-Invoke Space 'addLightweightPolyline lst))
(vla-put-Closed pline T)
(vla-put-Normal pline (vlax-3d-point nor))
(vla-put-Elevation pline (caddr (trans (vlax-curve-getStartPoint obj) 0 nor)))
(vla-getXData obj "" 'xdatatype 'xdatavalue)
(and xdatatype xdatavalue (vla-setXData pline xdatatype xdatavalue))
     )
     (vla-EndUndoMark *acdoc*)
     (vla-delete ss)
   )
 )
 (princ)
) 

[lecrabe]

 

Hello Gilles

 

Ta routine semble tout à fait OK, comme d'hab ! :)

Je l'ai testée sous MAP 2008 :D

 

Il me reste le problème des OD (Object Data) de MAP

que je ne peux transférer que "à la main" avec la routine "COPY_OD.lsp"

de MAP et ce UN par UN !!! = Galère :o

 

Merci quand même de ta rapidité et de ton efficacité habituelle

Le Decapode

 

[(gile)]

Si cette routine "COPY_OD.lsp" n'est pas protégée, on peut peut être la modifier ou l'intégrer pour traiter un jeu d sélection.

[lecrabe]

 

Hello Gilles

 

Je t'ai envoye la routine COPY_OD.lsp et aussi un DWG avec qq OD

sur ta messagerie perso ... :)

 

Encore merci, Le Decapode

 

[(gile)]

Re,

 

Il devrait suffire de rajouter l'expression suivante après (and xdatatype xdatavalue (vla-setXData pline xdatatype xdatavalue)

 

(and c:copy_od
copy_data
     (copy_data	(vlax-vla-object->ename obj)
		(vlax-vla-object->ename pline)
		nil
     )
) 

 

Je ne peux pas tester ces routines en appellent d'autres (ade_odgettables, ade_odrecordqty,ade_oddelrecord, ade_odtabledefn, ade_odgetfield, ade_odaddrecord,ade_odsetfield) qui sont sûrement chargées automatiquement sur MAP/CIVIL

[lecrabe]

 

Hello Gilles

 

Je viens de modifier ta routine en suivant tes instructions

et en ajoutant a la fin toute la routine "COPY_OD.lsp"

 

et ça marche !!! :) :D :cool:

 

Ce qui signifie que beaucoup de tes routines pourraient être modifiées

pour y inclure le "COPY_OD.lsp" PLUS bien sur les modifs nécessaires

pour transférer les éventuels OD de MAP (ou CIVIL) ;) ;)

 

C merveilleux, Le Grand Gilles a encore frappé !

et ce sans avoir MAP (ou CIVIL)

 

Le Decapode "frétillant" & heureux"