ligne \"mediane\"

[PHILPHIL]

hello

 

j'utilise ce lisp pour faire une ligne "centrale" entre deux lignes

 

mais voila le bimsss

 

je dois creer un ligne a l'axe de cloisons qui sont faite en polyligne non close par moment

apres decomposition et verification les faces ne sont pas parralleles ( super genial encore un bon celui qui a fait ca - pas le bon logiciel surement )

 

bref j'aimerai pouvoir recuperer les infos des sous entites de la polylignes ( les sois disantes lignes parralelles ) sans decomposer la polylignes pour l'adapter a mon LISp recuperer les points P1 P2 P3 P4 des extremites des deux "sous lignes" et ainsi crer la ligne mediane

 

vous avez une idée ??

 

merci d'avance

 

a+

phil

 

 

 

 ;; ligne centrale

(defun C:LL ()
  (setvar "cmdecho" 0)
  (setq CAV   (getvar "clayer")
 OSM   (getvar "osmode")
 SCUNA (getvar "ucsname")
 UCSFO (getvar "ucsfollow")
  )
  (setvar "ucsfollow" 0)
  (setvar "osmode" 0)

  (setq SS1 (car (nentsel "\nSELECTIONNER LA PREMIERE LIGNE."))
 P1  (cdr (assoc 10 (entget SS1)))
 P2  (cdr (assoc 11 (entget SS1)))
 SS2 (car (nentsel "\nSELECTIONNER LA DEUXIEME LIGNE."))
 P3  (cdr (assoc 10 (entget SS2)))
 P4  (cdr (assoc 11 (entget SS2)))
  )
  (command "scu" "")
  (if (= (inters P1 P4 P2 P3) NIL)
     (progn (command "ligne"
	      (polar P1 (angle P1 P4) (/ (distance P1 P4) 2))
	      (polar P2 (angle P2 P3) (/ (distance P2 P3) 2))
	      ""
     )
     )
     (command "ligne"
       (polar P2 (angle P2 P4) (/ (distance P2 P4) 2))
       (polar P1 (angle P1 P3) (/ (distance P1 P3) 2))
       ""
     )
  )
  (command "scu" "p")
  (setvar "clayer" CAV)
  (setvar "ucsfollow" UCSFO)
  (setvar "osmode" OSM)
  (setvar "cmdecho" 1)
  (princ)
)

[(gile)]

Salut,

 

Un petit truc vite fait.

 

AutoLISP

 

(defun c:MidPline (/ pl1 pl2 elst1 elst2 pts1 pts2 pts3)
 (if (and
       (setq pl1 (car (entsel "\nSélectionnez la première polyligne: ")))
       (setq elst1 (entget pl1))
       (= "LWPOLYLINE" (cdr (assoc 0 elst1)))
       (setq pl2 (car (entsel "\nSélectionnez la seconde polyligne: ")))
       (setq elst2 (entget pl2))
       (= "LWPOLYLINE" (cdr (assoc 0 elst2)))
       (not (equal pl1 pl2))
     )
   (progn
     (setq pts1 (massoc 10 elst1)
           pts2 (massoc 10 elst2)
           pts3 (mapcar 'midpoint pts1 pts2)
     )
     (entmake
       (append
         (list
           '(0 . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           '(100 . "AcDbPolyline")
           (cons 90 (length pts3))
           (assoc 70 elst1)
           (assoc 210 elst1)
         )
         (mapcar '(lambda (p) (cons 10 p)) pts3)
       )
     )
   )
 )
 (princ)
)

(defun massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (massoc code (cdr alst)))
 )
)

(defun midpoint (p1 p2)
 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)
)

 

Visual LISP

 

(defun c:MidPline (/ pl1 pl2 pts1 pts2 pts3)
 (vl-load-com)
 (if (and
       (setq pl1 (car (entsel "\nSélectionnez la première polyligne: ")))
       (setq pl1 (vlax-ename->vla-object pl1))
       (= "AcDbPolyline" (vla-get-ObjectName pl1))
       (setq pts1 (2d-coord->pt-lst (vlax-get pl1 'Coordinates)))
       (setq pl2 (car (entsel "\nSélectionnez la seconde polyligne: ")))
       (setq pl2 (vlax-ename->vla-object pl2))
       (= "AcDbPolyline" (vla-get-ObjectName pl2))
       (not (equal pl1 pl2))
       (setq pts2 (2d-coord->pt-lst (vlax-get pl2 'Coordinates)))
     )
   (vlax-invoke
     (vla-get-ModelSpace (vla-get-Activedocument (vlax-get-acad-object)))
     'addLightWeightPolyline
     (apply
       'append
       (mapcar
         (function
           (lambda (p1 p2)
             (mapcar
               (function
                 (lambda (x1 x2) (/ (+ x1 x2) 2.))
               )
               p1
               p2
             )
           )
         )
         pts1
         pts2
       )
     )
   )
 )
 (princ)
)

[PHILPHIL]

hello

 

merci gile tjrs aussi rapide je vois

 

juste un petit souci tes lisp prennent en compte l'ensemble des polylignes

 

je cherchais un truc qui prenaient en compte un segment de la polyligne puis un autre segment

 

je vais essayer avec comme base ton LISp "bissectrice" qui doit etre en visual lisp car il donne des donneées debutdeligne findeligne en fracauis dans le texte

 

mais je garde tes LISp j'en ferais bon usage surement

 

merci bonne nuit

 

phil

[PHILPHIL]

 

hello gile

 

j'ai modifie ton LISP "bissectrice" de facon tres alambiqué,

mais ca marche a premiere vue

 

merci

 

a+

phil

 

 

 ;;; C:ll -Gilles Chanteau- (maj 23/04/07)
;;; Crée une ligne depart et fin au milieu des points opposés des lignes / segment selectionnés.


(defun c:ll  (/ e1 e2 l1 l2 p1 p1e p1ee p2 p2e p2ee som ang)
(setq	cav   (getvar "clayer")
osm   (getvar "osmode")
scuna (getvar "ucsname")
ucsfo (getvar "ucsfollow")
)
 (setvar "ucsfollow" 0)
 (setvar "osmode" 0)




 (while (not
   (setq e1 (entsel "\nSélectionnez le premier segment: "))
   )
  )
 (while (not
   (setq e2 (entsel "\nSélectionnez le second segment: "))
   )
  )
 (setq	l1 (entget (car e1))
l2 (entget (car e2))
p1 (osnap (cadr e1) "_near")
p2 (osnap (cadr e2) "_near")
)
 (if
   (and (or (and (member (cdr (assoc 0 l1)) '("XLINE" "RAY"))
	  (setq p1ee (mapcar '+ p1 (trans (cdr (assoc 11 l1)) 0 1 t)))
	  (setq p1e (mapcar '- p1 (trans (cdr (assoc 11 l1)) 0 1 t))))
     (and (setq p1e (osnap (cadr e1) "_endpoint"))
	  (setq	p1ee (polar p1e
			    (angle p1e (osnap (cadr e1) "_midpoint"))
			    (* (distance p1e (osnap (cadr e1) "_midpoint")) 2)))))
 (or (and (member (cdr (assoc 0 l2)) '("XLINE" "RAY"))
	  (setq p2ee (mapcar '+ p2 (trans (cdr (assoc 11 l2)) 0 1 t)))
	  (setq p2e (mapcar '- p2 (trans (cdr (assoc 11 l2)) 0 1 t))))
     (and (setq p2e (osnap (cadr e2) "_endpoint"))
	  (setq	p2ee (polar p2e
			    (angle p2e (osnap (cadr e2) "_midpoint"))
			    (* (distance p2e (osnap (cadr e2) "_midpoint")) 2))))
     ))

    (if (vl-every (function (lambda (x) (equal (caddr p1) (caddr x) 1e-009)))
	   (list p1ee p1e p2 p2ee p2e)
	   )
      (if (and	(null (inters p1 p1ee p1 p1e))
	(null (inters p2 p2ee p2 p2e))
	)
 (progn
   (command "scu" "")
   (if (= (inters p1ee p2e p1e p2ee) nil)
     (progn
       (command	"ligne"
		(polar p1ee (angle p1ee p2e) (/ (distance p1ee p2e) 2))
		(polar p1e (angle p1e p2ee) (/ (distance p1e p2ee) 2))
		""
		)
       )
     (command "ligne"
	      (polar p1e (angle p1e p2e) (/ (distance p1e p2e) 2))
	      (polar p1ee (angle p1ee p2ee) (/ (distance p1ee p2ee) 2))
	      ""
	      )
     )
   (command "scu" "p")
   )
 (princ "\nErreur: segment non linéaire")
 )
      (princ
 "\nErreur: segments non coplanaires ou non parallèles au plan du SCU courant"
 )
      )
    (princ "\nErreur: entité non valide")
    )
 (setvar "clayer" cav)
 (setvar "ucsfollow" ucsfo)
 (setvar "osmode" osm)
 (setvar "cmdecho" 1)
 (princ)
 )

 

[RobyCG01]

bonjour vous

afin de créer une médiane entre 2 bords de chaussée pour implanter l'axe de celle-ci

je voudrai utiliser votre LIPS mais voici le message obtenu au lancement : "Aucun système de coordonnées trouvé."

qui saurait me dire ce qu'il convient de faire pour arriver à mes fins?

merci déjà

[RobyCG01]

bonjour à tous

je reviens vers vous car déciodément je n'arrive pas à utiliser cette routine

et pourtant il est tellement fastidieux de tracer ces axes que celle-ci me rendrait un bien grand service..

or ce matin après avoir inscrit "ll" dans la ligne de comande pour appeler la rotine "mediane" voici la réponse: LL doit être appelé à partir d'une autre commande..

qui peut me dire d'une part:

- si cette routine pourrait répondre à mon souci

- pourquoi j'ai ce message aujourd'hui? ?

 

en vous remerciant bien par avance

[(gile)]

Salut,

 

De quelle(s) routine(s) parles tu ?

 

Dans ce sujet, PHILPHIL demande de l'aide pour ce qu'il veut faire (1er message) en postant la routine qu'il a écrite mais qui ne fonctionne pas comme il veut.

Je lui réponds en proposant 2 autres routines (2nd message), mais je n'ai visiblement pas bien compris la demande.

Il est enfin arrivé à ses fins et poste une routine qui lui convient (4ème message).

[RobyCG01]

bonjour et merci gile

oui j'ai bien compris cela

mais justement la routine qu'il propose dans le post n°4 semble répondre à ma recherche.. mais visiblement j'ai un souci avec celle-ci.. c'est pourquoi je demande de l'aide

à moins que tu connaisses autre chose pour tracer ces axes de mi-chaussée !!!

merci à toi

[(gile)]

Si, comme ça semble être le cas au vu de ce sujet, tu veux tracer la 'médiane' entre deux polylignes, essaye plutôt une des routines "MidPline" que j'ai postées réponse 2 (les 2 font la même chose).

PHILPHIL essayait de faire quelque chose segment par segment.

[RobyCG01]

merci gile

ta routine est super quand on a une polyligne composée de segments de droites..

mais si, comme en conception routière, on utilise des arcs, là la routine se perd un peu.. et le résultat n'est pas top !!

as tu une idée pour remédier à cela?

au fait mes excuses si les termes que j'emploie ne sont pas très académiques, mais mes connaissances en routines ou autres LIPS sont très très limitées...

 

[(gile)]

Tu peux essayer cette version :

 

(defun c:MidPline (/ pl1 pl2 elst1 elst2)
 (if (and
(setq pl1 (car (entsel "\nSélectionnez la première polyligne: ")))
(setq elst1 (entget pl1))
(= "LWPOLYLINE" (cdr (assoc 0 elst1)))
(setq pl2 (car (entsel "\nSélectionnez la seconde polyligne: ")))
(setq elst2 (entget pl2))
(= "LWPOLYLINE" (cdr (assoc 0 elst2)))
(not (equal pl1 pl2))
     )
   ((lambda (pts blgs)
      (entmake
 (append
   (list
     '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(100 . "AcDbPolyline")
     (cons 90 (length pts))
     (assoc 70 elst1)
     (assoc 210 elst1)
   )
   (apply 'append (mapcar '(lambda (p b) (list (cons 10 p) (cons 42 b))) pts blgs))
 )
      )
    )
     (mapcar 'midpoint (massoc 10 elst1) (massoc 10 elst2))
     (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) (massoc 42 elst1) (massoc 42 elst2))
   )
 )
 (princ)
)

(defun massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (massoc code (cdr alst)))
 )
)

(defun midpoint	(p1 p2)
 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)
)

[RobyCG01]

re,

voici le message d'autocad après avoir saisi la 1ere polyligne:

 

Commande: midpline

Sélectionnez la première polyligne: ; erreur: no function definition:

2D-COORD->PT-LST

 

 

et rien ne se crée sur le dessin..

[(gile)]

Ce n'est pas la dernière routine (réponse 10) qui est chargée dans ton dessin, mais la seconde de la réponse 2.

[RobyCG01]

j'ai refais plusieurs fois la manip, réenregistré celle du post 10 et toujours le même message

 

Commande: MIDPLINE

Sélectionnez la première polyligne: ; erreur: no function definition:

2D-COORD->PT-LST

Commande:

 

à moins que je n'ai rien compris (ce qui n'est pas impossible!!)

[(gile)]

Je persiste : la routine donnée réponse 10 ne contient aucun appel à la fonction '2D-COORD->PT-LST' ce n'est donc pas elle qui est chargée dans le dessin.

 

Il ne suffit de modifier le fichier .lsp, il faut aussi le recharger dans le dessin (commande APPLOAD par exemple).

[RobyCG01]

je te prie d'accepter mes excuses car je ne savais pas qu'il fallait décharger la routine et la charger de nouveau.. ce que je viens de faire

Tout fonctionne admirablement bien et tu ne te doutes pas le temps que je vais gagner..

Un très grand merci gile pour ta patience et un grand bravo pour tes connaissances.