polyligne

[sosun38]

Bonjour,

Volià, est-il possible de faire par un programme lisp la procédure suivante?

 

Ce qu'on a:

_deux polylignes P et Q qui peuvent-être des 2D, 3D.

_la polyligne P a pour sommets P1,P2,P3.....P(n-1),Pn.

_la polyligne Q a pour sommets Q1,Q2,Q3.....Qn-1),Qn.

_avec P1(Xp1,Yp1,Zp1) et Q1(xq1,Yq1,Zq1)......Pn(Xpn,Ypn,Zpn) et Qn(Xqn,Yqn,Zqn).

 

Ce qu"on doit obtenir:

_une polyligne M de sommets M1,M2,M3.......Mn.

_avec le sommet M1 comme milieu du segment [P1Q1].

_et si les polylignes P et Q sont des 2D alors la polyligne M serra une poly2D.

_et si les polylignes P et Q sont des 3D alors la polyligne M serra une poly3D.

 

Le programme commence par la selection des deux polylignes et fini par le tracé de la 3°polyligne tout en conservant les deux polylignes et en ayant le même sens que les deux.

 

Merci bien d'avance.

 

[Edité le 4/6/2008 par sosun38]

[(gile)]

Salut,

 

Voilà un exemple, peut-être un peu ardu pour débuter, mais le problème posé ne peut se résoudre simplement

 

L'utilisateur choisit 2 polylignes.

Si au moins une des deux poly est une poly 3d ou si 2 poly 2d n'ont pas le même normale, une poly 3d est créé.

Si les 2 poly 2d ont la même normale mais une élévation différente, une poly 2d est créée à l'élévation moyenne.

Si les 2 poly n'ont pas le même nombre de sommets, seuls les premiers sommets sont pris en compte à concurrence du nombre de sommets de la polyligne qui en compte le moins.

La polyligne créée prend les propriétés de la première polyligne sélectionnée.

Les arcs et largeurs éventuelles sont ignorées.

 

;;; POLYMID (gile)
;;; Crée une polyligne (3d ou lw) dont les sommets sont le milieu des sommets
;;; de deux polylignes sélectionnées (3d, 2d ou lw)

(defun c:polymid
      (/ *error* vertices pl1 pl2 pl3 typ1 typ2 pts1 pts2 pts3)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-Activedocument (vlax-get-acad-object)))
 )

 ;; redéfiniton de *error*
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;; retourne la liste des sommets d'une polyligne (coordonnées SCG)
 (defun vertices (pl / n pt lst)
   (and (= (type pl) 'ENAME)
 (setq pl (vlax-ename->vla-object pl))
   )
   (setq n 0)
   (while (setq pt (vlax-curve-getPointAtParam pl n))
     (setq n	(1+ n)
    lst	(cons pt lst)
     )
   )
   (if	(= (vla-get-Closed pl) :vlax-true)
     (reverse (cdr lst))
     (reverse lst)
   )
 )

 (if (and
(setq
  pl1 (car (entsel "\nsélectionnez la première polyligne: "))
)
(member	(setq typ1 (vla-get-ObjectName
		     (setq pl1 (vlax-ename->vla-object pl1))
		   )
	)
	'("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")
)
(setq
  pl2 (car (entsel "\nsélectionnez la deuxième polyligne: "))
)
(member	(setq typ2 (vla-get-ObjectName
		     (setq pl2 (vlax-ename->vla-object pl2))
		   )
	)
	'("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")
)
     )
   (progn
     (setq pts1  (vertices pl1)
    pts2  (vertices pl2)
    pts3  (mapcar
	    (function
	      (lambda (p1 p2)
		(mapcar
		  (function
		    (lambda (x1 x2)
		      (/ (+ x1 x2) 2)
		    )
		  )
		  p1
		  p2
		)
	      )
	    )
	    pts1
	    pts2
	  )
    space (vla-ObjectIDtoObject *acdoc* (vla-get-OwnerId pl1))
     )
     (vla-StartUndoMark *acdoc*)
     (if (or (= typ1 "AcDb3dPolyline")
      (= typ2 "AcDb3dPolyline")
      (not (equal (setq norm (vlax-get pl1 'Normal))
		  (vlax-get pl2 'Normal)
		  1e-9
	   )
      )
  )
(setq pl3 (vlax-invoke space 'add3dPoly (apply 'append pts3)))
(progn
  (setq	pl3
	 (vlax-invoke
	   space
	   'addLightWeightPolyline
	   (apply 'append
		  (mapcar
		    (function
		      (lambda (p)
			(setq p (trans p 0 norm))
			(list (car p) (cadr p))
		      )
		    )
		    pts3
		  )
	   )
	 )
  )
  (vla-put-Normal pl3 (vlax-3d-point norm))
  (vla-put-Elevation
    pl3
    (/ (+ (vla-get-Elevation pl1) (vla-get-Elevation pl2)) 2)
  )
)
     )
     (foreach prop '(Closed	      Color	      Layer
	      Linetype	      LinetypeGeneration
	      LinetypeScale   Lineweight      TrueColor
	     )
(if (and (vlax-property-available-p pl1 prop)
	 (vlax-property-available-p pl3 prop T)
    )
  (vlax-put-property pl3 prop (vlax-get-property pl1 prop))
)
     )
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

[sosun38]

MERCI BEAUCOUP...gile !!!!!!!

c'est d'enfer !!!!!!!!!!!!!!!!

 

sosun38.