Commande Diviser...

jalna · le 26 juillet 2006

Bonjour,

La commande diviser manque à mon avis d'options...

Je m'explique:

J'ai une ligne de longueur "x" que je veu diviser de maniere à avoir

une longueur qui s'approche d'une longueur que j'ai besoin...

Bon pas tres clair!!

Admettons que dois diviser une longueur de 365 cm par 10 je sais que je

vais avoir des segments de 36.5 cm (logique), mais si je veu des longueurs

s'approchant de 45, alors la ca se complique.... (a part faire des éssais ou de mesurer...)

Alors pour résumer, il faudrait avoir un mixe de Mesurer-Diviser!!

:casstet: J'ai été clair?!?!

BIM G CO · le 26 juillet 2006

je prends comme hypothèse que ce que tu veuille diviser soit une "ligne"

code DXF (0 . "LINE")

début d'explication je te laisse chercher la suite :-)

;;; Prise des paramètres
(princ "\nCliquez sur la ligne ")
(setq Maligne (entsel))
(setq Nb (getint "\nEn combien de segment celle-ci doit être divisée ? "))
;;; Affichage de l'entité sélectionnée
(princ "La ligne est ") (princ Maligne) (princ "\n")
;;; Développement de l'entité
(setq MaligneDev (entget Maligne))
(princ MaligneDev)
;;; Affichage du X,Y,Z dans le SCG du départ de la ligne
(princ (cdr (assoc 10 MaligneDev)))
;;; Affichage du X,Y,Z dans le SCG de la fin de la ligne
(princ (cdr (assoc 11 MaligneDev)))
;;;
...
(command "_DIVIDE" Maligne Nb)
...
;;;
(princ)

jalna · le 26 juillet 2006

Merci Maximilien

Mais je suis dans le forum "AutoCAD, liste de souhaits".

:casstet: Je ne connais pas le Lisp!!

:P Peut etre un jour!!

Tramber · le 26 juillet 2006

Ce que je reproche à DIVISER, c'est de projeter systématiquement sur le SC en cours.

Ca n'est pas une commande 3D et c'est regrettable.

bonuscad · le 26 juillet 2006

Tramber ton souhait m'a donné une idée ;)

Je l'ai fais pour la commande mesurer (on pourrait faire de même pour diviser!) :exclam:

Testé assez rapidement, mais ça à l'air de fonctionner

Si ça peut te rendre service

(defun z_dir (p1 p2 / )
(trans
	'(0.0 1.0 0.0)
	(mapcar
		'(lambda (k)
			(/ k
				(sqrt
					(apply '+
						(mapcar
							'(lambda (x) (* x x))
							(mapcar '- p2 p1)
						)
					)
				)
			)
		)
		(mapcar '- p2 p1)
	)
	0
)
)
(defun c:my_divide-measure ( / js ent vla_obj perim_obj why flag name_blk len_vtx d_x param_pt pt_first pt_snd dxf_210)
(vl-load-com)
(princ "\nChoix de l'objet à mesurer/diviser: ")
(while
	(not
		(setq js
			(ssget "_+.:E:S"
				(list
					(cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
					(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
					(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
					(cons -4 "< NOT")
					(cons -4 "&") (cons 70 112)
					(cons -4 "NOT>")
				)
			)
		)
	)
)
(setq
	ent (ssname js 0)
	vla_obj (vlax-ename->vla-object ent)
	perim_obj (vlax-curve-getDistAtParam vla_obj (vlax-curve-getEndParam vla_obj))
)
(initget "Mesurer Diviser _Measure Divide")
(if (eq (getkword "\n[Mesurer/Diviser] l'objet? : ") "Divide")
	(progn
		(initget 7 "Bloc _Block")
		(setq why (getint "\nEntrez le nombre de segments ou [bloc]: ") flag T)
	)
	(progn
		(initget 7 "Bloc _Block")
		(setq why (getdist "\nSpécifiez la longueur du segment ou [bloc]: ") flag nil)
	)
)
(cond
	((eq why "Block")
		(while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nNom du bloc: " T))))
			(princ "\nNom de bloc **incorrect**")
		)
		(initget 7)
		(if flag
			(setq len_vtx (getint "\nEntrez le nombre de segments: "))
			(setq len_vtx (getdist "\nSpécifiez la longueur du segment: "))
		)
	)
	(T
		(setq len_vtx why)
	)
)
(setq d_x 0.0)
(while (< d_x perim_obj)
	(setq
		param_pt (vlax-curve-getParamAtPoint vla_obj (vlax-curve-getPointAtDist vla_obj d_x))
		pt_first (vlax-curve-getPointAtParam vla_obj (fix param_pt))
		pt_snd (vlax-curve-getPointAtParam vla_obj (1+ (fix param_pt)))
		dxf_210 (z_dir pt_first pt_snd)
	)
	(if (null pt_snd)
		(setq pt_snd (vlax-curve-getEndPoint vla_obj))
	)
	(setq dxf_210 (z_dir pt_first pt_snd))
	(cond
		((eq why "Block")
			(entmake
				(list
					(cons 0 "INSERT")
					(cons 100 "AcDbEntity")
					(assoc 67 (entget ent))
					(assoc 410 (entget ent))
					(cons 8 (getvar "CLAYER"))
					(cons 100 "AcDbBlockReference")
					(cons 2 name_blk)
					(cons 10 (trans (vlax-curve-getPointAtDist vla_obj d_x) 0 dxf_210))
					(cons 210 dxf_210)
				)
			)
		)
		(T
			(entmake
				(list
					(cons 0 "POINT")
					(cons 100 "AcDbEntity")
					(assoc 67 (entget ent))
					(assoc 410 (entget ent))
					(cons 8 (getvar "CLAYER"))
					(cons 100 "AcDbPoint")
					(cons 10 (vlax-curve-getPointAtDist vla_obj d_x))
					(cons 210 (list 0.0 0.0 1.0))
				)
			)
		)
	)
	(if flag
		(setq d_x (+ d_x (/ perim_obj len_vtx)))
		(setq d_x (+ d_x len_vtx))
	)
)
(prin1)
)

NB : Comme d'hab. enlever l'espace après "< NOT"

[Edité le 26/7/2006 par bonuscad]

didier · le 26 juillet 2006

Bonjour, à Toutes et à Tous,

Que veux tu dire Tramber ?

je divise et mesure souvent des objets 3D,

et le résultat est correct,

me trompé-je ?

amicalement

bonuscad · le 26 juillet 2006

Je pense, après avoir essayé justement de comprendre, que cela concerne surtout la commande diviser ou mesurer avec l'option bloc.

En effet le bloc ne suit pas correctement le chemin malgré l'option "aligner avec l'objet" et ceux-ci sont parfois projeté sur le scu courant.

NB: j'édite mon post précédent pour une commande similaire à mesurer ou diviser qui donne des résultats tout à fait différent (avec l'option bloc) que les commandes classiques.

rebcao · le 27 juillet 2006

Mais quand pourront nous enfin choisir le NOM du bloc dans une liste déroulante ??? Pour l'instant il faut se taper le NOM !!! :mad:

Encore une commande Préhistorique fossilisée !!! :o

Christian

Tramber · le 27 juillet 2006

et le résultat est correct,

me trompé-je ?

Ben non, j'ai trituré le machin dans tous les sens et, en effet, cela semble avoir été corrigé depuis la version 2000 sur laquelle j'avais constaté d'énormes problèmes avec l'option bloc, en 3D. Tu ne t'es pas trompé. c'est moi.

Là, la seule erreur que j'ai pu trouvé, c'est le refus d'insérer avec l'option bloc le long d'une LWpolyline non définie dans le SCG alors qu'on est justement dans un SCU différent du SCG.

Bref, sur 2004 le comportement est différent, je ne savais pas, j'aurais pu regarder.

Sinon, un truc tout bête, qui ne serait pas superflu, serait que la commande affiche la longueur de l'objet à diviser comme information.

jalna · le 27 juillet 2006

Sinon, un truc tout bête, qui ne serait pas superflu, serait que la commande affiche la longueur de l'objet à diviser comme information.

:P Voila c'est exactement cela!!!!

(gile) · le 29 juillet 2006

Salut à vous,

Voici un LISP qui devrait répondre à quelques demandes ici exprimées.

D'après les tests que j'ai fait, les commandes DIVISER3D et MESURER3D fonctionnent comme DIVISER et MESURER, avec en plus :

- un comportement en 3D qui devrait plus plaire à Tramber (si j'ai bien compris la demande),

- une boite de dialogue pour Rebcao,

- l'affichage de la longueur de l'objet pour Tramber et Jalna.

Version du 01/08/06 11h00

Le fichier DCL à enregistrer sous getblock.dcl dans un dossier du chemin de recherche des fichiers de support.

getblock:dialog{
 label="Sélection de bloc";
 initial_focus="bl";
 :boxed_column{
   label="Choisissez un bloc";
   :popup_list{
     key="bl";
     edit_width=30;
   }
 }
 ok_cancel;
}

et les routines LISP qui vont avec :

;;; DIVISER3D et MESURER3D - Gilles Chanteau - 31/07/06
;;;
;;; Fonctionnement similaire aux commandes DIVISER (_DIVIDE) et MESURER (__MEASURE)
;;; Les plus :
;;; - L'option "Bloc" permet l'insertion de bloc sur des objets 2D quels que soient
;;;   le SCO de l'objet et le SCU courant.
;;; - Une option supplémentaire : "Plan de référence pour l'insertion du bloc ?"
;;;   permet de choisir si le bloc est inséré par rapport au plan XY du SCU courant
;;;   (Scu) ou par rapport à l'objet (Objet).
;;; - Le choix du bloc se fait dans la liste déroulante d'une boite de dialogue.
;;; - La longueur de l'objet sélectionnée est affichée sur la ligne de commande.


;;; Getspace Retourne l'espace courant (Modèle ou Papier)

(defun getSpace	()
 (if (= (getvar "CVPORT") 1)
   (vla-get-PaperSpace
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (vla-get-ModelSpace
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
 )
)

;;; Getblock Retourne le nom du bloc choisi par l'utilisateur dans une
;;; liste déroulante de la boite de dialogue définie dans Getblock.dcl

(defun getblock	(/ bloc lst dcl_id nom)
 (setq bloc (tblnext "BLOCK" T))
 (while bloc
   (setq lst  (cons (cdr (assoc 2 bloc)) lst)
  bloc (tblnext "BLOCK")
   )
 )
 (setq lst (acad_strlsort lst))
 (setq dcl_id (load_dialog "Getblock.dcl"))
 (if (not (new_dialog "getblock" dcl_id))
   (exit)
 )
 (start_list "bl")
 (mapcar 'add_list lst)
 (end_list)
 (action_tile
   "accept"
   (strcat
     "(progn"
     "(setq nom (nth (atoi (get_tile \"bl\")) lst)))"
     "(done_dialog))"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 nom
)

;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points

(defun norm_3pts (p0 p1 p2 / norm)
 (cond
   ((inters p0 p1 p0 p2)
    (foreach p	'(p1 p2)
      (set p (mapcar '- (eval p) p0))
    )
    (setq norm	(list (- (* (cadr p1) (caddr p2)) (* (caddr p1) (cadr p2)))
	      (- (* (caddr p1) (car p2)) (* (car p1) (caddr p2)))
	      (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2)))
	)
   norm	(mapcar	'(lambda (x) (* x (/ 1 (distance '(0 0 0) norm))))
		norm
	)
    )
   )
 )
)

;;; Std_vl_err Redéfinition de *error*

(defun std_vl_err (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)
)

;;; Diviser3D

(defun c:diviser3D (/	   AcDoc  Space	 ucszdir       ent    obj
	    pick   long	  nb	 nom	algn  scu    dist
	    ins_pt deriv1 deriv2 ang	norm   ref
	   )
 (vl-load-com)
 (setq	m:err	*error*
*error*	std_vl_err
 )
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
Space	(getSpace)
ucszdir	(trans '(0 0 1) 1 0 T)
 )
 (sssetfirst nil nil)
 (if (vl-catch-all-error-p
(vl-catch-all-apply
  'vla-getEntity
  (list	(vla-get-Utility AcDoc)
	'obj
	'pick
	"\nChoix de l'objet à diviser: "
  )
)
     )
   (prompt "*Incorrect*")
   (progn
     (if (vl-catch-all-error-p
    (vl-catch-all-apply 'vlax-curve-getEndParam (list obj))
  )
(prompt "\nL'objet ne peut pas être divisé.*Incorrect*")
(progn
  (setq	long (vlax-curve-getDistAtParam
	       obj
	       (vlax-curve-getEndParam obj)
	     )
  )
  (prompt (strcat "\nLongueur de l'objet: " (rtos long)))
  (while (not (> 3268 nb 1))
    (initget "Bloc")
    (setq
      nb (getint "\nEntrez le nombre de segments ou [bloc]: ")
    )
    (if	(numberp nb)
      (if (not (> 3268 nb 1))
	(prompt
	  "\nNécessite un entier entre 2 et 32767, ou une option."
	)
      )
    )
    (if	(= nb "Bloc")
      (progn
	(setq nom (getblock))
	(if nom
	  (setq nb 2)
	  (setq nb 0)
	)
      )
    )
  )
  (if nom
    (progn
      (initget "Oui Non")
      (setq algn
	     (getkword
	       "\nAligner le bloc avec l'objet ? [Oui/Non] : "
	     )
	    nb 0
      )
      (initget "Objet Scu")
      (setq scu
	     (getkword
	       "\nPlan de référence pour l'insertion du bloc ? [Objet/Scu] : "
	     )
      )
      (while (not (> 3268 nb 1))
	(setq nb (getint "\nEntrez le nombre de segments: "))
	(if (not (> 3268 nb 1))
	  (prompt
	    "\nNécessite un entier entre 2 et 32767."
	  )
	)
      )
    )
  )
  (setq dist (/ long nb))
  (vla-StartUndoMark AcDoc)
  (repeat (setq nb (1- nb))
    (setq ins_pt (vlax-curve-getPointAtDist obj (* nb dist))
	  deriv1 (vlax-curve-getFirstDeriv
		   obj
		   (vlax-curve-getParamAtDist obj (* nb dist))
		 )
    )
    (if	(/= scu "Scu")
      (cond
	((member (vla-get-ObjectName obj)
		 '("AcDbArc"	       "AcDbCircle"
		   "AcDbEllipse"       "AcDbPolyline"
		   "AcDb2dPolyline"
		  )
	 )
	 (setq
	   norm	(vlax-safearray->list
		  (vlax-variant-value (vla-get-Normal obj))
		)
	 )
	)
	(T
	 (setq
	   deriv2
	    (vlax-curve-getSecondDeriv
	      obj
	      (vlax-curve-getParamAtDist obj (* nb dist))
	    )
	 )
	 (if (equal '(0 0 0) deriv2)
	   (setq deriv2
		  (trans
		    (polar
		      '(0 0 0)
		      (+ (angle
			   (trans '(0 0 0)
				  0
				  (vlax-vla-object->ename obj)
			   )
			   (trans deriv1
				  0
				  (vlax-vla-object->ename obj)
			   )
			 )
			 (/ pi 2)
		      )
		      1.0
		    )
		    (vlax-vla-object->ename obj)
		    0
		  )
	   )
	 )
	 (setq ang
		(- (angle '(0 0 0) deriv2) (angle '(0 0 0) deriv1))
	 )
	 (if (minusp ang)
	   (setq ang (+ ang (* 2 pi)))
	 )
	 (if
	   (		    (setq norm (norm_3pts '(0 0 0) deriv1 deriv2))
	    (setq norm (norm_3pts '(0 0 0) deriv2 deriv1))
	 )
	)
      )
    )
    (if	nom
      (if (= scu "Scu")
	(vla-InsertBlock
	  Space
	  (vlax-3d-point ins_pt)
	  nom
	  1
	  1
	  1
	  (if (= algn "Non")
	    (angle '(0 0 0)
		   (trans (getvar "UCSXDIR") 0 ucszdir)
	    )
	    (angle '(0 0 0) (trans deriv1 0 ucszdir))
	  )
	)
	(progn
	  (setq	ref
		 (vla-InsertBlock
		   Space
		   (vlax-3d-point '(0 0 0))
		   nom
		   1
		   1
		   1
		   0
		 )
	  )
	  (vla-put-Normal ref (vlax-3d-Point norm))
	  (vla-Move ref
		    (vlax-3d-point '(0 0 0))
		    (vlax-3d-point ins_pt)
	  )
	  (vla-Rotate3d
	    ref
	    (vlax-3d-point ins_pt)
	    (vlax-3d-point (mapcar '+ ins_pt norm))
	    (if	(= algn "Non")
	      (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 norm))
	      (angle '(0 0 0) (trans deriv1 0 norm))
	    )
	  )
	)
      )
      (vla-addPoint
	Space
	(vlax-3d-point
	  (vlax-curve-getPointAtDist obj (* nb dist))
	)
      )
    )
    (setq nb (1- nb))
  )
  (if (vlax-curve-isClosed obj)
    (progn
      (setq ins_pt (vlax-curve-getStartPoint obj)
	    deriv1 (vlax-curve-getFirstDeriv
		     obj
		     (vlax-curve-getStartParam obj)
		   )
      )
      (if (/= scu "Scu")
	(cond
	  ((member (vla-get-ObjectName obj)
		   '("AcDbArc"		 "AcDbCircle"
		     "AcDbEllipse"	 "AcDbPolyline"
		     "AcDb2dPolyline"
		    )
	   )
	   (setq
	     norm (vlax-safearray->list
		    (vlax-variant-value (vla-get-Normal obj))
		  )
	   )
	  )
	  (T
	   (setq
	     deriv2
	      (vlax-curve-getSecondDeriv
		obj
		(vlax-curve-getParamAtDist obj (* nb dist))
	      )
	   )
	   (if (equal '(0 0 0) deriv2)
	     (setq deriv2
		    (trans
		      (polar
			'(0 0 0)
			(+ (angle
			     (trans '(0 0 0)
				    0
				    (vlax-vla-object->ename obj)
			     )
			     (trans deriv1
				    0
				    (vlax-vla-object->ename obj)
			     )
			   )
			   (/ pi 2)
			)
			1.0
		      )
		      (vlax-vla-object->ename obj)
		      0
		    )
	     )
	   )
	   (setq ang
		  (- (angle '(0 0 0) deriv2) (angle '(0 0 0) deriv1))
	   )
	   (if (minusp ang)
	     (setq ang (+ ang (* 2 pi)))
	   )
	   (if
	     (		      (setq norm (norm_3pts '(0 0 0) deriv1 deriv2))
	      (setq norm (norm_3pts '(0 0 0) deriv2 deriv1))
	   )
	  )
	)
      )
      (if nom
	(if (= scu "Scu")
	  (vla-InsertBlock
	    Space
	    (vlax-3d-point ins_pt)
	    nom
	    1
	    1
	    1
	    (if	(= algn "Non")
	      (angle '(0 0 0)
		     (trans (getvar "UCSXDIR") 0 ucszdir)
	      )
	      (angle '(0 0 0) (trans deriv1 0 ucszdir))
	    )
	  )
	  (progn
	    (setq ref
		   (vla-InsertBlock
		     Space
		     (vlax-3d-point '(0 0 0))
		     nom
		     1
		     1
		     1
		     0
		   )
	    )
	    (vla-put-Normal ref (vlax-3d-Point norm))
	    (vla-Move ref
		      (vlax-3d-point '(0 0 0))
		      (vlax-3d-point ins_pt)
	    )
	    (vla-Rotate3d
	      ref
	      (vlax-3d-point ins_pt)
	      (vlax-3d-point (mapcar '+ ins_pt norm))
	      (if (= algn "Non")
		(angle '(0 0 0)
		       (trans (getvar "UCSXDIR") 0 norm)
		)
		(angle '(0 0 0) (trans deriv1 0 norm))
	      )
	    )
	  )
	)
	(vla-addPoint
	  Space
	  (vlax-3d-point
	    (vlax-curve-getPointAtDist obj (* nb dist))
	  )
	)
      )
    )
  )
  (vla-EndUndoMark AcDoc)
)
     )
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; Mesurer3D

(defun c:mesurer3D
	   (/	    AcDoc   Space   ucszdir obj	    pick
	    long    dist    nom	    algn   scu	    nb
	    rest    ins_pt  deriv1  deriv2  ang	    norm
	    ref
	   )
 (vl-load-com)
 (setq	m:err	*error*
*error*	std_vl_err
 )
 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
Space	(getSpace)
ucszdir	(trans '(0 0 1) 1 0 T)
 )
 (sssetfirst nil nil)
 (if (vl-catch-all-error-p
(vl-catch-all-apply
  'vla-getEntity
  (list	(vla-get-Utility AcDoc)
	'obj
	'pick
	"\nChoix de l'objet à mesurer: "
  )
)
     )
   (prompt "*Incorrect*")
   (progn
     (if (vl-catch-all-error-p
    (vl-catch-all-apply 'vlax-curve-getEndParam (list obj))
  )
(prompt "\nL'objet ne peut pas être mesuré.*Incorrect*")
(progn
  (setq	pick (vlax-curve-getClosestPointToProjection
	       obj
	       (trans (vlax-SafeArray->list pick) 1 0)
	       (mapcar '- (trans (getvar "viewdir") 1 0) (trans '(0 0 0) 1 0))
	     )
	long (vlax-curve-getDistAtParam
	       obj
	       (vlax-curve-getEndParam obj)
	     )
  )
  (prompt (strcat "\nLongueur de l'objet: " (rtos long)))
  (while (and (not (numberp dist)) (not nom))
    (initget 7 "Bloc")
    (setq dist
	   (getint "\nSpécifiez la longueur du segment ou [bloc]: ")
    )
    (if	(= dist "Bloc")
      (setq nom (getblock))
    )
  )
  (if nom
    (progn
      (initget "Oui Non")
      (setq algn
	     (getkword
	       "\nAligner le bloc avec l'objet ? [Oui/Non] : "
	     )
      )
      (initget "Objet Scu")
      (setq scu
	     (getkword
	       "\nPlan de référence pour l'insertion du bloc ? [Objet/Scu] : "
	     )
      )
      (initget 7)
      (setq
	dist (getdist "\nSpécifiez la longueur du segment: ")
      )
    )
  )
  (if (	    (prompt "\nL'objet n'est pas assez long.")
    (progn
      (setq nb (fix (/ long dist)))
      (if
	(		 (setq rest (rem long dist))
	 (setq rest nil)
      )
      (vla-StartUndoMark AcDoc)
      (repeat nb
	(setq ins_pt (if rest
		       (vlax-curve-getPointAtDist
			 obj
			 (+ (* (1- nb) dist) rest)
		       )
		       (vlax-curve-getPointAtDist obj (* nb dist))
		     )
	      deriv1 (vlax-curve-getFirstDeriv
		       obj
		       (if rest
			 (vlax-curve-getParamAtDist
			   obj
			   (+ (* (1- nb) dist) rest)
			 )
			 (vlax-curve-getParamAtDist obj (* nb dist))
		       )
		     )

	)
	(if (/= scu "Scu")
	  (cond
	    ((member (vla-get-ObjectName obj)
		     '("AcDbArc"	   "AcDbCircle"
		       "AcDbEllipse"	   "AcDbPolyline"
		       "AcDb2dPolyline"
		      )
	     )
	     (setq
	       norm
		(vlax-safearray->list
		  (vlax-variant-value (vla-get-Normal obj))
		)
	     )
	    )
	    (T
	     (setq
	       deriv2
		(vlax-curve-getSecondDeriv
		  obj
		  (if rest
		    (vlax-curve-getParamAtDist
		      obj
		      (+ (* (1- nb) dist) rest)
		    )
		    (vlax-curve-getParamAtDist obj (* nb dist))
		  )
		)
	     )
	     (if (equal '(0 0 0) deriv2)
	       (setq deriv2
		      (trans
			(polar
			  '(0 0 0)
			  (+ (angle
			       (trans '(0 0 0)
				      0
				      (vlax-vla-object->ename obj)
			       )
			       (trans deriv1
				      0
				      (vlax-vla-object->ename obj)
			       )
			     )
			     (/ pi 2)
			  )
			  1.0
			)
			(vlax-vla-object->ename obj)
			0
		      )
	       )
	     )
	     (setq ang
		    (- (angle '(0 0 0) deriv2)
		       (angle '(0 0 0) deriv1)
		    )
	     )
	     (if (minusp ang)
	       (setq ang (+ ang (* 2 pi)))
	     )
	     (if
	       (			(setq norm (norm_3pts '(0 0 0) deriv1 deriv2))
		(setq norm (norm_3pts '(0 0 0) deriv2 deriv1))
	     )
	    )
	  )
	)
	(if nom
	  (if (= scu "Scu")
	    (vla-InsertBlock
	      Space
	      (vlax-3d-point ins_pt)
	      nom
	      1
	      1
	      1
	      (if (= algn "Non")
		(angle '(0 0 0)
		       (trans (getvar "UCSXDIR") 0 ucszdir)
		)
		(angle '(0 0 0) (trans deriv1 0 ucszdir))
	      )
	    )
	    (progn
	      (setq ref
		     (vla-InsertBlock
		       Space
		       (vlax-3d-point '(0 0 0))
		       nom
		       1
		       1
		       1
		       0
		     )
	      )
	      (vla-put-Normal ref (vlax-3d-Point norm))
	      (vla-Move	ref
			(vlax-3d-point '(0 0 0))
			(vlax-3d-point ins_pt)
	      )
	      (vla-Rotate3d
		ref
		(vlax-3d-point ins_pt)
		(vlax-3d-point (mapcar '+ ins_pt norm))
		(if (= algn "Non")
		  (angle '(0 0 0)
			 (trans (getvar "UCSXDIR") 0 norm)
		  )
		  (angle '(0 0 0) (trans deriv1 0 norm))
		)
	      )
	    )
	  )
	  (vla-addPoint Space (vlax-3d-point ins_pt))
	)
	(setq nb (1- nb))
      )
      (vla-EndUndoMark AcDoc)
    )
  )
)
     )
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 30/7/2006 par (gile)][Edité le 30/7/2006 par (gile)][Edité le 31/7/2006 par (gile)][Edité le 31/7/2006 par (gile)]

[Edité le 1/8/2006 par (gile)]

(gile) · le 30 juillet 2006

J'ai amélioré la routine ci dessus, il est désormais possible de spécifier si le bloc doit être inséré par rapport au plan XY du SCU courant ou par rapport au plan de l'objet.

http://img153.imageshack.us/img153/8263/diviserfg4.png

J'ai réparé un bug avec les splines, le bloc s'insérait à l'envers suivant la concavité ou convexité de la spline.

http://img163.imageshack.us/img163/4883/diviser2dg5.png

[Edité le 30/7/2006 par (gile)]

(gile) · le 31 juillet 2006

je divise et mesure souvent des objets 3D,
et le résultat est correct,

me trompé-je ?

Les commandes DIVSER et MESURER n'ont pas un comportement très rigoureux en 3D suivant le type d'entité sélectionné (notamment avec les ellipses) et le SCU courant.

Petits exemples illustrés :

Dans le SCU (non parallèle au SCG) dans lequel a été créée l'ellipse, les blocs s'insèrent suivant le SCG et à côté de l'ellipse.

http://img143.imageshack.us/img143/3073/diviser5wq9.png

Dans un SCU (non parallèle au SCG) différent de celui dans lequel ont été créées l'ellipse et le cercle, les blocs s'insèrent suivant le SCU sur l'ellipse et suivant l'objet sur le cercle.

http://img154.imageshack.us/img154/9682/diviser4my3.png

(gile) · le 31 juillet 2006

Il y avait encore un bug dans le LISP avec les lignes et les portions droites de polyligne (dérivée seconde = (0.0 0.0 0.0).

Je pense l'avoir réparé.

Merci de me prévenir en cas de dysfonctionnements.

jalna · le 31 juillet 2006

Ok Merci gile....

J'aimerais éssayer ce lisp mais je suis pas tres fort sur les lisp...

J'ai enregistré sous getblock.dcl (boite de dialogue) dans un dossier du chemin de recherche des fichiers de support

Mais pour le lisp, la je seche, quel est la fonction pour lancer le programme!!

Désolé d'etre si nul!!!

:P En tous cas un grand merci par avance!!

(gile) · le 31 juillet 2006

Salut,

Tu enregistres le fichier : le_nom_que_tu_veux.lsp

Puis,

- soit tu le fais glisser directment de l'explorer vers la fenêtre d'AutoCAD,

- soit tu tapes APPLOAD et tu charges le fichier (tu peux le mettre dans la "valise" Au démarrage si tu veux qu'il soit chargé à chaque démarrage d'AutoCAD),

- soit tu copies le code dans ton fichier .MNL courant (acd.mnl par défaut) ou dans le fichier AutoCAD.lsp ou acaddoc.lsp,

- soit, si le fichier est enrgistré dans un dossier du chemin de recherche des fichiers de support, tu tapes (load "le_nom_que_tu_veux.lsp"), ou tu ajoutes cette ligne dans le fichier .MNL ou encore (autoload "le_nom_que_tu_veux.lsp" '("diviser3d" "mesurer3d")) qui ne chargeras le LISP que quand tu taperas mesurer3d ou diviser3d à la ligne de commande...

Attention, il est possible qu'il y ait des modifications, la programmation en 3D n'est pas évidente pour moi, il reste peut-être des "bugs" (voir la date et l'heure de la version).

(gile) · le 31 juillet 2006

Le LISP est encore amélioré, il ne reste que l'insertion de bloc sur les lignes et polylignes 3D avec l'option "Objet" pour le plan de référence qui peuvent produire des résultats pas très cohérents en ce qui concene le plan de référence, justement.

Bilbeau · le 5 novembre 2006

C'est clair que Diviser et Mesurer sont restées les mêmes depuis Autocad 10 je crois, alors qu'il y a plein d'options qui pourraient venir s'y coller :

- appliquer une selection dans le repère courant et avec un point de base et non seulement un bloc ou un point.

- découper l'entité qu'on mesure ou divise.

- appliquer non seulement un point mais un ségment orienté de découpe sur les polylignes avec largeur...

nicoping28 · le 14 septembre 2007

"découper l'entité qu'on mesure ou divise."

Ce sujet a t il été exploré?

Connexion

Commande Diviser...

Messages recommandés

jalna

BIM G CO

jalna

Tramber

bonuscad

didier

bonuscad

rebcao

Tramber

jalna

(gile)

(gile)

(gile)

(gile)

jalna

(gile)

(gile)

Bilbeau

nicoping28

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante