création d\'intersection et reconstitution de contour

lecrabe · le 2 juillet 2007

Hello Gilles

Je confirme le bon fonctionnement de ton corridor.lsp (avec des polylignes) sur AutoCAD 2007

et son plantage sur AutoCAD 2006 ! :o

**** AutoCAD 2006 (et sans doute aussi sur 2005) ****

En fait si la polyligne est formée d'un seul segment : ca marche

Si la polyligne est formée de 2 segments ou plus : ca plante :(

Commande: corridor

Sélectionner une polyligne:

Longueur des boites : Spécifiez le deuxième point:

largeur des boites: Spécifiez le deuxième point: ; erreur: une exception s'est

produite: 0xC0000005 (Violation d'accès)

; avertissement: fonction unwind ignorée erreur inconnue

Une petite correction SVP !

Le Decapode "intéressé"

lecrabe · le 2 juillet 2007

Hello

Qq precisions supplementaires :

Ca marche nickel-chrome sur AutoCAD 2007 et 2008

Ca deconne complet sur AutoCAD 2002 / 2004 / 2005 / 2006

Ca marche toujours si la polyligne a un SEUL segment !

Avec 2002/2004/2005/2006, lorsque la polyligne ouverte a 2 segments ou plus :

CORRIDOR.lsp dessine le decalage de chaque coté de la polyligne ouverte = OK

puis dessine une ligne qui part de l'extrémité du 1er decalage, suit le decalage ( !!! ) de la longueur du rectangle puis FONCE à la derniere extrémité du decalage

avec le msg d'erreur evoqué dans mon message précédent ...

Avec 2002/2004/2005/2006, lorsque la polyligne est close :

CORRIDOR.lsp dessine le decalage de chaque coté de la polyligne close = OK

et se plante avec l'erreur:

Erreur: Erreur Automation Index incorrect

et il y a 2 polylignes dessinées à l'intérieur !!!

c'est surement la fameuse polyligne qui se dessine lors du cas d'une polyline non clsoe !

Voilu, voilo, voila, Le Decapode "testeur"

lecrabe · le 2 juillet 2007

Hello

Qq precisions supplementaires :

Ca marche nickel-chrome sur AutoCAD 2007 et 2008

Ca deconne complet sur AutoCAD 2002 / 2004 / 2005 / 2006

Ca marche toujours si la polyligne a un SEUL segment !

Avec 2002/2004/2005/2006, lorsque la polyligne ouverte a 2 segments ou plus :

CORRIDOR.lsp dessine le decalage de chaque coté de la polyligne ouverte = OK

puis dessine une ligne qui part de l'extrémité du 1er decalage, suit le decalage ( !!! ) de la longueur du rectangle puis FONCE à la derniere extrémité du decalage

avec le msg d'erreur evoqué dans mon message précédent ...

Avec 2002/2004/2005/2006, lorsque la polyligne est close :

CORRIDOR.lsp dessine le decalage de chaque coté de la polyligne close = OK

et se plante avec l'erreur:

Erreur: Erreur Automation Index incorrect

et il y a 2 polylignes dessinées à l'intérieur !!!

c'est surement la fameuse polyligne qui se dessine lors du cas d'une polyline non clsoe !

Voilu, voilo, voila, Le Decapode "testeur"

(gile) · le 2 juillet 2007

Salut et merci pour les tests.

Je fais ça en aveugle n'ayant que 2007 sous la main.

Je pense que le problème vient de la sous routine CutPlineAtPoint, je te propose de tester en chargeant cette nouvelle version de CutLineAtpoint.

;;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;; 
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)

(defun CutPlineAtPoint (pl pt / ec vl)
 (and (= (type pl) 'VLA-OBJECT)
      (setq pl	(vlax-vla-object->ename pl)
     vl	T
      )
 )
 (setq ec (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (vl-cmdf "_.break" pl "_non" (trans pt 0 1) "_non" "@")
 (setvar "cmdecho" ec)
 (if vl
   (list (vlax-ename->vla-object pl)
  (vlax-ename->vla-object (entlast))
   )
   (list pl (entlast))
 )
)

lecrabe · le 2 juillet 2007

Hello Gilles

C Super, ca marche avec toutes les versions maintenant ! :)

Cependant parfois, ça déconne un peu sur la dernière boite d'une polyligne close ! :casstet:

Donc je t'envoie par MP mon DWG de test et la routine CORRIDOR2.LSP

pour correction et amélioration SVP :D

Je suggère l'amélioration suivante en début de routine:

- Question : Voulez vous une numérotation des boites ?

- Si OUI, poser la question valeur de départ ?

- avec dernière valeur incrémentée par défaut

- ou sinon 1

- ou sinon saisie au clavier de la valeur de départ

- Question : Hauteur du texte ?

- Génération d'un texte simple au centre de chaque rectangle / boîte !

Merci d'avance, Le Decapode "testeur chieur"

lecrabe · le 2 juillet 2007

Hello Gilles

SVP peux tu me renvoyer ton adresse courriel perso ?

J'ai perdu ton adresse lors de mon desabonnement Wanadoo !

cadxp at hotmail.fr

Le Decapode

(gile) · le 2 juillet 2007

C'est parti.

lecrabe · le 2 juillet 2007

ReBonjour Gilles

C parti ... Merci :)

Sinon comme d'hab, attention au style de texte en cours dont la hauteur serait FIXEE !

c'est à dire différente de ZERO !!

Ca m'énerve prodigieusement les styles de textes avec une hauteur 0 :o :( :mad:

Autre suggestion: si on lance plusieurs fois la routine dans une meme session de DWG

proposer en longueur / largeur les dernières valeurs utilisées :cool:

Encore merci pour ta routine :) :D :cool: ;)

Le Decapode "hyper-chieur"

(gile) · le 2 juillet 2007

Voilà une nouvelle version dans laquelle je pense avoir fixé les problèmes géométriques.

Elle fonctionne avec les polylignes ouvertes, fermées, avec ou sans arcs, quelque soit le SCU courant et le SCO de la polyligne.

Je rajouterai la possibilité de numérotation plus tard...

EDIT : décelé et réparé un bug

(defun c:corridor (/	  erreur JoinPlines    AcDoc  Space  inc
	   ht	  ent	 long	larg   pl0    nor    pl1
	   pl2	  ps1	 ps2	nb     n      pt0    pa0
	   pt1	  pt2	 cut1	cut2 txt
	  )

 (vl-load-com)

 ;; Redéfintion de *error* (fermeture du groupe d'annulation)
 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;; Joint deux polylignes en une polyligne fermée
 (defun JoinPlines (p1 p2 / v1 v2 i lst pl)
   (setq v1 (fix (vlax-curve-getEndParam p1))
  v2 (fix (vlax-curve-getEndParam p2))
  i  0
   )
   (repeat v1
     (setq lst	(cons (cons i (vla-getBulge p1 i)) lst)
    i	(1+ i)
     )
   )
   (setq i (1+ i))
   (repeat v2
     (setq lst	(cons (cons i (- (vla-GetBulge p2 (setq v2 (1- v2))))) lst)
    i	(1+ i)
     )
   )
   (setq pl
   (vlax-invoke
     Space
     'addLightWeightPolyline
     (append (vlax-get p1 'Coordinates)
	     (apply 'append
		    (reverse (split-list (vlax-get p2 'Coordinates) 2))
	     )
     )
   )
   )
   (vla-put-Closed pl :vlax-true)
   (mapcar '(lambda (x) (vla-SetBulge pl (car x) (cdr x))) lst)
   (vla-put-Normal pl (vla-get-Normal p1))
   (vla-put-Elevation pl (vla-get-Elevation p1))
   (vla-delete p1)
   (vla-delete p2)
   pl
 )

 ;; Fonction principale
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	erreur
 )
 (or (vlax-ldata-get "corridor" "long")
     (vlax-ldata-put "corridor" "long" 40.0)
 )
 (or (vlax-ldata-get "corridor" "larg")
     (vlax-ldata-put "corridor" "larg" 20.0)
 )
 (while (not
   (setq ent (car (entsel "\nSélectionner une polyligne: ")))
 )
 )
 (initget 6)
 (if (setq long
     (getdist (strcat "\nLongueur des boites 			      (rtos (vlax-ldata-get "corridor" "long"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "long" long)
   (setq long (vlax-ldata-get "corridor" "long"))
 )
 (initget 6)
 (if (setq larg
     (getdist (strcat "\nLongueur des boites 			      (rtos (vlax-ldata-get "corridor" "larg"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "larg" larg)
   (setq larg (vlax-ldata-get "corridor" "larg"))
 )
 (vla-StartUndoMark AcDoc)
 (setq	pl0 (vlax-ename->vla-object ent)
nor (vlax-get pl0 'Normal)
pl1 (car (vlax-invoke pl0 'Offset (/ larg 2.0)))
pl2 (car (vlax-invoke pl0 'Offset (/ larg -2.0)))
ps1 (trans (vlax-curve-getPointAtParam pl1 0) 0 nor)
ps2 (trans (vlax-curve-getPointAtParam pl2 0) 0 nor)
nb  (fix
      (/ (vlax-curve-getDistAtParam
	   pl0
	   (vlax-curve-getEndParam pl0)
	 )
	 long
      )
    )
n   1
 )
 (repeat nb
   (setq pt0 (vlax-curve-getPointAtDist pl0 (* n long))
  pa0 (vlax-curve-getParamatpoint pl0 pt0)
   )
   (if	(equal pa0 (fix pa0) 1e-9)
     (setq pt1	(vlax-curve-getPointatParam pl1 1)
    pt2	(vlax-curve-getPointatParam pl2 1)
     )
     (setq pt1	(vlax-curve-getClosestPointTo pl1 pt0)
    pt2	(vlax-curve-getClosestPointTo pl2 pt0)
     )
   )
   (setq cut1 (CutPlineAtPoint pl1 pt1)
  cut2 (CutPlineAtPoint pl2 pt2)
   )
   (cond
     ((not (car cut1))
      (vlax-put pl2
	 'Coordinates
	 (append (vlax-get pl2 'Coordinates)
		 (reverse (cdr (reverse (trans pt1 0 nor))))
	 )
      )
      (vla-put-Closed pl2 :vlax-true)
      (vla-put-Layer pl2 (getvar "CLAYER"))
     )
     ((not (car cut2))
      (vlax-put pl1
	 'Coordinates
	 (append (vlax-get pl1 'Coordinates)
		 (reverse (cdr (reverse (trans pt2 0 nor))))
	 )
      )
      (vla-put-Closed pl1 :vlax-true)
      (vla-put-Layer pl1 (getvar "CLAYER"))
     )
     (T (JoinPlines (car cut1) (car cut2)))
   )
   (setq n   (1+ n)
  inc (1+ inc)
  pl1 (cadr cut1)
  pl2 (cadr cut2)
   )
 )
 (cond
   ((not pl1)
    (vlax-put pl2
       'Coordinates
       (append (vlax-get pl2 'Coordinates)
	       (list (car ps1) (cadr ps1))
       )
    )
    (vla-put-Closed pl2 :vlax-true)
    (vla-put-Layer pl2 (getvar "CLAYER"))
   )
   ((not pl2)
    (vlax-put pl1
       'Coordinates
       (append (vlax-get pl1 'Coordinates)
	       (list (car ps2) (cadr ps2))
       )
    )
    (vla-put-Closed pl1 :vlax-true)
    (vla-put-Layer pl1 (getvar "CLAYER"))
   )
   (T (JoinPlines pl1 pl2))
 )
 (vlax-ldata-put "corridor" "num" inc)
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;;************************* SOUS ROUTINES *************************;;;

;;; Angle2Bulge
;;; Retourne le bulge correspondant à un angle
(defun Angle2Bulge (a)
 (/ (sin (/ a 4.0)) (cos (/ a 4.0)))
)

;;; ArcCenterBy3Points
;;; Retourne le centre de l'arc décrit par 3 points
(defun ArcCenterBy3Points (p1 p2 p3)
 ((lambda (mid1 mid2)
    (inters mid1
     (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
     mid2
     (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)
     nil
    )
  )
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p2 p3)
 )
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 -1) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 12) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)
(defun sublst (lst start leng / rslt)
 (or (      (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

;; SPLIT-LIST Retourne une liste de sous-listes
;; Arguments
;; - lst : la liste à fractionner
;; - num : un entier, le nombre d'éléments des sous listes
;; Exemples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
 (if lst
   (cons (sublst lst 1 n)
  (split-list (sublst lst (1+ n) nil) n)
   )
 )
)

;;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;; 
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)

(defun CutPlineAtPoint (pl pt / ec vl lst)
 (and (= (type pl) 'VLA-OBJECT)
      (setq pl	(vlax-vla-object->ename pl)
     vl	T
      )
 )
 (cond
   ((equal pt (vlax-curve-getEndPoint pl) 1e-9)
    (setq lst (list pl nil))
   )
   ((equal pt (vlax-curve-getStartPoint pl) 1e-9)
    (setq lst (list nil pl))
   )
   ((null (vlax-curve-getParamAtPoint pl pt))
    (setq lst (list pl nil))
   )
   (T
    (setq ec (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (vl-cmdf "_.break" pl "_non" (trans pt 0 1) "_non" "@")
    (setvar "cmdecho" ec)
    (setq lst (list pl (entlast)))
   )
 )
 (if vl
   (mapcar '(lambda (x)
       (if x
	 (vlax-ename->vla-object x)
       )
     )
    lst
   )
   lst
 )
)

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

lecrabe · le 2 juillet 2007

Hello Gilles

C TIP TOP :) :D :cool:

J'ai testé et validé sur AutoCAD/MAP 2002 et 2006 et 2008 !

Donc je suis sur que ca fonctionne aussi sur AutoCAD / MAP 2004 & 2005 :P

Ta réactivité et efficacité sont exceptionnelles = BRAVO !

Le Decapode "chapeau bas"

(gile) · le 2 juillet 2007

Voilà la version avec texte incrémenté.

EDIT : correction d'undysfonctionnement pour l'option "Non" à la numérotation.

(defun c:corridor (/	  erreur JoinPlines    AcDoc  Space  inc
	   ht	  ent	 long	larg   pl0    nor    pl1
	   pl2	  ps1	 ps2	nb     n      pt0    pa0
	   pt1	  pt2	 cut1	cut2   txt
	  )

 (vl-load-com)

 ;; Redéfintion de *error* (fermeture du groupe d'annulation)
 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;; Joint deux polylignes en une polyligne fermée
 (defun JoinPlines (p1 p2 / v1 v2 i lst pl)
   (setq v1 (fix (vlax-curve-getEndParam p1))
  v2 (fix (vlax-curve-getEndParam p2))
  i  0
   )
   (repeat v1
     (setq lst	(cons (cons i (vla-getBulge p1 i)) lst)
    i	(1+ i)
     )
   )
   (setq i (1+ i))
   (repeat v2
     (setq lst	(cons (cons i (- (vla-GetBulge p2 (setq v2 (1- v2))))) lst)
    i	(1+ i)
     )
   )
   (setq pl
   (vlax-invoke
     Space
     'addLightWeightPolyline
     (append (vlax-get p1 'Coordinates)
	     (apply 'append
		    (reverse (split-list (vlax-get p2 'Coordinates) 2))
	     )
     )
   )
   )
   (vla-put-Closed pl :vlax-true)
   (mapcar '(lambda (x) (vla-SetBulge pl (car x) (cdr x))) lst)
   (vla-put-Normal pl (vla-get-Normal p1))
   (vla-put-Elevation pl (vla-get-Elevation p1))
   (vla-delete p1)
   (vla-delete p2)
   pl
 )

 ;; Fonction principale
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	erreur
 )
 (or (vlax-ldata-get "corridor" "long")
     (vlax-ldata-put "corridor" "long" 40.0)
 )
 (or (vlax-ldata-get "corridor" "larg")
     (vlax-ldata-put "corridor" "larg" 20.0)
 )
 (or (vlax-ldata-get "corridor" "num")
     (vlax-ldata-put "corridor" "num" 1)
 )
 (initget "Oui Non")
 (if
   (/=	"Non"
(getkword "\Numéroter les boites ? [Oui/Non] : ")
   )
    (progn
      (if (setq inc
	  (getint (strcat "\nEntrez le numéro de départ 				  (itoa (vlax-ldata-get "corridor" "num"))
			  ">: "
		  )
	  )
   )
 (vlax-ldata-put "corridor" "num" inc)
 (setq inc (vlax-ldata-get "corridor" "num"))
      )
      (if (setq ht (getdist (strcat "\nSpécifiez la hauteur de texte 				     (rtos (getvar "TEXTSIZE"))
			     ">: "
		     )
	    )
   )
 (setvar "TEXTSIZE" ht)
 (setq ht (getvar "TEXTSIZE"))
      )
    )
 )
 (while (not
   (setq ent (car (entsel "\nSélectionner une polyligne: ")))
 )
 )
 (initget 6)
 (if (setq long
     (getdist (strcat "\nLongueur des boites 			      (rtos (vlax-ldata-get "corridor" "long"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "long" long)
   (setq long (vlax-ldata-get "corridor" "long"))
 )
 (initget 6)
 (if (setq larg
     (getdist (strcat "\nLargeur des boites 			      (rtos (vlax-ldata-get "corridor" "larg"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "larg" larg)
   (setq larg (vlax-ldata-get "corridor" "larg"))
 )
 (vla-StartUndoMark AcDoc)
 (setq	pl0 (vlax-ename->vla-object ent)
nor (vlax-get pl0 'Normal)
pl1 (car (vlax-invoke pl0 'Offset (/ larg 2.0)))
pl2 (car (vlax-invoke pl0 'Offset (/ larg -2.0)))
ps1 (trans (vlax-curve-getPointAtParam pl1 0) 0 nor)
ps2 (trans (vlax-curve-getPointAtParam pl2 0) 0 nor)
nb  (fix
      (/ (vlax-curve-getDistAtParam
	   pl0
	   (vlax-curve-getEndParam pl0)
	 )
	 long
      )
    )
n   1
 )
 (repeat nb
   (setq pt0 (vlax-curve-getPointAtDist pl0 (* n long))
  pa0 (vlax-curve-getParamatpoint pl0 pt0)
   )
   (if	(equal pa0 (fix pa0) 1e-9)
     (setq pt1	(vlax-curve-getPointatParam pl1 1)
    pt2	(vlax-curve-getPointatParam pl2 1)
     )
     (setq pt1	(vlax-curve-getClosestPointTo pl1 pt0)
    pt2	(vlax-curve-getClosestPointTo pl2 pt0)
     )
   )
   (setq cut1 (CutPlineAtPoint pl1 pt1)
  cut2 (CutPlineAtPoint pl2 pt2)
   )
   (cond
     ((not (car cut1))
      (vlax-put pl2
	 'Coordinates
	 (append (vlax-get pl2 'Coordinates)
		 (reverse (cdr (reverse (trans pt1 0 nor))))
	 )
      )
      (vla-put-Closed pl2 :vlax-true)
      (vla-put-Layer pl2 (getvar "CLAYER"))
     )
     ((not (car cut2))
      (vlax-put pl1
	 'Coordinates
	 (append (vlax-get pl1 'Coordinates)
		 (reverse (cdr (reverse (trans pt2 0 nor))))
	 )
      )
      (vla-put-Closed pl1 :vlax-true)
      (vla-put-Layer pl1 (getvar "CLAYER"))
     )
     (T (JoinPlines (car cut1) (car cut2)))
   )
   (if	inc
     (progn
(setq txt
       (vla-addText
	 Space
	 (itoa inc)
	 (vlax-3d-point '(0 0 0))
	 ht
       )
)
(vla-put-Normal txt (vlax-3d-point nor))
(vla-put-Alignment txt 10)
(vla-put-TextAlignmentPoint
  txt
  (vlax-3d-point
    (vlax-curve-getPointAtDist pl0 (- (* n long) (/ long 2)))
  )
)
(setq inc (1+ inc))
     )
   )
   (setq n   (1+ n)
  pl1 (cadr cut1)
  pl2 (cadr cut2)
   )
 )
 (cond
   ((not pl1)
    (vlax-put pl2
       'Coordinates
       (append (vlax-get pl2 'Coordinates)
	       (list (car ps1) (cadr ps1))
       )
    )
    (vla-put-Closed pl2 :vlax-true)
    (vla-put-Layer pl2 (getvar "CLAYER"))
   )
   ((not pl2)
    (vlax-put pl1
       'Coordinates
       (append (vlax-get pl1 'Coordinates)
	       (list (car ps2) (cadr ps2))
       )
    )
    (vla-put-Closed pl1 :vlax-true)
    (vla-put-Layer pl1 (getvar "CLAYER"))
   )
   (T (JoinPlines pl1 pl2))
 )
 (if inc
   (progn
     (setq txt
     (vla-addText
       Space
       (itoa inc)
       (vlax-3d-point '(0 0 0))
       ht
     )
     )
     (vla-put-Normal txt (vlax-3d-point nor))
     (vla-put-Alignment txt 10)
     (vla-put-TextAlignmentPoint
txt
(vlax-3d-point
  (vlax-curve-getPointAtDist
    pl0
    (/ (+ (vlax-curve-getDistatPoint pl0 pt0)
	  (vlax-curve-getDistAtParam
	    pl0
	    (vlax-curve-getEndParam pl0)
	  )
       )
       2.0
    )
  )
)
     )
     (vlax-ldata-put "corridor" "num" (1+ inc))
   )
 )
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;;************************* SOUS ROUTINES *************************;;;

;;; Angle2Bulge
;;; Retourne le bulge correspondant à un angle
(defun Angle2Bulge (a)
 (/ (sin (/ a 4.0)) (cos (/ a 4.0)))
)

;;; ArcCenterBy3Points
;;; Retourne le centre de l'arc décrit par 3 points
(defun ArcCenterBy3Points (p1 p2 p3)
 ((lambda (mid1 mid2)
    (inters mid1
     (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
     mid2
     (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)
     nil
    )
  )
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p2 p3)
 )
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 -1) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 12) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)
(defun sublst (lst start leng / rslt)
 (or (      (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

;; SPLIT-LIST Retourne une liste de sous-listes
;; Arguments
;; - lst : la liste à fractionner
;; - num : un entier, le nombre d'éléments des sous listes
;; Exemples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
 (if lst
   (cons (sublst lst 1 n)
  (split-list (sublst lst (1+ n) nil) n)
   )
 )
)

;;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;; 
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)

(defun CutPlineAtPoint (pl pt / ec vl lst)
 (vl-load-com)
 (and (= (type pl) 'VLA-OBJECT)
      (setq pl	(vlax-vla-object->ename pl)
     vl	T
      )
 )
 (cond
   ((equal pt (vlax-curve-getEndPoint pl) 1e-9)
    (setq lst (list pl nil))
   )
   ((equal pt (vlax-curve-getStartPoint pl) 1e-9)
    (setq lst (list nil pl))
   )
   ((null (vlax-curve-getParamAtPoint pl pt))
    (setq lst (list pl nil))
   )
   (T
    (setq ec (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (vl-cmdf "_.break" pl "_non" (trans pt 0 1) "_non" "@")
    (setvar "cmdecho" ec)
    (setq lst (list pl (entlast)))
   )
 )
 (if vl
   (mapcar '(lambda (x)
       (if x
	 (vlax-ename->vla-object x)
       )
     )
    lst
   )
   lst
 )
)

PS pour lecrabe :

Pour les styles de texte avec une hauteur non nulle, une petite routine qui remet tous les style de texte du dessin à une hauteur 0.0

(defun c:HT0 ()
 (vl-load-com)
 (vlax-for ts (vla-get-textstyles
	 (vla-get-activedocument (vlax-get-acad-object))
       )
   (vla-put-Height ts 0.0)
 )
 (princ)
)

et puisqu'on en est au ménage, j'ai répondu à une de tes demandes en souffrance ici et il y a quelque temps à une autre là.

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

doy · le 4 juillet 2007

salut à tous,

un petit tour sur le site et quelle suprise !!!!!!!!

merci gile pour la rapidité de ta réponse.

je le télécharge et j'essaye ça.

à + doy

et encore merci, cela fait plaisir de ne pas se sentir seul devant un problème

quand on débute et de ne plus avoir un écran vide de sens.

( ps : un petit mot pour charlie69 qui ne donne plus de nouvelle).

doy · le 13 juillet 2007

Bonjour à tous

et merci gile pour tes conseils et explications.

j'ai essayé le programme et formidable il fonctionne à merveille

j'ai changer les couleurs et attributions des calques pour les boites et les textes

ça marche à peu près mais j'ai toujours un petit soucis car le dernier chiffre reste dans sa couleur et calque d'origine.

j'essais de faire une boîte de dialogue mais comme je ne comprend pas tourjours tous dans ton programme il me manque des explications sur par exemple ce que définis exactement "num" ai je bien compris s'agit il de l'abréviation de numérotation ou est ce autre chose.

en tout cas il fonctionne et ça s'est super

encore merci.

à + doy.

(gile) · le 14 juillet 2007

il me manque des explications sur par exemple ce que définis exactement "num" ai je bien compris s'agit il de l'abréviation de numérotation ou est ce autre chose

Les fonctions (vlax-ldata-put ...) (vlax-ldata-get ...) permettent de stocker (et de récupérer) des données dans le dessin, elles requièrent comme premiers arguments :

- un dictionnaire (ou une entité) auquel la donnée est liée

- une clé pour définir (ou retrouver) la donnée dans le dictionnaire.

Le dictionnaire et la clé sont des chaines de caractères choisies par le programmeur, personnellement, j'utilise pour le dictionnaire le même nom que la routine et pour les clés des noms que je pense explicite, mais on peut choisir ce que l'on veut (en essayant d'éviter de redéfinir des données "ldata" qui pourraient déjà exister dans le dessin.

lecrabe · le 14 juillet 2007

Hello Gilles

Je fais des super-corridors ... Encore merci !

Bon WE, Le Decapode (pas encore en vacances, SNIFF)

(gile) · le 19 juillet 2007

J'ai réparé un dysfonctionnement dans corridor, quand on choisissait l'option sans numérotation des "boites".

La version donnée plus haut (postée le 2/7/2007 à 21:08) a été mise à jour.

D'autre part, je persiste à essayer de finaliser une routine "CutPlineAtPoint" qui n'utiliserait pas la fonction "command" (exécution plus rapide malgrè un code plus long).

Les précedentes versions ne fonctionnaient pas avec les versions antérieures à 2007.

Si certains fidèles testeurs voulaient bien essayer la version ci dessous sur différentes versions d'AutoCAD, et signaler si elle pose toujours problème.

Merci d'avance.

(defun c:corridor (/	  erreur JoinPlines    AcDoc  Space  inc
	   ht	  ent	 long	larg   pl0    nor    pl1
	   pl2	  ps1	 ps2	nb     n      pt0    pa0
	   pt1	  pt2	 cut1	cut2   txt
	  )

 (vl-load-com)

 ;; Redéfintion de *error* (fermeture du groupe d'annulation)
 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;; Joint deux polylignes en une polyligne fermée
 (defun JoinPlines (p1 p2 / v1 v2 i lst pl)
   (setq v1 (fix (vlax-curve-getEndParam p1))
  v2 (fix (vlax-curve-getEndParam p2))
  i  0
   )
   (repeat v1
     (setq lst	(cons (cons i (vla-getBulge p1 i)) lst)
    i	(1+ i)
     )
   )
   (setq i (1+ i))
   (repeat v2
     (setq lst	(cons (cons i (- (vla-GetBulge p2 (setq v2 (1- v2))))) lst)
    i	(1+ i)
     )
   )
   (setq pl
   (vlax-invoke
     Space
     'addLightWeightPolyline
     (append (vlax-get p1 'Coordinates)
	     (apply 'append
		    (reverse (split-list (vlax-get p2 'Coordinates) 2))
	     )
     )
   )
   )
   (vla-put-Closed pl :vlax-true)
   (mapcar '(lambda (x) (vla-SetBulge pl (car x) (cdr x))) lst)
   (vla-put-Normal pl (vla-get-Normal p1))
   (vla-put-Elevation pl (vla-get-Elevation p1))
   (vla-delete p1)
   (vla-delete p2)
   pl
 )

 ;; Fonction principale
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
m:err	*error*
*error*	erreur
 )
 (or (vlax-ldata-get "corridor" "long")
     (vlax-ldata-put "corridor" "long" 40.0)
 )
 (or (vlax-ldata-get "corridor" "larg")
     (vlax-ldata-put "corridor" "larg" 20.0)
 )
 (or (vlax-ldata-get "corridor" "num")
     (vlax-ldata-put "corridor" "num" 1)
 )
 (initget "Oui Non")
 (if
   (/=	"Non"
(getkword "\Numéroter les boites ? [Oui/Non] < Oui >: ")
   )
    (progn
      (if (setq inc
	  (getint (strcat "\nEntrez le numéro de départ <"
			  (itoa (vlax-ldata-get "corridor" "num"))
			  ">: "
		  )
	  )
   )
 (vlax-ldata-put "corridor" "num" inc)
 (setq inc (vlax-ldata-get "corridor" "num"))
      )
      (if (setq ht (getdist (strcat "\nSpécifiez la hauteur de texte <"
			     (rtos (getvar "TEXTSIZE"))
			     ">: "
		     )
	    )
   )
 (setvar "TEXTSIZE" ht)
 (setq ht (getvar "TEXTSIZE"))
      )
    )
 )
 (while (not
   (setq ent (car (entsel "\nSélectionner une polyligne: ")))
 )
 )
 (initget 6)
 (if (setq long
     (getdist (strcat "\nLongueur des boites <"
		      (rtos (vlax-ldata-get "corridor" "long"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "long" long)
   (setq long (vlax-ldata-get "corridor" "long"))
 )
 (initget 6)
 (if (setq larg
     (getdist (strcat "\nLongueur des boites <"
		      (rtos (vlax-ldata-get "corridor" "larg"))
		      ">: "
	      )
     )
     )
   (vlax-ldata-put "corridor" "larg" larg)
   (setq larg (vlax-ldata-get "corridor" "larg"))
 )
 (vla-StartUndoMark AcDoc)
 (setq	pl0 (vlax-ename->vla-object ent)
nor (vlax-get pl0 'Normal)
pl1 (car (vlax-invoke pl0 'Offset (/ larg 2.0)))
pl2 (car (vlax-invoke pl0 'Offset (/ larg -2.0)))
ps1 (trans (vlax-curve-getPointAtParam pl1 0) 0 nor)
ps2 (trans (vlax-curve-getPointAtParam pl2 0) 0 nor)
nb  (fix
      (/ (vlax-curve-getDistAtParam
	   pl0
	   (vlax-curve-getEndParam pl0)
	 )
	 long
      )
    )
n   1
 )
 (repeat nb
   (setq pt0 (vlax-curve-getPointAtDist pl0 (* n long))
  pa0 (vlax-curve-getParamatpoint pl0 pt0)
   )
   (if	(equal pa0 (fix pa0) 1e-9)
     (setq pt1	(vlax-curve-getPointatParam pl1 1)
    pt2	(vlax-curve-getPointatParam pl2 1)
     )
     (setq pt1	(vlax-curve-getClosestPointTo pl1 pt0)
    pt2	(vlax-curve-getClosestPointTo pl2 pt0)
     )
   )
   (setq cut1 (CutPlineAtPoint pl1 pt1)
  cut2 (CutPlineAtPoint pl2 pt2)
   )
   (cond
     ((not (car cut1))
      (vlax-put pl2
	 'Coordinates
	 (append (vlax-get pl2 'Coordinates)
		 (reverse (cdr (reverse (trans pt1 0 nor))))
	 )
      )
      (vla-put-Closed pl2 :vlax-true)
      (vla-put-Layer pl2 (getvar "CLAYER"))
     )
     ((not (car cut2))
      (vlax-put pl1
	 'Coordinates
	 (append (vlax-get pl1 'Coordinates)
		 (reverse (cdr (reverse (trans pt2 0 nor))))
	 )
      )
      (vla-put-Closed pl1 :vlax-true)
      (vla-put-Layer pl1 (getvar "CLAYER"))
     )
     (T (JoinPlines (car cut1) (car cut2)))
   )
   (if	inc
     (progn
(setq txt
       (vla-addText
	 Space
	 (itoa inc)
	 (vlax-3d-point '(0 0 0))
	 ht
       )
)
(vla-put-Normal txt (vlax-3d-point nor))
(vla-put-Alignment txt 10)
(vla-put-TextAlignmentPoint
  txt
  (vlax-3d-point
    (vlax-curve-getPointAtDist pl0 (- (* n long) (/ long 2)))
  )
)
(setq inc (1+ inc))
     )
   )
   (setq n   (1+ n)
  pl1 (cadr cut1)
  pl2 (cadr cut2)
   )
 )
 (cond
   ((not pl1)
    (vlax-put pl2
       'Coordinates
       (append (vlax-get pl2 'Coordinates)
	       (list (car ps1) (cadr ps1))
       )
    )
    (vla-put-Closed pl2 :vlax-true)
    (vla-put-Layer pl2 (getvar "CLAYER"))
   )
   ((not pl2)
    (vlax-put pl1
       'Coordinates
       (append (vlax-get pl1 'Coordinates)
	       (list (car ps2) (cadr ps2))
       )
    )
    (vla-put-Closed pl1 :vlax-true)
    (vla-put-Layer pl1 (getvar "CLAYER"))
   )
   (T (JoinPlines pl1 pl2))
 )
 (if inc
   (progn
     (setq txt
     (vla-addText
       Space
       (itoa inc)
       (vlax-3d-point '(0 0 0))
       ht
     )
     )
     (vla-put-Normal txt (vlax-3d-point nor))
     (vla-put-Alignment txt 10)
     (vla-put-TextAlignmentPoint
txt
(vlax-3d-point
  (vlax-curve-getPointAtDist
    pl0
    (/ (+ (vlax-curve-getDistatPoint pl0 pt0)
	  (vlax-curve-getDistAtParam
	    pl0
	    (vlax-curve-getEndParam pl0)
	  )
       )
       2.0
    )
  )
)
     )
     (vlax-ldata-put "corridor" "num" (1+ inc))
   )
 )
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;;************************* SOUS ROUTINES *************************;;;

;;; Angle2Bulge
;;; Retourne le bulge correspondant à un angle
(defun Angle2Bulge (a)
 (/ (sin (/ a 4.0)) (cos (/ a 4.0)))
)

;;; ArcCenterBy3Points
;;; Retourne le centre de l'arc décrit par 3 points
(defun ArcCenterBy3Points (p1 p2 p3)
 ((lambda (mid1 mid2)
    (inters mid1
     (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
     mid2
     (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)
     nil
    )
  )
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p2 p3)
 )
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 -1) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 12) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)
(defun sublst (lst start leng / rslt)
 (or (<= 1 leng (- (length lst) start))
     (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

;; SPLIT-LIST Retourne une liste de sous-listes
;; Arguments
;; - lst : la liste à fractionner
;; - num : un entier, le nombre d'éléments des sous listes
;; Exemples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
 (if lst
   (cons (sublst lst 1 n)
  (split-list (sublst lst (1+ n) nil) n)
   )
 )
)

[surligneur];;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;; 
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)

(defun CutPlineAtPoint
	       (pl  pt	/   en	no  pa	p0  p1	pn  cl	l0  l1
		l2  ce	sp  c	b0  b1	b2  bp	a1  a2	n   wp
		w0  w1	w2
	       )
 (vl-load-com)
 (or (= (type pl) 'VLA-OBJECT)
     (setq pl (vlax-ename->vla-object pl)
    en T
     )
 )
 (setq	no (vlax-get pl 'Normal)
pa (fix (vlax-curve-getParamAtPoint pl pt))
p0 (vlax-curve-getPointAtparam pl pa)
p1 (vlax-curve-getPointAtParam pl (1+ pa))
pn (reverse (cdr (reverse (trans pt 0 no))))
cl (vla-Copy pl)
l0 (vlax-get pl 'Coordinates)
l1 (append (sublst l0 1 (* 2 (1+ pa))) pn)
l2 (append pn (sublst l0 (1+ (* 2 (1+ pa))) nil))
ce (if (not (equal pt p0 1e-9))
     (ArcCenterBy3Points (trans p0 0 no) pn (trans p1 0 no))
   )
sp (reverse
     (cdr (reverse (trans (vlax-curve-getStartPoint pl) 0 no)))
   )
 )
 (and (= (vla-get-Closed pl) :vlax-true)
      (setq c	T
     l2	(append l2 sp)
      )
 )
 (repeat (setq	n (if c
	    (fix (vlax-curve-getendParam pl))
	    (fix (1+ (vlax-curve-getendParam pl)))
	  )
  )
   (setq b0 (cons (vla-getBulge pl (setq n (1- n))) b0))
   (vla-GetWidth pl n 'StartWidth 'EndWidth)
   (setq w0 (cons (list StartWidth EndWidth) w0))
 )
 (setq bp (nth pa b0))
 (if ce
   (progn
     (setq a1 (- (angle ce pn) (angle ce (trans p0 0 no)))
    a2 (- (angle ce (trans p1 0 no)) (angle ce pn))
     )
     (if (minusp bp)
(foreach a '(a1 a2)
  (if (< 0 (eval a))
    (set a (- (eval a) (* 2 pi)))
  )
)
(foreach a '(a1 a2)
  (if (< (eval a) 0)
    (set a (+ (eval a) (* 2 pi)))
  )
)
     )
   )
 )
 (setq	b1 (append
     (if (zerop pa)
       nil
       (sublst b0 1 pa)
     )
     (if ce
       (list (Angle2Bulge a1))
       (list bp)
     )
   )
b2 (append
     (if ce
       (list (Angle2Bulge a2))
       (list bp)
     )
     (sublst b0 (+ 2 pa) nil)
   )
wp (if (equal pt p0 1e-9)
     (car (nth pa w0))
     (+	(car (nth pa w0))
	(* (- (cadr (nth pa w0)) (car (nth pa w0)))
	   (/ (- (vlax-curve-getDistAtPoint pl pt)
		 (vlax-curve-getDistAtParam pl pa)
	      )
	      (- (vlax-curve-getDistAtParam pl (1+ pa))
		 (vlax-curve-getDistAtParam pl pa)
	      )
	   )
	)
     )
   )
w1 (append (if (zerop pa)
	     nil
	     (sublst w0 1 pa)
	   )
	   (list (list (car (nth pa w0)) wp))
   )
w2 (append (list (list wp (cadr (nth pa w0))))
	   (sublst w0 (+ 2 pa) nil)
   )
 )
 (if c
   (progn
     (vla-put-Closed pl :vlax-false)
     (vla-put-Closed cl :vlax-false)
   )
 )
 (mapcar '(lambda (p l b w)
     (vlax-put p 'Coordinates l)
     (repeat (setq n (length B))
       (vla-SetBulge p (setq n (1- n)) (nth n B))
     )
     (repeat (setq n (length w))
       (vla-SetWidth
	 p
	 (setq n (1- n))
	 (car (nth n w))
	 (cadr (nth n w))
       )
     )
   )
  (list pl cl)
  (list l1 l2)
  (list b1 b2)
  (list w1 w2)
 )
 (if en
   (list (vlax-vla-object->ename pl)
  (vlax-vla-object->ename pl)
   )
   (list pl cl)
 )
) [/surligneur]

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

lecrabe · le 19 juillet 2007

Bonsoir Gilles

Super !

Demain je vais essayer de tester sur les versions 2004 / 2005 / 2006 !

Le Decapode (tripatouillant son AutoCAD 2005)

lecrabe · le 20 juillet 2007

Hello Gilles

Sur mon AutoCAD / MAP 2005, voilà le résultat:

Debut >>>>>

Commande: corridor

Numéroter les boites ? [Oui/Non] :

Entrez le numéro de départ : 101

Spécifiez la hauteur de texte : 0.5

Sélectionner une polyligne:

Longueur des boites : 6

Longueur des boites : 2

; erreur: une exception s'est produite: 0xC0000005 (Violation d'accès)

; avertissement: fonction unwind ignorée erreur inconnue

L'erreur est identique que la polyligne soit close ou non !

Il dessine les 2 décalages et se casse la figure tout de suite avec une ligne qui part du dernier point du dernier décalage (sans doute) pour aller à peu près au milieu du 1er segment du 1er décalage !

Aucune boîte n'est dessinée

Même problème avec ou sans la numérotation !!

Désolé, Le Decapode

(gile) · le 20 juillet 2007

Merci pour le test, donc, pour les versions antérieures à 2005, conserver l'ancienne version...

lecrabe · le 20 juillet 2007

Hello Gilles

Pour les versions antérieures à QUOI ?

Je ne comprend plus ...

L'ancienne version fonctionne t-elle sur TOUTES les versions ?

et Avec ou Sans la numérotation ?

La nouvelle version fonctionne sur 2007 / 2008 ?

Avec ou Sans la numérotation ?

Mais elle est plus performante, si j'ai bien entendu ...

Le Decapode "indécis"

[Edité le 20/7/2007 par lecrabe]

(gile) · le 21 juillet 2007

Pour 2007/2008 on peut utiliser, dand le LISP corridor, la routine CutPlineAtPoint (surlignée) donnée ci-dessus (réponse 11).

Sinon, il faut la remplacer dans le LISP ci-dessus par celle-là :

;;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;;
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)

(defun CutPlineAtPoint (pl pt / ec vl lst)
(vl-load-com)
(and (= (type pl) 'VLA-OBJECT)
(setq pl (vlax-vla-object->ename pl)
vl T
)
)
(cond
((equal pt (vlax-curve-getEndPoint pl) 1e-9)
(setq lst (list pl nil))
)
((equal pt (vlax-curve-getStartPoint pl) 1e-9)
(setq lst (list nil pl))
)
((null (vlax-curve-getParamAtPoint pl pt))
(setq lst (list pl nil))
)
(T
(setq ec (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-cmdf "_.break" pl "_non" (trans pt 0 1) "_non" "@")
(setvar "cmdecho" ec)
(setq lst (list pl (entlast)))
)
)
(if vl
(mapcar '(lambda (x)
(if x
(vlax-ename->vla-object x)
)
)
lst
)
lst
)
)

création d\'intersection et reconstitution de contour

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante