Tracer calorifuge sur tuyau 2 d

[usegomme]

Routine pour dessiner un bout de calo sur un tuyau 2 D

 
;; CALO.LSP   Usegomme
(defun ercalo (msg)
(setvar "osmode" osm)
(setvar "pickstyle" groupobj) ; groupe objet restore
(setq osm nil groupobj nil)
(setvar "cmdecho" 1)
(setq *error* m:err m:err nil)
(princ)
)

(defun inscalo (/ pw)
(command "_undo" "_be")
(command "_break" ent1 pb pe2 )
(command "_break" ent2 pe pb2 )
(command "_line" p1b p4b "")
(command "_line" p5b p6b "")
(setq pw (getvar "plinewid"))
(setvar "plinewid" 0)
(command "_pline" pc pd p1b pa pb pe pf p5b "")
(command "_pline" pc2 pd2 p6b pa2 pb2 pe2 pf2 p4b "")
(setvar "plinewid" pw)
(command "_undo" "_e")
)

(defun defptcalo (/ x)
(cond
 ((>= d2 45) (setq x 1.0))
 ((< d2 24) (setq x 0.6))
 ((< d2 30) (setq x 0.7))
 ((< d2 38) (setq x 0.8))
 ((< d2 45) (setq x 0.9))
)

(setq p1b (polar p2 (+ a1 pi) d))
(setq p4b (polar p3 (+ a1 pi) d))
(setq p5b (polar p2 a1 d))
(setq p6b (polar p3 a1 d))

(setq pb (polar p1 a2 (* x (* 0.5 d1))))
(setq pa (polar (polar p1 (+ a1 pi)(* 0.6 d1)) a2 (* x (* 0.45 d1))))
(setq pc (polar pb (+ a2 pi) (* x d1)))
(setq pd (polar pa (+ a2 pi) (* x (* 0.9 d1))))
(setq pe (polar pc a1 (* 2 d2)))
(setq pf (polar pd a1 (+ (* 2 d2)(* 1.2 d1))))

(setq pf2 (polar pa a2 d3))
(setq pe2 (polar pb a2 d3))
(setq pb2 (polar pe a2 d3))
(setq pa2 (polar pf a2 d3))
(setq pc2 (polar pb2 a2 (* x d1)))
(setq pd2 (polar pa2 a2 (* x (* 0.9 d1))))
)

(defun c:calo (/ sel1 ent1 lent typent p1 d1 p2 p3 d2 p1b p4b p5b p6b
                               d3 d a1 a2 p4 p5 p6 sel2 ent2
             pa pb pc pd pe pf pa2 pb2 pc2 pd2 pe2 pf2 osm             )
(setq m:err *error* *error* ercalo)
(setq osm (getvar "osmode" ))
(setq groupobj (getvar "pickstyle"))
(setvar "pickstyle" 0) ; groupe inactif
(if in_accro_auto (in_accro_auto) (setvar "osmode" 0)) 
(setvar "cmdecho" 0)
(while
 (setq sel1 (entsel "\n Pointer Generatrice Exterieure Tube : \n"))
 (if sel1 (progn
  (setq ent1 (car sel1))
  (setq lent (entget ent1))
  (setq typent (cdr (assoc 0 lent)))
  (if (or (= typent "LINE") (= typent "POLYLINE") (= typent "LWPOLYLINE"))
   (progn
    (setq p1 (cadr sel1))
    (setq p1 (osnap p1 "_near"))
    (if epcalo
     (progn
      (initget 2)
      (setq d1 (getdist (strcat "\n Epaisseur calo <" (rtos epcalo 2 2) ">:") p1))
      (if (= d1 nil) (setq d1 epcalo)(setq epcalo d1))
     )
     (progn
      (initget 2)
      (setq d1 (getdist "\n Epaisseur calo <50>:" p1))
      (if (= d1 nil) (setq d1 50)(setq epcalo d1))
     )
    )
    (setvar "osmode" 128)
    (setq p2 (getpoint p1 "\n 1 er Point sur Axe Tube :"))
    (setvar "osmode" 512)
    (setq p3 (getpoint p2 "\n 2 eme Point sur Axe Tube :"))
    (if in_accro_auto (in_accro_auto) (setvar "osmode" 0)) 
    (setq d2 (distance p1 p2))
    (setq d3 (distance p2 p3))
    (setq d (+ d1 d2))
    (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"))
        (defptcalo)
        (inscalo)
       )
      )
     )
    )
   )
  )
 )) ;fin if sel1
) ; fin while
(ercalo) 
)