Interrompre un tuyau 2D

[usegomme]

Routine pour interrompre un tuyau 2 D et dégager l'arriere plan

 
;;; COUPTUB.LSP
;; Usegomme
(defun ercptub ()
 (setvar "pickstyle" groupobj) ; groupe objet restore
 (setvar "osmode" osm)
 (setvar "clayer" clay)
 (setq osm nil ok nil clay nil npl nil groupobj nil)
 (setvar "cmdecho" 1)
 (setq *error* m:err m:err nil)
 (princ)
)

(defun profcoup (pt av ah )
 (setq pa  pt)
 (setq pb ( polar (polar pa av (* 0.18 d2)) ah (* 0.18 d2)))
 (setq pc ( polar (polar pa av (* 0.5 d2)) ah (* 0.25 d2)))
 (setq pd ( polar (polar pa av (* 0.82 d2)) ah (* 0.18 d2)))
)

(defun inscoupure (pt1 pt2 pt3 ang1 ang2 ang3 ang4) 
 (command "_pline")
 (profcoup  pt1 ang1 ang2 )
 (command "_none" pa "_none" pb "_none" pc "_none" pd )
 (profcoup  pt2 ang1 ang3)
 (command "_none" pa "_none" pb "_none" pc "_none" pd )
 (profcoup  pt3 ang4 ang2)
 (command "_none" pa "_none" pb "_none" pc "_none" pd )
 (command pt2 "")
)

(defun c:COUPTUB (/ sel1 ent1 lent typent p1 p2 p3 d2             
                  sel3 d3 a1 a2 p4 p5 p6 sel2 ent2
                  ent3 ent4 sel4 ok)
 (setq m:err *error* *error* ercptub)
 (setq osm (getvar "osmode" ))
 (setq clay (getvar "clayer" ))
 (setq groupobj (getvar "pickstyle"))
 (setq pw (getvar "plinewid"))
 (while
   (setq sel1 (entsel "\n Pointer Generatrice Exterieure Tube : \n"))
   (setq ent1 (car sel1))
   (setq lent (entget ent1))
   (setq npl (cdr (assoc 8 lent)))
   (setq typent (cdr (assoc 0 lent)))
   (if(or (= typent "LINE") (= typent "LWPOLYLINE")(= typent "POLYLINE")
       (= typent "SPLINE")(= typent "ELLIPSE")(= typent "TRACE")
       (= typent "ARC")(= typent "CIRCLE")
     )
     (progn
       (command "_undo" "_be")
       (setvar "cmdecho" 0)
       (setvar "pickstyle" 0) ; groupe inactif
       (setq p1 (cadr sel1))
       (setq p1 (osnap p1 "_near"))
       (setvar "osmode" 128)
       (setq p2 (getpoint p1 "\n 1 er Point sur Axe Tube :"))
       (setq sel3 (ssget p2))
       (if sel3
         (progn
           (setq ent3 (ssname sel3 0))
           (setq typent (cdr (assoc 0 (entget ent3))))
           (if (or (= typent "LINE") (= typent "POLYLINE")(= typent "LWPOLYLINE")
               (= typent "SPLINE")(= typent "ELLIPSE")(= typent "TRACE")
               (= typent "ARC")(= typent "CIRCLE")
             )
             (progn
               (setvar "osmode" 512)
               (setq p3 (getpoint p2 "\n 2 eme Point sur Axe Tube :"))
               (setq sel4 (ssget p3))
               (if sel4
                 (setq ok T)
                 ;   (progn
                 ;    (setq ent4 (ssname sel4 0))
                 ;    (if (equal ent3 ent4) (setq ok T) (setq ok nil))
                 ;   )
                 (setq ok nil)
               )               
               (setq d2 (distance p1 p2))
               (setq d3 (distance p2 p3))
               (setq a1 (angle p1 p2))
               (setq a2 (angle p2 p3))
               (setq p4 (polar p1 a2 d3))
               (setq p5 (polar p2 a1 d2))
               (setq p6 (polar p5 a2 d3))
               (setq sel2 (ssget p5))              
               (if sel2
                 (progn
                   (setq ent2 (ssname sel2 0))
                   (setq typent (cdr (assoc 0 (entget ent2))))
                   (cond
                     (
                       (or (= typent "LINE") (= typent "POLYLINE")(= typent "LWPOLYLINE")
                         (= typent "SPLINE")(= typent "ELLIPSE")(= typent "TRACE")
                         (= typent "ARC")(= typent "CIRCLE")
                       )
                       (command "_break" ent1 "_none" p1 "_none" p4 )
                       (command "_break" ent2 "_none" p5 "_none" p6 )
                       (command "_break" ent3 "_none" p2 "_none" p3 )
                       (setvar "plinewid" 0)
                       (setvar "clayer" npl)
                       (setq a3 (+ a2 pi))
                       (setq a4 (+ a1 pi))
                       (if ok (inscoupure p6 p3 p4 a4 a3 a2 a1))                    
                       (inscoupure p1 p2 p5 a1 a2 a3 a4)
                       (command "_undo" "_e")                      
                     )
                   )
                 )
               )
             )
           )
         )
       )     
     )
   )
 )
 (ercptub)
)