Ac2pg.lsp et AutoCAD MAP

[fabcad]

Bonjour Gilles,

 

J'utilise tous les jours votre fonction de transformation et elle rend un très grand service dans le monde du SIG ou les cercles sont à éviter.

 

Ma requête aujourd'hui serait la possibilité d'ajouter à l'objet polyligne les Données d'Objets issus de l'arc ou cercle d'origine.

 

Merci d'avance,

 

Fabcad

 

[lecrabe]

 

Hello Fab

 

J'essaye de convaincre Gilles "tous les jours" de faire du MAP 2009 :) :D

 

En espérant, Le Decapode

 

[(gile)]

Salut Fabcad,

 

Utilises-tu cette version ? Les données étendues sont copiées dans la polyligne créée.

 

lecrabe,

 

Je n'ai pas encore eu le temps d'essayer d'installer la version d'évaluation que tu m'as envoyé...

[fabcad]

Merci Gilles la fonction Arc2Seg est beaucoup mieux que sa base ac2pg, mais je souhaiterais comme la fonction mapcoup.lsp de lecrabe d'intégrer la sous fonction COPY_OD.LSP afin de copier les données d'objets sur les objets polylignes issues des arcs et des cercles.

 

Lecrabe sera fou de joie si je ne m'abuse!!!!!!!!!

 

Merci d'avance,

 

Il faudrait que tu rajoutes Arc2Seg modifiée sur ta page dans la liste des fonctions disponibles.

 

Fabcad

 

[(gile)]

J'ai ajouté un appel à copy_data sous condition que les routines ade_odgettables, ade_odrecordqty, ade_oddelrecord, ade_odtabledefn, ade_odgetfield, ade_odaddrecord et copy_data soient chargées.

 

Merci de me dire si ça fonctionne.

 

;;; ARC2SEG (gile)
;;; Transforme les arcs, cercles et polyarcs en polylignes constituées de segments droits
;;; Les Xdatas sont copiées dans les nouveaux objet ainsi que les données d'objet MAP
;;; (copy_data.lsp doit être chargée)

(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] ? : ")
     )
   (setq del T)
 )
 (initget "Courant Origine")
 (if (= "Origine"
 (getkword
   "\nCalque des nouveaux objets [Courant/Origine] ? : "
 )
     )
   (setq org T)
 )
 (prompt
   "\nSélectionner les objets à traiter ou ."
 )
 (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 (pol2pol elst seg org))
  (progn
    (entmake (pol2pol elst seg org))
    (and
      ade_odgettables
      ade_odrecordqty
      ade_oddelrecord
      ade_odtabledefn
      ade_odgetfield
      ade_odaddrecord
             copy_data
      (copy_data ent (entlast) nil)
    )
  )
)
(progn
  (entmake (arc2pol elst seg org))
  (and
    ade_odgettables
    ade_odrecordqty
    ade_oddelrecord
    ade_odtabledefn
    ade_odgetfield
    ade_odaddrecord
           copy_data
    (copy_data ent (entlast) nil)
  )
  (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  )
)

[fabcad]

Merci (Gile),

 

Ca fonctionne sur MAP 2009 et je me suis permis de t'envoyer à ton adresse le fichier modifié avec l'ajout en tête du fichier COPY_OD.lsp.

 

Merci encore et Bon week-end

[(gile)]

Merci Fabrice.

[lecrabe]

 

Hello Gilles et Fab

 

Je viens de tester sur MAP 3D 2006, ca fonctionne bien ! :) :D

 

Encore merci à Gilles qui developpe pour MAP sans avoir MAP : la classe !! :P

 

Mille merci, Le Decapode

 

[lecrabe]

 

ReHello

 

Rappel: La routine "COPY_OD.lsp" se trouve dans le catalogue

de MAP et sans doute aussi dans celui de CIVIL ... :)

 

Le Decapode