Congé sur une polyligne contenant des arcs

[Titifonky]

Bonjour,

 

Je me heurte à une petit pb et ça fait mal !!! :blink:

Comme explicité dans le titre, j'essaye de faire des congés sur une polyligne contenant des arcs. La commande RACCORD ne propose pas cette fonctionnalité et renvoie un beau message d'erreur.

 

J'ai plusieurs dizaine de milliers de polyligne à traiter, je ne me vois pas le faire à la main. Avez-vous déjà été confronté à ce pb et avez-vous une solution lisp ?

 

J'ai déjà commencé à developper une solution mais ça bug un peu dans tous les sens, le resultat est assez aléatoire.

 

Une idée ?

 

Merci.

[bonuscad]

Bonjour,

 

J'ai plusieurs dizaine de milliers de polyligne à traiter

En effet "ça fait mal" :wacko:

 

Surtout que je ne vois pas comment palier à cette insuffisance de RACCORD.

Je pense que le problème dans ce cas précis et de déterminer les points de sélection qui détermine le sens du raccord.

On le voit avec les éléments décomposés en LIGNE, ARC ou le raccord devient possible mais ou les points de sélection déterminent le raccord à mettre en place: arc complémentaire ou pas.

 

Tu as peut être possibilité d'appréhender le problème autrement, mais pour cela il serait bien d'avoir un exemple concret de la situation existante (quelques objets) et ce que tu voudrais obtenir au final.

 

J'ai déjà commencé à developper une solution

Tu pourrais aussi nous montrer cela !

[didier]

coucou

 

je dois mal comprendre car je ne vois pas ce qui interdit de faire RACCORD sur des polylignes

 

tu nous fait un exemple, s'il te plaît.

 

amicalement

[Titifonky]

coucou

 

je dois mal comprendre car je ne vois pas ce qui interdit de faire RACCORD sur des polylignes

 

tu nous fait un exemple, s'il te plaît.

 

amicalement

@Didier

Bien sur,

 

Creer une polyligne contenant des arcs, creer un raccord entre deux segements d'arc.

Autocad ne veux pas.

Et il répond l'insolent : Impossible de raccorder les segments arcs d'une polyligne.

Il faut décomposer la polyligne, faire le raccord, puis la recréer.

 

Sinon, je crois que j'ai trouvé une solution avec un peu de calcul. Pas encore eu le temps de la tester. Je vais voir ça se we.

 

Voici mon pseudo-code :

 

Une petite illustration

 

 

Je décale la polyligne de base de la valeur d' un rayon du raccord souhaité de chaque coté. Courbe magenta et courbe bleu

Je boucle sur les sommets des deux polylignes ainsi crée et je teste si le rayon jaune partant du sommet A jusqu'au centre c1 de l'arc coupe le segment d'arc 1 et si le rayon vert du sommet A jusqu'au centre c2 de l'arc coupe le segment 2. Si c'est le cas, c'est le bon coté et je récupère le centre de mon arc, le point A, et les points de départ et d'arrivée de mon arc. Sinon, c'est le point B.

Je dessine une nouvelle polyligne avec mes nouveaux points.

A voir comment je peux implémenter ça.

 

Je cherche une routine qui renvoie les infos d'un segment de polyligne, arc ou ligne, en donnant simplement le no du segment.

[bonuscad]

Est ce que tes millier de polylignes ont toutes cette forme (sans tenir compte de la rotation ou de l'échelle)?

 

Si oui, on pourrait envisager de passer temporairement par un bloc qui contiendrait les modifs de raccordement. Remplacer toute les polylignes sélectionnées (1er point = pt insertion) par ce bloc décomposé en insertion en récupérant l'orientation et l'échelle du 1er segment.

 

Autrement j'avais répondu à ce besoin qui est approchant.

Si ça peut t'aider...

[Titifonky]

Bon, après avoir un peu galéré et m'être dispersé, j'ai sorti un truc qui fonctionne, un peu à l'arrache.

 

Je l'ai testé sur 200000 entité, ca prend un peu de temps mais ça passe sans bug.

 

Le fonctionnement est simple :

Decomposition de la polyligne

Raccord des différents segments avec la commande Raccord

Convertion des différents segments en une nouvelle polyligne

 

(defun c:tst ()
 (setvar "FILLETRAD" (getdist "Rayon de raccord"))
 (Raccorder_Polyligne
   (car (entsel "Selectionnez la polyligne à raccorder"))
   (getvar "FILLETRAD")
 )
)

(defun Raccorder_Polyligne (ent	   rayon  /	 data	pts    enttmp ferme
		    lst	   lstPl  lent	 seg1	seg2   ptcomm pt1
		    pt2	   deriv1 deriv2 ss
		   )
 ;; Nettoyage de la polyligne
 ;; On supprime le dernier sommet si celui ci est superposé avec le premier
 ;; et on la déclare fermée
 (and (setq data (entget ent)
     pts  (dxf 10 data)
      )
      (and (= (cdr (assoc 0 data)) "LWPOLYLINE")
    (apply 'and
	   (mapcar (function (lambda (x1 x2) (equal x1 x2 1e-9)))
		   (car pts)
		   (last pts)
	   )
    )
      )
      (setq data (reverse data)
     data (remove-ele (assoc 10 data) data)
     data (remove-ele (assoc 40 data) data)
     data (remove-ele (assoc 41 data) data)
     data (remove-ele (assoc 42 data) data)
     data (reverse data)
     data (subst (cons 70 1) (assoc 70 data) data)
      )
      (entmod data)
 )

 ;; Si elle est fermée, ok
 ;; Si elle n'est pas fermé mais qu'elle à plus de deux sommets, ok
 (if (or (= (cdr (assoc 70 data)) 1) (> (length (dxf 10 (entget ent))) 2))
   (progn
     ;; Pour éviter d'avoir des pb de raccord
     ;; On décale la polyligne dans les deux sens.
     ;; Cela permet de supprimer les segments qui disparaitront lors du raccord
     (setq enttmp (Courbe-Decaler ent rayon nil))

     (entdel ent)
     (setq ent (Courbe-Decaler enttmp (* 2.0 rayon) t))
     (entdel enttmp)
     (setq enttmp (Courbe-Decaler ent rayon nil))
     (entdel ent)

     (setq ent	  enttmp
    data  (entget ent)
    ferme (= (cdr (assoc 70 data)) 1)
     )
     (setq lent (entlast))
     (command "_explode" ent)
     (setq lent (entnext lent))
     (while lent
(setq lst  (cons lent lst)
      lent (entnext lent)
)
     )
     (setq lst	  (reverse lst)
    lstPl lst
     )
     (mapcar
(function
  (lambda (seg1 seg2)
    ;; On recherche le point 
    (setq ptcomm (car (common-fuzz
			(Courbe-PtDepartPtArrive seg1)
			(Courbe-PtDepartPtArrive seg2)
			1e-4
		      )
		 )
	  pt1	 (Courbe-PointLePlusProche seg1 ptcomm)
	  pt2	 (Courbe-PointLePlusProche seg2 ptcomm)
	  deriv1 (Courbe-Derivee1
		   seg1
		   (Courbe-ParamAuPoint seg1 pt1)
		 )
	  deriv2 (Courbe-Derivee1
		   seg2
		   (Courbe-ParamAuPoint seg2 pt2)
		 )
    )
    (if	(not (colinear deriv1 deriv2 1e-5))
      (progn
	(setq pt1 (Courbe-PointALaDistance
		    seg1
		    0.1
		    (Courbe-Position seg1 pt1)
		  )
	      pt2 (Courbe-PointALaDistance
		    seg2
		    0.1
		    (Courbe-Position seg2 pt2)
		  )
	)
	(if (not (or (zerop (apply '+ pt1)) (zerop (apply '+ pt2))))
	  (progn
	    (setq ent (entlast))
	    (command "_fillet" (list seg1 pt1) (list seg2 pt2))
	    (if	(not (equal ent (entlast)))
	      (setq lstPl (cons (entlast) lstPl))
	    )
	  )
	)
      )
    )
  )
)
lst
(if ferme
  (rot1 lst)
  (cdr lst)
)
     )

     (setq ss (ssadd))

     (mapcar (function (lambda (x) (ssadd x ss))) lstPl)

     (setvar "PEDITACCEPT" 1)
     (command "pedit" "m" ss "")
     (command "j" 0.1 "")

   )
 )
 (princ)
)


;;; =================== Sous-fonction ======================

;; DXF
;; Retourne la liste des données associé au code dxf
(defun dxf (code alst)
 (mapcar 'cdr (massoc code alst))
)


;; MASSOC
;; assoc multiple, retourne toutes les clef key
(defun massoc (key alst)
 (apply 'append
 (mapcar '(lambda (x)
	    (if	(= (car x) key)
	      (list x)
	    )
	  )
	 alst
 )
 )
)


;; REMOVE-ELE
;; Retourne la liste sans la première occurence de l'expression

(defun remove-ele (ele lst)
 (if (equal ele (car lst))
   (cdr lst)
   (cons (car lst) (remove-ele ele (cdr lst)))
 )
)

;; COMMON-FUZZ
;; Comme COMMON avec une tolérance dans la comparaison

(defun common-fuzz (l1 l2 fuzz)
 (if l1
   (if	(member-fuzz (car l1) l2 fuzz)
     (cons (car l1) (common-fuzz (cdr l1) l2 fuzz))
     (common-fuzz (cdr l1) l2 fuzz)
   )
 )
)

;; MEMBER-FUZZ
;; Comme MEMBER avec une tolérance dans la comparaison

(defun member-fuzz (expr lst fuzz)
 (while (and lst (not (equal (car lst) expr fuzz)))
   (setq lst (cdr lst))
 )
 lst
)


;;; ROT1 - mettre le premier élément à la fin, version simple,
;;;        (rotation par un)
(defun rot1 (lst) (append (cdr lst) (list (car lst))))

;; COLINEAR

(defun colinear	(v1 v2 fuzz)
 (cond
   ((or (and (equal (car v1) 0 fuzz) (equal (car v2) 0 fuzz))
 (and (equal (cadr v1) 0 fuzz) (equal (cadr v2) 0 fuzz))
    )
    t
   )
   ((or (equal (car v1) 0 fuzz)
 (equal (car v2) 0 fuzz)
    )
    nil
   )
   (t
    (equal (/ (cadr v1) (car v1)) (/ (cadr v2) (car v2)) fuzz)
   )
 )
)

;; V2D
;; Retourne un vecteur 2D
;;
;; Arguments : un vecteur
(defun v2d (l)
 (mapcar '+ (append l '(0.0 0.0)) '(0.0 0.0))
)


;;; Decaler une courbe
(defun Courbe-Decaler (Courbe Dist Cote)
 (setq	Dist (*	Dist
	(if Cote
	  1
	  -1
	)
     )
 )
 (vl-catch-all-apply
   'vla-Offset
   (list (vlax-ename->vla-object Courbe) Dist)
 )
 (entlast)
)

;;; Renvoi le point de depart et d'arrivé
(defun Courbe-PtDepartPtArrive (Courbe)
 (list	(V2D
  (vlax-curve-getStartPoint (vlax-ename->vla-object Courbe))
)
(V2D
  (vlax-curve-getEndPoint (vlax-ename->vla-object Courbe))
)
 )
)

;;; Renvoi le coté sur lequel se situe un point
;;; début : T
;;; fin : nil

(defun Courbe-Position (Courbe Point)
 (if (> (Courbe-DistanceAuPoint
   Courbe
   (Courbe-PointLePlusProche Courbe Point)
   't
 )
 (* (Courbe-Longueur Courbe) 0.5)
     )
   'nil
   't
 )
)


;;; Renvoi le point le plus proche
(defun Courbe-PointLePlusProche	(Courbe lPoint)
 (V2D (vlax-curve-getClosestPointTo
 (vlax-ename->vla-object Courbe)
 lPoint
      )
 )
)

;;; Renvoi la longueur d'une courbe
(defun Courbe-Longueur (Courbe / prop vCourbe)
 (setq vCourbe (vlax-ename->vla-object Courbe))
 (- (vlax-curve-getDistAtParam
      vCourbe
      (vlax-curve-getEndParam vCourbe)
    )
    (vlax-curve-getDistAtParam
      vCourbe
      (vlax-curve-getStartParam vCourbe)
    )
 )
)

;;; Renvoi le parametre au point donnée
(defun Courbe-ParamAuPoint (Courbe Point)
 (vlax-curve-getParamAtPoint
   (vlax-ename->vla-object Courbe)
   Point
 )
)


;;; Renvoi la derivee 1 d'une courbe
(defun Courbe-Derivee1 (Courbe Param /)
 (V2D (vlax-curve-getFirstDeriv
 (vlax-ename->vla-object Courbe)
 Param
      )
 )
)

;;; Renvoi le point à la distance donnée à partir du debut ou de la fin
(defun Courbe-PointALaDistance (Courbe Dist Fin)
 (setq	Dist (if Fin
       Dist
       (- (Courbe-Longueur Courbe) Dist)
     )
 )
 (V2D (vlax-curve-getPointAtDist
 (vlax-ename->vla-object Courbe)
 Dist
      )
 )
)

;;; Renvoi la distance à un point donné à partir du debut ou de la fin
(defun Courbe-DistanceAuPoint (Courbe Point Fin / dist)
 (setq	dist (vlax-curve-getDistAtPoint
       (vlax-ename->vla-object Courbe)
       Point
     )
 )
 (if Fin
   dist
   (- (Courbe-Longueur Courbe) dist)
 )
)