Création de linéaires de voies

[fabcad]

Bonjour j'ai commencé une routine de création de linéaires de voies mais je butte sur la boucle de la commande polyligne pour créer les sommets dans la fonction maitre CR_CENTERLINES.

Cette dernière fonctionne avec la sous-routine new-point permet en sélectionnant les points de calculer le milieu du nouveau point du sommet de la polyligne.

Merci pour vos infos,

 

Voici le code en état :

(defun new-point (/ Obj-pt-1 Obj-pt-2 coord-Obj-pt-1 coord-Obj-pt-2 ang-2pts moitié-dist new-pt new-pt-string)

;select Obj-pt-1

(while (= (setq Obj-pt-1 (nentsel "\n Choisir le 1er objet point : ")) nil))

;select Obj-pt-2

(while (= (setq Obj-pt-2 (nentsel "\n Choisir le 2eme objet point : ")) nil))

 

(setq coord-Obj-pt-1 (cdr (assoc 10 (entget (car Obj-pt-1)))))

(setq coord-Obj-pt-2 (cdr (assoc 10 (entget (car Obj-pt-2)))))

 

;(command "ligne" coord-Obj-pt-1 coord-Obj-pt-2 "")

 

(setq ang-2pts (angle coord-Obj-pt-1 coord-Obj-pt-2))

(setq moitié-dist (/ (distance coord-Obj-pt-1 coord-Obj-pt-2) 2))

(setq new-pt (polar coord-Obj-pt-1 ang-2pts moitié-dist))

 

;(setq new-pt-string (strcat (rtos (car new-pt) 2 2) "," (rtos (cadr new-pt) 2 2)))

 

);fin defun new-point

 

(defun c:CR_CENTERLINES (/ epais-poly mode-acc chx stp)

 

(setq mode-acc (getvar "osmode"))

(setq epais-poly (getvar "PLINEWID"))

 

(setvar "cmdecho" 0)

(setvar "osmode" 0)

 

(setq pt (getpoint "\n Point de depart ") p1 pt)

 

(command "polylign" pt "la" 1 1)

 

(while (/= command nil)

(progn

(setq pt (new-point))

(command pt)

); fin progn

(setq p1 pt)

); fin while

(command "")

 

(prompt "\n---COPYRIGHT Mars 2007 par Fabrice DEMIEL---")

 

(setvar "osmode" mode-acc)

(setvar "PLINEWID" epais-poly)

 

(princ)

); fin defun c:CR_CENTERLINES

 

 

[bonuscad]

Une autre façon de faire peut être?

 

(defun c:middle_line ( / )
(command "_.pline"
	(while (not (zerop (getvar "cmdactive")))
		(command "_none"
			((lambda ( / p1 p2)
			(princ "\nPoint milieu entre ")
			(setq p1 (getpoint "premier point : "))
			(if p1 (progn (initget 33) (setq p2 (getpoint p1 "\nsecond point : "))))
			(if (and p1 p2)
				(setq p
					(list
						(/ (+ (car p1) (car p2)) 2)
       						(/ (+ (cadr p1) (cadr p2)) 2)
       						(/ (+ (caddr p1) (caddr p2)) 2)
					)
				)
			)
			))
		)
	)
)
(princ)
)

 

A mettre à ta sauce...

[(gile)]

Salut,

 

Je ne suis pas sûr d'avoir compris la demande, mais en changeant la sous-routine "new-point" pour qu"elle retourne nil si deux entités ne sont pas sélectionnées (en remplaçant les while par un if).

On peut ainsi faire la boucle pour les sommets "tant que des entités sont sélectionnées".

Par la même je te propose aussi une autre méthode de calcul du milieu entre 2 points.

 

(defun new-point (/		  Obj-pt-1	  Obj-pt-2
	  coord-Obj-pt-1  coord-Obj-pt-2  ang-2pts
	  moitié-dist	  new-pt	  new-pt-string
	 )
				
 [surligneur](if (and
                                        ;select Obj-pt-1
(setq Obj-pt-1 (nentsel "\n Choisir le 1er objet point : "))
				;select Obj-pt-2
(setq Obj-pt-2 (nentsel "\n Choisir le 2eme objet point : "))
     )[/surligneur]

   (progn

     (setq coord-Obj-pt-1 (cdr (assoc 10 (entget (car Obj-pt-1)))))
     (setq coord-Obj-pt-2 (cdr (assoc 10 (entget (car Obj-pt-2)))))

				;(command "ligne" coord-Obj-pt-1 coord-Obj-pt-2 "")

    [surligneur] ;milieu de dex points
     (setq new-pt (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2))
		   coord-Obj-pt-1
		   coord-Obj-pt-2
	   )
     )[/surligneur]


				;(setq new-pt-string (strcat (rtos (car new-pt) 2 2) "," (rtos (cadr new-pt) 2 2)))

   );fin de progn
 );fin de if

)					;fin defun new-point

(defun c:CR_CENTERLINES	(/ epais-poly mode-acc chx stp)

 (setq mode-acc (getvar "osmode"))
 (setq epais-poly (getvar "PLINEWID"))

 (setvar "cmdecho" 0)
 (setvar "osmode" 0)

 (setq	pt (getpoint "\n Point de depart ")
p1 pt
 )

 (command "polylign" pt "la" 1 1)

 [surligneur](while (setq pt (new-point))
   (command pt)			; fin progn
   (setq p1 pt)
 )					; fin while[/surligneur]
 
 (command "")

 (prompt "\n---COPYRIGHT Mars 2007 par Fabrice DEMIEL---")

 (setvar "osmode" mode-acc)
 (setvar "PLINEWID" epais-poly)

 (princ)
)					; fin defun c:CR_CENTERLINES 

[fabcad]

Merci à vous deux pour ces informations que je vais approfondir.

 

Ces linéaires de voies seront plus vite dessinés.

 

Fabcad