Salut,
Voici un LISP qui permet de faire de solides ou des surfaces débillardés avec les versions 2007 et postérieures.
Le LISP répartit des "coupes" sur le chemin spécifié et fait un lissage suivant ces coupes et ce chemin.
La "coupe" doit être une entité 2D unique composant d'un bloc. Attention au moment de la création du bloc à l'orientation de l'entité par rapport au SCU, c'est l'axe des X du SCO du bloc qui tangentera avec la projection du chemin sur le plan XY du SCU courant.
Après avoir sélectionné le bloc dans la liste déroulante, spécifé le chemin et le nombre de coupes, les blocs sont insérés et explosés et sélectionnés dans l'ordre pour le lissage :
Code:
;;; C:DEBIL (gile)
;;; Crée un solide ou une surface "débillardé" à partir d'un profil de coupe
;;; et d'un chemin.
;;; Le profil doit être une unique entité 2D contenue dans un bloc.
;;; Loft_along_path Créé un lissage d'après une liste de coupes et un chemin
;;; Fonctionne avec COMMAND dans l'attente d'une fonction vla-...
(defun loft_along_path (lst path / echo)
(setq echo (getvar "CMDECHO"))
(grtext -2 "Création du lissage en cours.")
(setvar "CMDECHO" 0)
(command "_.loft")
(mapcar 'command lst)
(command "" "_path" path)
(setvar "CMDECHO" echo)
)
;;; Fonction principale
(defun c:debil (/ Space *error* ucszdir nom sect path
nb obj dist ins_pt deriv1 ref lst
)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
(defun *error* (msg)
(if (or
(= msg "Fonction annulée")
(= msg "quitter / sortir abandon")
)
(princ)
(princ (strcat "\nErreur: " msg))
)
(vla-endundomark *acdoc*)
(princ)
)
(setq Space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
)
ucszdir (trans '(0 0 1) 1 0 T)
)
(sssetfirst nil nil)
(vla-StartUndoMark *acdoc*)
(if (setq nom (getblock nil))
(if
(and
(setq bloc_def (vla-Item (vla-get-Blocks *acdoc*) nom))
(= (vla-get-Count bloc_def) 1)
(or
(member (vla-get-ObjectName (setq sect (vla-Item bloc_def 0)))
'("AcDbArc" "AcDbCircle"
"AcDbEllipse" "AcDbLine"
"AcDbPolyline" "AcDb2dPolyline"
)
)
(and (= (vla-get-ObjectName sect) "AcDbSpline")
(= :vlax-true (vla-get-isPlanar sect))
)
)
)
(progn
(while
(not
(and
(setq path (car (entsel "\nChoix du chemin: "))
obj (vlax-ename->vla-object path)
)
(not (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-curve-getEndParam
(list obj)
)
)
)
)
)
)
(initget 7)
(setq nb (getint "\nEntrez le nombre de coupes: "))
(setq dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
nb
)
)
(repeat (setq nb (1- nb))
(setq ins_pt (vlax-curve-getPointAtDist obj (* nb dist)))
(setq deriv1 (vlax-curve-getFirstDeriv
obj
(vlax-curve-getParamAtDist obj (* nb dist))
)
)
(setq ref
(vla-InsertBlock
Space
(vlax-3d-point ins_pt)
nom
1
1
1
(angle '(0 0 0) (trans deriv1 0 ucszdir))
)
)
(setq lst (append (vlax-invoke ref 'explode) lst))
(vla-delete ref)
(setq nb (1- nb))
)
(setq ins_pt (vlax-curve-getStartPoint obj)
deriv1 (vlax-curve-getFirstDeriv
obj
(vlax-curve-getStartParam obj)
)
)
(setq ref
(vla-InsertBlock
Space
(vlax-3d-point ins_pt)
nom
1
1
1
(angle '(0 0 0) (trans deriv1 0 ucszdir))
)
)
(setq lst (append (vlax-invoke ref 'explode) lst))
(vla-delete ref)
(if (or
(member (vla-get-Objectname obj)
'("AcDbArc" "AcDbHelix" "AcDbLine")
)
(and (= (vla-get-Objectname obj) "AcDbEllipse")
(or
(/= (vla-get-StartAngle obj) 0.0)
(/= (vla-get-EndAngle obj) (* 2 pi))
)
)
(and (member (vla-get-Objectname obj)
'("AcDbPolyline"
"AcDb2dPolyline"
"AcDb3dPolyline"
"AcDbSpline"
)
)
(and
(= :vlax-false (vla-get-Closed obj))
(not (equal (vlax-curve-getStartPoint obj)
(vlax-curve-getEndPoint obj)
1e-9
)
)
)
)
)
(progn
(setq ins_pt (vlax-curve-getEndPoint obj)
deriv1 (vlax-curve-getFirstDeriv
obj
(vlax-curve-getEndParam obj)
)
)
(setq ref
(vla-InsertBlock
Space
(vlax-3d-point ins_pt)
nom
1
1
1
(angle '(0 0 0) (trans deriv1 0 ucszdir))
)
)
(setq lst
(append lst (vlax-invoke ref 'explode))
)
(vla-delete ref)
)
)
(if (<= 17 (read (substr (getvar "ACADVER") 1 4)))
(loft_along_path (mapcar 'vlax-vla-object->ename lst) path)
(alert
"La commande LISSAGE (_LOFT) n'est pas accessible aux versions antérieures à 2007"
)
)
(setvar "INSNAME" nom)
)
(prompt "\nLe bloc ne doit contenir qu'une seule entité 2D."
)
)
)
(vla-EndUndoMark *acdoc*)
(princ)
)
;;; Getblock (gile) 03/11/07
;;; Retourne le nom du bloc entré ou choisi par l'utilisateur
;;; dans une liste déroulante de la boite de dialogue ou depuis la boite
;;; de dialogue standard d'AutoCAD
;;; Argument : le titre (string) ou nil (défaut : "Choisir un bloc")
(defun getblock (titre / bloc n lst tmp file what_next dcl_id nom)
(while (setq bloc (tblnext "BLOCK" (not bloc)))
(setq lst (cons (cdr (assoc 2 bloc)) lst)
)
)
(setq lst (acad_strlsort
(vl-remove-if
(function (lambda (n) (= (substr n 1 1) "*")))
lst
)
)
tmp (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
)
(write-line
(strcat
"getblock:dialog{label="
(cond (titre (vl-prin1-to-string titre))
("\"Choisir un bloc\"")
)
";initial_focus=\"bl\";:boxed_column{
:row{:text{label=\"Sélectionner\";alignment=left;}
:button{label=\">>\";key=\"sel\";alignment=right;fixed_width=true;}}
spacer;
:column{:button{label=\"Parcourir...\";key=\"wbl\";alignment=right;fixed_width=true;}}
:column{:text{label=\"Nom :\";alignment=left;}}
:edit_box{key=\"tp\";edit_width=25;}
:popup_list{key=\"bl\";edit_width=25;}spacer;}
spacer;
ok_cancel;}"
)
file
)
(close file)
(setq dcl_id (load_dialog tmp))
(setq what_next 2)
(while (>= what_next 2)
(if (not (new_dialog "getblock" dcl_id))
(exit)
)
(start_list "bl")
(mapcar 'add_list lst)
(end_list)
(if (setq n (vl-position
(strcase (getvar "INSNAME"))
(mapcar 'strcase lst)
)
)
(setq nom (nth n lst))
(setq nom (car lst)
n 0
)
)
(set_tile "bl" (itoa n))
(action_tile "sel" "(done_dialog 5)")
(action_tile "bl" "(setq nom (nth (atoi $value) lst))")
(action_tile "wbl" "(done_dialog 3)")
(action_tile "tp" "(setq nom $value) (done_dialog 4)")
(action_tile
"accept"
"(setq nom (nth (atoi (get_tile \"bl\")) lst)) (done_dialog 1)"
)
(setq what_next (start_dialog))
(cond
((= what_next 3)
(if (setq nom (getfiled "Sélectionner un fichier" "" "dwg" 0))
(setq what_next 1)
(setq what_next 2)
)
)
((= what_next 4)
(cond
((not (read nom))
(setq what_next 2)
)
((tblsearch "BLOCK" nom)
(setq what_next 1)
)
((findfile (setq nom (strcat nom ".dwg")))
(setq what_next 1)
)
(T
(alert (strcat "Le fichier \"" nom "\" est introuvable."))
(setq nom nil
what_next 2
)
)
)
)
((= what_next 5)
(if (and (setq ent (car (entsel)))
(= "INSERT" (cdr (assoc 0 (entget ent))))
)
(setq nom (cdr (assoc 2 (entget ent)))
what_next 1
)
(setq what_next 2)
)
)
((= what_next 0)
(setq nom nil)
)
)
)
(unload_dialog dcl_id)
(vl-file-delete tmp)
nom
)
Exemple avec une main courante d'escalier :
Comment faire un serpentin en 3D avec AutoCAD
Re: Comment faire un serpentin en 3D avec AutoCAD
Re: Comment faire un serpentin en 3D avec AutoCAD
)
Posting Permissions
Reply With Quote