Un p\'tit challenge d\'été !?

bonuscad · le 16 juillet 2007

Bonjours à tous.

Je voulais réaliser un lisp un petit peu "fun", mais qui pourrais être aussi utile. (une sorte de type de ligne, mais invariable)

J'ai déjà commencé aujourd'hui et suis arrivé à un certain résultat.

Le mieux est de l'essayer pour vous rendre compte de ce que je veux faire. (appliquez le sur un rectangle)

J'en profite donc pour lancer un challenge (d'été), afin de l'améliorer et avoir un résultat correct pour toutes les LwPolylignes (arc).

Au départ je voulais pouvoir l'appliquer à tout les objets curvilignes, mais ça complique pas mal les choses.

Je pense que la partie (entmake) n'as pas besoin d'être reprise (sous réserve...)

C'est plutôt la liste l_42, que je réserve pour la suite pour essayer de mettre le motif courbé.

Celui-ci est pour l'instant traitée en segment droit. Le motif pourra être changé, on peut envisager un traitement de motif différent (losange, croix, insertion de segment non épais...)

Mais déjà pour la mise au point, on peut garder ce motif.

Donc pour ceux que l'idée interresse, les propositions sont attendues...et j'expliquerais les variables employées si vous ne comprenez pas à quoi elles servent.

NB: Les points d'appuis originaux doivent êtres conservés.

(defun c:lw2motif ( / ent obj_valx dxf_obj pt_first ep_lw d_inc pt_snd nb_vtx count l_pt lg_inc start_ep end_ep delta lg_vtx l_40 l_41 l_42)
(vl-load-com)
(while (not (setq ent (entsel "\nSelectionner un objet: "))))
(setq obj_vlax (vlax-ename->vla-object (car ent)) dxf_obj (entget (car ent)))
(cond
	((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
		(setq pt_first (vlax-curve-getStartPoint obj_vlax))
		(initget 71)
		(setq ep_lw (getdist pt_first "\nEpaisseur du symbole: "))
		(initget 71)
		(setq d_inc (getdist pt_first "\nLongueur du symbole: "))
		(setq
			pt_snd (vlax-curve-getPointAtParam obj_vlax 1)
			nb_vtx (fix (vlax-curve-getEndParam obj_vlax))
			count 0
			l_pt (list (cons 10 pt_first))
			l_40 (list (cons 40 ep_lw))
			l_41 (list (cons 41 0.0))
;				l_42 (list (cons 42 (vlax-invoke obj_vlax 'GetBulge count)))
			l_42 (list (cons 42 0.0))
			lg_inc 0.0
			start_ep ep_lw
			end_ep 0.0
			delta 0.0
		)
		(repeat nb_vtx
			(setq
				lg_inc (vlax-curve-getDistAtParam obj_vlax count)
				lg_vtx (vlax-curve-getDistAtParam obj_vlax (1+ count))
			)
			(while (< (+ lg_inc d_inc) lg_vtx)
				(if (< (+ lg_inc d_inc) lg_vtx)
					(setq
						start_ep (if (zerop delta) ep_lw end_ep)
						end_ep 0.0
						delta 0.0
					)
					(setq
						start_ep ep_lw
						delta (- lg_vtx lg_inc)
						end_ep (* (/ ep_lw d_inc) delta)
					)
				)
				(setq
					l_pt (cons (cons 10 (vlax-curve-getPointAtDist obj_vlax (setq lg_inc (+ lg_inc d_inc)))) l_pt)
					l_40 (cons (cons 40 start_ep) l_40)
					l_41 (cons (cons 41 end_ep) l_41)
;						l_42 (cons (cons 42 (vlax-invoke obj_vlax 'GetBulge count)) l_42)
					l_42 (cons (cons 42 0.0 )l_42)
				)
			)
			(setq
				count (1+ count)
				pt_first (vlax-curve-getPointAtParam obj_vlax count)
				pt_snd (vlax-curve-getPointAtParam obj_vlax (1+ count))
				l_pt (cons (cons 10 pt_first) l_pt)
				l_40 (cons (cons 40 start_ep) l_40)
				l_41 (cons (cons 41 end_ep) l_41)
;					l_42 (cons (cons 42 (vlax-invoke obj_vlax 'GetBulge count)) l_42)
				l_42 (cons (cons 42 0.0 )l_42)
			)
		)
		(setq
			l_pt (reverse l_pt)
			l_40 (reverse l_40)
			l_41 (reverse l_41)
			l_42 (reverse l_42)
		)
		(entmake
			(append
				(list
					(cons 0 "LWPOLYLINE")
					(cons 100 "AcDbEntity")
					(assoc 67 dxf_obj)
					(assoc 410 dxf_obj)
					(assoc 8 dxf_obj)
					(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
					(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
					(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
					(cons 100 "AcDbPolyline")
					(cons 90 (length l_pt))
					(cons 70
						(if (zerop (boole 1 (rem (cdr (assoc 70 dxf_obj)) 128) 1))
							(boole 1 (cdr (assoc 70 dxf_obj)) 128)
							(1+ (boole 1 (cdr (assoc 70 dxf_obj)) 128))
						)
					)
					(cons 38 (if (assoc 38 dxf_obj) (cdr (assoc 38 dxf_obj)) 0.0))
					(cons 39 (if (assoc 39 dxf_obj) (cdr (assoc 39 dxf_obj)) 0.0))
				)
				(apply 'append
					(mapcar
						'(lambda (x10 x40 x41 x42)
							(append (list x10 x40 x41 x42))
						)
						l_pt l_40 l_41 l_42
					)
				)
				(list (assoc 210 dxf_obj))
			)
		)
	)
	(T
		(princ "\nN'est pas une polyligne optimisée!")
	)
)
(princ)
)

(gile) · le 22 juillet 2007

Ce challenge ne semble pas bousculer les foules :exclam:

Je livre quand même mes devoirs de vacances.

Pour éviter de trop me laisser influencer, j'ai juste parcourru le code de Bonuscad et l'ai testé avant d'essayer de faire quelque chose de plus personnel.

Il y a donc quelques différences :

- l'utilisateur ne spécifie qu'une longueur approximative pour le motif.

- celle-ci est remplacée par la division juste de la longueur totale la plus proche

- la largeur du motif est calculée en multipliant cette longueur par un ratio (défaut : 1/3)

- les motifs peuvent être dessinés "à cheval" sur les sommets de la polyligne d'origine

- ils suivent la courbure des "polyarcs"

(defun c:lw2motif (/	  make-lst	ent    obj    pt     long
	   AcDoc  Space	 nor	len    ratio  larg   larg_d
	   long_d pa	 ind	clo    blg    seg    dis
	   nb	  long_f larg_f	p_lst  b_lst  w_lst  pline
	  )
 (vl-load-com)

 ;; Sous-routine pour la constitution des listes de sommets, de largeurs
 ;; et de bulges de la nouvelle polyligne
 (defun make-lst (pt l0 l1 b)
   (setq p_lst	(cons pt p_lst)
  w_lst	(cons (list ind l0 l1) w_lst)
   )
   (or (= blg 0) (setq b_lst (cons (cons ind b) b_lst)))
   (setq ind (1+ ind))
 )

 ;; Saisie des données
 (while (not
   (and	(setq ent (car (entsel)))
	(setq obj (vlax-ename->vla-object ent))
	(= (vla-get-objectName obj) "AcDbPolyline")
   )
 )
 )
 (setq pt (vlax-curve-getStartPoint obj))
 (initget 7)
 (setq
   long (getdist pt
	  "\nSpécifiez la longueur approximative du motif: "
 )
 )
 (initget 6)
 (or (setq ratio
     (getreal
       "\nSpécifiez le ratio largeur/longueur du motif : "
     )
     )
     (setq ratio (/ 1.0 3.0))
 )

 ;; Initialisation
 (setq	AcDoc  (vla-get-ActiveDocument (vlax-get-acad-object))
Space  (if (= (getvar "CVPORT") 1)
	 (vla-get-PaperSpace AcDoc)
	 (vla-get-ModelSpace AcDoc)
       )
nor    (vlax-get obj 'Normal)
len    (vla-get-Length obj)
long   (/ len (fix (+ (/ len long) 0.5)))
larg   (* ratio long)
larg_d larg
long_d long
pa     0
ind    0
 )
 (and (= (vla-get-Closed obj) :vlax-true) (setq clo T))

 ;; Boucle sur chaque segment de la polyligne d'origine
 (repeat (fix (vlax-curve-getEndParam obj))
   (setq blg (vla-GetBulge obj pa)
  seg (- (vlax-curve-getDistAtParam obj (1+ pa))
	 (vlax-curve-getDistAtParam obj pa)
      )
  dis (- seg long_d)
   )

   ;; Si le segment est plus court que la longueur de motif à dessiner
   (if	(minusp dis)

     ;; Alors
     (progn
(setq larg_f (* ratio (- long_d seg)))
(make-lst (vlax-curve-getPointAtParam obj pa)
	  larg_d
	  larg_f
	  blg
)
(setq long_d (- dis)
      larg_d larg_f
      pa     (1+ pa)
)
     )

     ;; Sinon
     (progn
(setq nb     (fix (/ dis long))
      long_f (rem dis long)
)

;; Premier motif
(make-lst (vlax-curve-getPointAtParam obj pa)
	  larg_d
	  0.0
	  (k*bulge blg (/ long_d seg))
)

;; Motifs suivants
(repeat	nb
  (make-lst (vlax-curve-getPointAtDist obj (* long (- ind pa)))
	    larg
	    0.0
	    (k*bulge blg (/ long seg))
  )
)

;; Dernier motif
(if (zerop long_f)
  (setq	long_d long
	larg_f 0.0
	larg_d larg
  )
  (progn
    (setq long_d (- long long_f)
	  larg_f (* ratio long_d)
	  larg_d larg_f
    )
    (make-lst (vlax-curve-getPointAtDist obj (* long (- ind pa)))
	      larg
	      larg_f
	      (k*bulge blg (/ long_f seg))
    )
  )
)
(setq pa (1+ pa))
     )
   )
 )

 ;; Création de la polyligne
 (or clo
     (setq p_lst (cons (vlax-curve-getEndPoint obj) p_lst))
 )
 (setq	pline (vlax-invoke
	Space
	'addLightWeightPolyline
	(apply 'append
	       (mapcar '(lambda	(p)
			  (setq p (trans p 0 nor))
			  (list (car p) (cadr p))
			)
		       (reverse p_lst)
	       )
	)
      )
 )
 (and clo (vla-put-closed pline :vlax-true))
 (mapcar '(lambda (x) (vla-SetBulge pline (car x) (cdr x)))
  b_lst
 )
 (mapcar '(lambda (x) (vla-Setwidth pline (car x) (cadr x) (caddr x)))
  w_lst
 )
 (vla-put-Normal pline (vlax-3d-point nor))
 (vla-put-Elevation pline (vla-get-elevation obj))
 (princ)
)

;; K*BULGE
;; Retourne le bulge proportionnel au bulge de référence
;; Arguments :
;; b : le bulge
;; k : le rapport de proportion (entre les angles ou les longueurs d'arcs)

(defun k*bulge (b k / a)
 (setq a (atan b))
 (/ (sin (* k a)) (cos (* k a)))
)

[Edité le 24/7/2007 par (gile)]

(gile) · le 23 juillet 2007

Quelques corrections/amméliorations au LISP ci-dessus :

- correction du calcul des bulges (routine k*bulge)

- allègement du traitement des polylignes ouvertes/fermées

(gile) · le 24 juillet 2007

Coucou, y'a que moi qui joue ? :exclam:

Une autre version, qui fonctionne comme celle de bonuscad (les arcs en plus), à savoir, le dernier motif de chaque segment de la polyligne d'origine est "raccourci" en fonction de la distance restante.

(defun c:lw2motif (/	  ent	 obj	pt     long   larg   AcDoc
	   Space  nor	 elv	pa     ind    clo    blg
	   seg	  nb	 rest	dist   p_lst  b_lst  pline
	  )
 (vl-load-com)

 ;; Constitution des listes de points et de bulges de la nouvelle polyligne
 (defun make-lst (b)
   (setq p_lst (cons (vlax-curve-getPointAtDist obj dist) p_lst))
   (or (= blg 0) (setq b_lst (cons (cons ind b) b_lst)))
   (setq ind  (1+ ind)
  dist (+ dist long)
   )
 )

 ;; Saisie des données
 (while (not
   (and	(setq ent (car (entsel)))
	(setq obj (vlax-ename->vla-object ent))
	(= (vla-get-objectName obj) "AcDbPolyline")
   )
 )
 )
 (setq pt (vlax-curve-getStartPoint obj))
 (initget 1)
 (setq long (getdist pt "\nspécifiez la longueur du motif: "))
 (initget 1)
 (setq larg (getdist pt "\nspécifiez la largeur du motif: "))

 ;; initialisation
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
nor   (vlax-get obj 'Normal)
pa    0
ind   0
 )
 (and (= (vla-get-Closed obj) :vlax-true) (setq clo T))

 ;; Boucle sur chaque segment de la polyligne d'origine
 (repeat (fix (vlax-curve-getEndParam obj))
   (setq blg  (vla-GetBulge obj pa)
  seg  (- (vlax-curve-getDistAtParam obj (1+ pa))
	  (vlax-curve-getDistAtParam obj pa)
       )
  nb   (fix (/ seg long))
  rest (rem seg long)
  dist (vlax-curve-getDistAtParam obj pa)
   )

   ;; Motifs réguliers
   (repeat nb
     (k*bulge blg (/ long seg))
     (make-lst (k*bulge blg (/ long seg)))
   )

   ;; Dernier motif
   (if	(      (make-lst (k*bulge blg (/ rest seg)))
   )
   (setq pa (1+ pa))
 )

 ;; Création de la polyligne
 (or clo
     (setq p_lst (cons (vlax-curve-getEndPoint obj) p_lst))
 )
 (setq	pline (vlax-invoke
	Space
	'addLightWeightPolyline
	(apply 'append
	       (mapcar '(lambda	(p)
			  (setq p (trans p 0 nor))
			  (list (car p) (cadr p))
			)
		       (reverse p_lst)
	       )
	)
      )
 )
 (and clo (vla-put-closed pline :vlax-true))
 (mapcar '(lambda (x) (vla-SetBulge pline (car x) (cdr x)))
  b_lst
 )
 (repeat (setq ind (fix (vlax-curve-getEndParam pline)))
   (vla-SetWidth pline (setq ind (1- ind)) larg 0.0)
 )
 (vla-put-Normal pline (vlax-3d-point nor))
 (vla-put-Elevation pline (vla-get-elevation obj))
 (princ)
)


;; K*BULGE
;; Retourne le bulge proportionnel au bulge de référence
;; Arguments :
;; b : le bulge
;; k : le rapport de proportion (entre les angles ou les longueurs d'arcs)

(defun k*bulge (b k / a)
 (setq a (atan b))
 (/ (sin (* k a)) (cos (* k a)))
)

bonuscad · le 24 juillet 2007

Bravo pour ta résolution dans les segments courbes, je n'y étais pas encore parvenu.

Pour l'instant je te laisse jouer seul, car je déconnecte un peu pour mes congés...

Mais je ne laisse pas tomber, je regarderais ça plus tard, il y aura peut être d'ici là d'autres propositions intéressantes.

NB: Ta première proposition modifié n'accepte pas la validation de (1/3) depuis la souris (division par zéro), seulement au clavier par un "Entrée". Un détail .... ;)

Connexion

Un p\'tit challenge d\'été !?

Messages recommandés

bonuscad

(gile)

(gile)

(gile)

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante