;;By Larry Criswell
;;10/27/98 The program extrudes
;;         3d tubes...


(defun DTR (deg)
  (* deg (/ pi 180))
)

(defun c:tubex (/	 count	  linename allents  all	     allinfo
		entcount lpt1	  lpt2	   linlay   circlast arclay
		arcrad	 pt3	  zaxis	   p50	    ctr	     arccount
		arcents	 lineents p51	   pt4	    fpt	     spt
		entd	 lgth	  osmd
	       )

  ;; Get list of arc names and line names
  (command "ucs" "d" "temp")
  (command "ucs" "s" "temp")
  (setq osmd (getvar "osmode"))
  (setvar "osmode" 0)
  (command "ucs" "world")
  (setq os (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if ctan2_rad
    (setq olddia (* ctan2_rad 2))
    (progn
      (setq ctan2_rad 3.0)
      (setq olddia ctan2_rad)
    )					;end progn
  )					;endif
  (prompt "\nThis program extrudes arcs and lines: ")
  (setq	ctan2_rad (getreal (strcat "\nEnter diameter of tube: "
				   "<"
				   (rtos olddia 2 4)
				   "> "
			   )
		  )
  )
  (if (not ctan2_rad)
    (setq ctan2_rad (/ olddia 2))
    (setq ctan2_rad (/ ctan2_rad 2))
  )					;end if
  (prompt "\nSelect tube runs: ")
  (while (not (setq allents (ssget))))
  (setq entcount 0)
  (setq entd 0)
  (setq lineents (ssadd))
  (setq arcents (ssadd))
  (while (setq all (ssname allents entcount))
    (setq alldata (entget all))
    (setq allinfo (cdr (assoc 0 alldata)))
    (if	(= allinfo "LINE")
      (progn
	(setq fpt (cdr (assoc 10 alldata)))
	(setq spt (cdr (assoc 11 alldata)))
	(setq lgth (distance fpt spt))
	(if (< lgth 0.005)
	  (progn
	    (setq entd (1+ entd))
	    (entdel all)
	  )				;end progn
	  (ssadd all lineents)
	)				;end if	
      )					;end progn

    )					;end if
    (if	(= allinfo "ARC")
      (ssadd all arcents)
    )					;end if
    (setq entcount (1+ entcount))
  )					;end while
					;End of gettng line and arc names

					;Start extruding lines
  (setq count 0)
  (if lineents
    (progn
      (while (setq linename (ssname lineents count))
	(setq linedata (entget linename))
	(setq lpt1 (cdr (assoc 10 linedata)))
	(setq lpt2 (cdr (assoc 11 linedata)))
	(setq linelay (cdr (assoc 8 linedata)))
	(command "_ucs" "world")
	(command "_ucs" "3point" lpt1 lpt2 "124342,13265,9887")
	(command "_ucs" "y" "90")
	(setvar "clayer" linelay)
	(command "_circle" "0,0" ctan2_rad)
	(setq circlast (entlast))
	(setq circlist (list circlast))
	(setq circlist2 (append circlist circlist2))
	(command "extrude" circlast "" "p" linename)
	(setq count (1+ count))
      )					;end while
    )					;end progn
  )					;end if
  ;; End of extruding lines


  ;; Start extruding arcs


  (if arcents
    (progn
      (setq arccount 0)
      (while (setq arcname (ssname arcents arccount))
	(command "ucs" "world")
	(setq arcdata (entget arcname))
	(setq arclay (cdr (assoc 8 arcdata)))

	(setq p50 (cdr (assoc 50 arcdata)))
	(setq p51 (+ p50 (dtr 90)))
	(setq ctr (cdr (assoc 10 arcdata)))
	(setq arcrad (cdr (assoc 40 arcdata)))
	(setq pt3 (polar ctr p50 arcrad))
	(setq pt4 (polar ctr p51 arcrad))
	(setq zaxis (cdr (assoc 210 arcdata)))
	(command "ucs" "za" "" zaxis)	;Get ucs flat with circle
	(command "ucs" "3point" pt3 ctr pt4)
	(command "ucs" "x" "90")
	(setvar "clayer" arclay)
	(command "circle" "0,0" ctan2_rad)
	(setq circlast (entlast))
	(setq circlist (list circlast))
	(setq circlist2 (append circlist circlist2))
	(command "extrude" circlast "" "p" arcname)
	(setq arccount (1+ arccount))
      )					;end while
    )					;end progn
  )					;end if

  ;;End of extruding arcs
  ;;                     
  ;;                     

  (foreach c circlist2
    (command "erase" c "")
  )					;end foreach
 (command "ucs" "r" "temp")
 (command "ucs" "d" "temp")
  (setvar "cmdecho" os)
  (prompt (strcat "\nThere were "
		  "<"
		  (rtos entd 2 0)
		  "> "
		  "Zero length entities deleted: "
	  )
  )
  (setvar "osmode" osmd)
  (princ)
)					;end tubex