;****************************************;
;*this is mold_cap_cst.lsp program	*;
;*completely complied in 03/17/98	*;
;*last changed in 03/17/99		*;
;*ZX Mold Ltd   XY.Liao			*;
;****************************************;
;********************************************************************************************************;
(defun MoldCapCst(scrD scrLen pt1 pt2 if_h_v pt3 / mpt1 	mpt2	mpt3	mpt4	mpt5
		mpt6	mpt7	mpt8	mpt9	mpt10	mpt11	mpt12 	mpt13	mpt14	mpt15
		mpt16	mpt17	mpt18	mpt19	mpt20	mpt21	mpt22	mpt23	mpt24	mpt25
		mpt26	mpt27	mpt28	mpt29	angh	angv	angvv	mcpt1	mcpt2	sel_ent
		textpt1	textpt2 textang textangv)
  (load "screwlib")
  (setq scr_m_n (xh_get scrD (scr_lib "SHCSM" "spec")))
  (setq d (nth scr_m_n (scr_lib "SHCSM" "d_ct")))
  (setq hd (nth scr_m_n (scr_lib "SHCSM" "d_ch")))
  (setq s (nth scr_m_n (scr_lib "SHCSM" "cs")))
  (setq b (nth scr_m_n (scr_lib "SHCSM" "cb")))
  (setq l (- scrLen d 1))
;---------------------------------------------------------
;Calculate angle value
;---------------------------------------------------------
  (setq ang (angle pt1 pt2))
  (setq angh  (+ pi ang))
  (setq angv  (+ ang (/ pi 2)))
  (setq angvv (- ang (/ pi 2)))
;-----------------------------------------------------
;calculate c'bore points ordinate
;-----------------------------------------------------
  (setq mpt1  (polar pt1 angv (/ (+ hd 1) 2))
	mpt2  (polar pt1 angvv (/ (+ hd 1) 2))
	mpt5  (polar mpt1 ang (+ d 1))
	mpt12 (polar mpt2 ang (+ d 1))
  )
  (setq mpt13 (polar pt2 angv (/ (+ d 1) 2))
	mpt16 (polar pt2 angvv (/ (+ d 1) 2))
	mpt7  (polar mpt13 angh (- (distance pt1 pt2) d 1))
	mpt10 (polar mpt16 angh (- (distance pt1 pt2) d 1))
	mpt14 (polar pt2 angv (/ d 2))
	mpt15 (polar pt2 angvv (/ d 2))
  )
;-----------------------------------------------------
;calculate screw points ordinate
;-----------------------------------------------------
  (setq mpt6  (polar mpt5 angvv 0.5)
	mpt11 (polar mpt12 angv 0.5)
	mpt3  (polar mpt6 angh d)
	mpt4  (polar mpt11 angh d)
	mpt8  (polar mpt6 angvv (/ (- hd d) 2))
	mpt9  (polar mpt11 angv (/ (- hd d) 2))
	mpt17 (polar mpt8 ang (- l (* d 0.1)))
	mpt18 (polar mpt9 ang (- l (* d 0.1)))
	mpt19 (polar (polar mpt8 ang l) angvv (* d 0.1))
	mpt20 (polar (polar mpt9 ang l) angv (* d 0.1))
  )
;-----------------------------------------------------
;calculate screw hole points ordinate
;-----------------------------------------------------
  (if pt3
    (setq mpt21 (polar pt3 angv (/ d 2))
	  mpt22 (polar mpt21 angvv (* d 0.1))
	  mpt24 (polar pt3 angvv (/ d 2))
	  mpt23 (polar mpt24 angv (* d 0.1))
    )
    (setq mpt21 (polar mpt8 ang (+ l 2))
	  mpt22 (polar mpt9 ang (+ l 2))
	  mpt23 (polar mpt19 ang 3.5)
	  mpt24 (polar mpt20 ang 3.5)
	  mpt25 (polar pt1 ang (+ l d 4.5 (* (* d 0.5) 0.5774)))
    )
  )
;-----------------------------------------------------
;Justy if draw smooth cylinder part or not
;-----------------------------------------------------
  (if (<= l b)
     (progn
	(setq mpt27 (polar mpt8 angvv (* d 0.1)))
	(setq mpt28 (polar mpt9 angv (* d 0.1)))
     )
     (progn
	(setq mpt26 (polar mpt8 ang (- l b)))
	(setq mpt29 (polar mpt9 ang (- l b)))
  	(setq mpt27 (polar mpt26 angvv (* d 0.1)))
	(setq mpt28 (polar mpt29 angv (* d 0.1)))
     )
  )
;-----------------------------------------------------
;calculate center line points ordinate and
;text insert points ordinate
;-----------------------------------------------------
  (setq mcpt1 (polar pt1 angh 2))
  (if pt3
    (setq mcpt2 (polar pt3 ang 2))
    (setq mcpt2 (polar mpt25 ang 2))
  )
;-------------------------------------------------------
;if hidden then set current linetype as hidden
;-------------------------------------------------------
  (if (= if_h_v "1")
    (command "cecolor" "yellow"
	     "_.linetype" "set" "hidden" "")
    (progn
      (setvar "cecolor" "bylayer")
      (setvar "celtype" "bylayer")
    )
  )
;------------------------------------------------------
;draw screw
;------------------------------------------------------
  (setq sel_ent (ssadd))
  (progn
    (command "pline" mpt6 mpt3 mpt4 mpt11 mpt6 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt27 mpt19 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "pline" mpt8 mpt17 mpt19 mpt20 mpt18 mpt9 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt28 mpt20 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (command "line" mpt17 mpt18 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (if (> l b)
      (progn
        (command "line" mpt26 mpt29 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
      )
    )
  )
;-----------------------------------------------------
;Draw c'bore and screw hole
;-----------------------------------------------------
  (setq tr_ent (ssadd))
  (progn
    (command "line" mpt7 mpt13 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (setq tr_ent (ssadd (entlast) tr_ent))
    (command "line" mpt10 mpt16 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (setq tr_ent (ssadd (entlast) tr_ent))
  )
  (if (= "0" if_h_v)
    (command "trim" tr_ent "" pt2 "")
  )
  (progn
    (command "pline" mpt1 mpt5 mpt12 mpt2 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
    (if pt3
      (progn
        (command "line" mpt17 mpt21 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" mpt19 mpt22 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" mpt20 mpt23 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" mpt18 mpt24 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
      )
      (progn
        (command "pline" mpt19 mpt23 mpt25 mpt24 mpt20 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "line" mpt23 mpt24 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
        (command "pline" mpt17 mpt21 mpt22 mpt18 mpt17 "")
        (setq sel_ent (ssadd (entlast) sel_ent))
      )
    )
  )
;-----------------------------------------------------
;Draw center line
;-----------------------------------------------------
  (progn 
    (command "cecolor" "red"
	     "_.linetype" "set" "center" "")
    (command "line" mcpt1 mcpt2 "")
    (setq sel_ent (ssadd (entlast) sel_ent))
  )

  (mblk (strcat "AC_LXY_BLK" (itoa (getvar "useri2"))) pt1 sel_ent)
  (setvar "useri2" (+ 1 (getvar "useri2")))
  (setvar "cecolor" "bylayer")
  (setvar "celtype" "bylayer")
)
;*************************************** End of function ****************************************;