;;;---------------------------------------------------------
;;;既存線分から相対角度線をPLINEに対して作成(土木専用)
;;; 00/07/12 C9
;;;---------------------------------------------------------
(defun C:KOUBAI (/ ANG1 L_LYR T_LYR C9_CMDEC C9_MNEC PL10LIST YO SP EP BL PL1 PL2 PTLIST
                 BLFLG BLFLGL BLFLGR SP2 EP2 CLYR
                )
  (C9_OFF)
  (setq L_LYR "koubai"
        T_LYR "moji"
  ) ;_ <<SETQ
  (initget 6)
  (setq YO (getdist "\n 余裕幅を入力 <0.0>:"))
  (setq SATO#ANG1 (C9_GETREAL "\n 最初の勾配を入力 0=終了 (1:?)" SATO#ANG1))
  (if (/= 0.0 SATO#ANG1)
    (progn
      (SATO_LINECHK)
      (if BL
        (progn
          (redraw (setq SATO#HLOBJ (car BL)) 3)
          (setq PL1 (entsel "\n ポリラインを指示<enter=終了>:"))
          (redraw SATO#HLOBJ 4)
          (setq SATO#HLOBJ NIL)
          (if PL1
            (progn
              (setq PL10LIST (SATO_PLIST PL1))
              (if PL10LIST
                (progn
                  (setq PTLIST (SATO_XPTLR PL10LIST SP EP SATO#ANG1))
                  (if PTLIST
                    (progn
                      (setq CLYR (getvar "CLAYER"))
                      (SATO_MAKELYR)
                      (setvar "CLAYER" CLYR)
                      (SATO_DRAWLINE PTLIST SATO#ANG1)
                      (if YO
                        (progn (if (not (nth 4 PTLIST))
                                 (setq SP (polar SP (angle SP EP) YO))
                               ) ;_ <<IF
                               (if (not (nth 5 PTLIST))
                                 (setq EP (polar EP (angle EP SP) YO))
                               ) ;_ <<IF
                               (if (and (not (nth 4 PTLIST)) (not (nth 5 PTLIST)))
                                 (setq BLFLG NIL)
                                 (setq BLFLG t)
                               ) ;_ <<IF
                               (if BLFLG
                                 (SATO_BLSET)
                               ) ;_ <<IF
                        ) ;_ <<progn
                      ) ;_ <<if
                      (setq SP2 (list (nth 2 PTLIST) (nth 4 PTLIST)) ;PLINEとの左の交点
                            EP2 (list (nth 3 PTLIST) (nth 5 PTLIST)) ;PLINEとの右の点
                      ) ;_ <<setq
                      (setq SATO#ANG2
                             (C9_GETREAL "\n 次の勾配を入力 0=終了 (1:?)" SATO#ANG2)
                      ) ;_ <<setq
                      (if (/= 0.0 SATO#ANG2)
                        (progn
                          (setq PL2 (entsel "\n ポリラインを指示<enter=終了>:"))
                          (if PL2
                            (progn
                              (setq PL10LIST (SATO_PLIST PL2))
                              (if PL10LIST
                                (progn
                                  (if (cadr SP2)
                                    (setq SP2 (car SP2))
                                    (progn (setq SP2 SP)
                                           (if YO
                                             (progn (setq SP2 (polar SP (angle EP SP) YO))
                                                    (setq BLFLGL t)
                                             ) ;_ <<PROGN
                                           ) ;_ <<if
                                    ) ;_ <<PROGN
                                  ) ;_ <<IF
                                  (if (cadr EP2)
                                    (setq EP2 (car EP2))
                                    (progn (setq EP2 EP)
                                           (if YO
                                             (progn (setq EP2 (polar EP (angle EP SP) YO))
                                                    (setq BLFLGR t)
                                             ) ;_ <<PROGN
                                           ) ;_ <<if
                                    ) ;_ <<PROGN
                                  ) ;_ <<IF
                                  (if BLFLGL
                                    (setq SP SP2)
                                  ) ;_ <<if
                                  (if BLFLGR
                                    (setq EP EP2)
                                  ) ;_ <<if
                                  (if (or BLFLGL BLFLGR)
                                    (SATO_BLSET)
                                  ) ;_ <<if
                                  (setq PTLIST (SATO_XPTLR PL10LIST SP2 EP2 SATO#ANG2))
                                  (if PTLIST
                                    (SATO_DRAWLINE PTLIST SATO#ANG2)
                                  ) ;_ <<IF
                                ) ;_ <<PROGN
                              ) ;_ <<IF
                            ) ;_ <<PROGN
                          ) ;_ <<IF
                        ) ;_ <<PROGN
                      ) ;_ <<if
                    ) ;_ <<PROGN
                  ) ;_ <<IF
                ) ;_ <<PROGN
              ) ;_ <<IF
            ) ;_ <<PROGN
          ) ;_ <<if
        ) ;_ <<PROGN
        (prompt "\n 水平なLINEｵﾌﾞｼﾞｪｸﾄを選択して下さい。")
      ) ;_ <<IF
    ) ;_ <<PROGN
  ) ;_ <<if
  (C9_ON)
  (princ)
) ;_ <<defun


(defun C9_OFF (/ *C9_ERROR*)
  (defun *C9_ERROR* (MSG)
    (princ (strcat "\n err:" MSG "\n"))
    (if C9_ORTMD
      (setvar "orthomode" C9_ORTMD)
    ) ;_ <<IF
    (if C9_OSMD
      (setvar "osmode" C9_OSMD)
    ) ;_ <<IF
    (if C9_SPMD
      (setvar "SNAPMODE" C9_SPMD)
    ) ;_ <<IF
    (setq C9_ORTMD NIL
          C9_OSMD NIL
          C9_SPMD NIL
    ) ;_ <<SETQ
    (setvar "CMDECHO" 1)
    (SATO_KOUBAI_ERR)
    (redraw)
    (princ)
  ) ;_ <<defun
  (setq *ERROR* *C9_ERROR*)
  (setvar "CMDECHO" 0)
  (command ".UNDO" "BE")
) ;_ <<defun

(defun SATO_KOUBAI_ERR ()
  (if SATO#HLOBJ
    (redraw SATO#HLOBJ 4)
  ) ;_ <<IF
  (setq CQ#HLOBJ NIL)
) ;_ <<DEFUN


(defun C9_ON ()
  (setq *ERROR* NIL)
  (setq C9_ORTMD NIL
        C9_OSMD NIL
        C9_SPMD NIL
  ) ;_ <<SETQ
  (command ".UNDO" "E")
  (setvar "CMDECHO" 1)
  (princ)
) ;_ <<defun


(defun SATO_BLSET ()
  (setq BL_LYR (C9_DXFC 8 (car BL)))
  (command "ERASE" (car BL) "")
  (C9_MOFF)
  (command ".LINE" SP EP "")
  (C9_MON)
  (command ".CHPROP" "L" "" "LA" BL_LYR "")
) ;_ <<defun


(defun SATO_MAKELYR ()
  (if (not (tblsearch "LAYER" L_LYR))
    (command "-LAYER" "M" L_LYR "C" "6" L_LYR "L" "CENTER" L_LYR "") ;_ <<command
  ) ;_ <<if
  (if (not (tblsearch "LAYER" T_LYR))
    (command "-LAYER" "M" T_LYR "C" "7" T_LYR "")
  ) ;_ <<IF
) ;_ <<DEFUN


;;;勾配線を描く
(defun SATO_DRAWLINE (PTLIST ANGN / SPL SPR EPL EPR)
  (setq SPL (nth 0 PTLIST)    ;2点の内、左の点
        SPR (nth 1 PTLIST)    ;2点の内、右の点
        EPL (nth 2 PTLIST)    ;PLINEとの左の交点
        EPR (nth 3 PTLIST)    ;PLINEとの右の交点
  ) ;_ <<setq
  (if (nth 4 PTLIST)
    (progn (C9_MOFF)
           (command ".LINE" SPL EPL "")
           (command ".CHPROP" "L" "" "LA" L_LYR "")
           (SATO_SETTEXT EPL SPL ANGN)
           (command ".CHPROP" "L" "" "LA" T_LYR "")
           (C9_MON)
    ) ;_ <<PROGN
  ) ;_ <<IF
  (if (nth 5 PTLIST)
    (progn (C9_MOFF)
           (command ".LINE" SPR EPR "")
           (command ".CHPROP" "L" "" "LA" L_LYR "")
           (SATO_SETTEXT SPR EPR ANGN)
           (command ".CHPROP" "L" "" "LA" T_LYR "")
           (C9_MON)
    ) ;_ <<PROGN
  ) ;_ <<IF
) ;_ <<defun



;;;基準線のCHECK
(defun SATO_LINECHK ()
  (setq BL (entsel "\n 基準線を指示:"))
  (if BL
    (if (eq (C9_DXFC 0 (car BL)) "LINE")
      (progn (setq SP (C9_DXFC 10 (car BL))
                   EP (C9_DXFC 11 (car BL))
             ) ;_ <<setq
             (if (equal (cadr SP) (cadr EP) 0.0000001)
               (progn (if YO
                        (progn (setq SP (polar SP (angle EP SP) YO))
                               (setq EP (polar EP (angle SP EP) YO))
                        ) ;_ <<PROGN
                      ) ;_ <<if
               ) ;_ <<progn
               (setq BL NIL
                     YO NIL
               ) ;_ <<setq
             ) ;_ <<if
      ) ;_ <<PROGN
      (setq BL NIL
            YO NIL
      ) ;_ <<setq
    ) ;_ <<IF
  ) ;_ <<IF
) ;_ <<DEFUN

;;;角度線上の下に文字を書く
(defun SATO_SETTEXT (P1 P2 ANG /)
  (defun C9_RTD (R) (* 180.0 (/ R pi)))
  (command ".TEXT"
           "J"
           "TC"
           (polar (polar P1 (angle P1 P2) (/ (distance P1 P2) 2))
                  (+ (angle P1 P2) (* 1.5 pi))
                  (* 1.0 (getvar "DIMSCALE"))
           ) ;_ <<POLAR
           (* 2.5 (getvar "DIMSCALE"))
           (C9_RTD (angle P1 P2))
           (strcat "1:" (rtos ANG 2 1))
  ) ;_ <<command
) ;_ <<DEFUN


;;; PLINE CHECK
(defun SATO_PLIST (ENT / OBJ SS LYR LENT CHK EN 10_LIST ALL_10_LIST ALL_10_LIST_BACK FUKU_DATA
             )
  (setq OBJ (C9_DXFC 0 (car ENT)))
  (if (eq OBJ "LINE")
    (progn (setq EN (car ENT))
           (setq LYR (list (cons 8 (C9_DXFC 8 EN))))
           (setq SS (ssget "X" LYR))
           (command ".PEDIT" EN "Y" "J" SS "" "")
           (redraw (setq SATO#HLOBJ (entlast)) 3)
           (initget "Yes No")
           (setq CHK (getkword "よろしいですか? [はい(Y)/いいえ(N)]<Y>: "))
           (redraw SATO#HLOBJ 4)
           (if (or (eq CHK "Yes") (eq CHK NIL))
             (setq ENTITY_DATA (entget SATO#HLOBJ))
           ) ;_ <<if
           (command ".EXPLODE" SATO#HLOBJ)
    ) ;_ <<PROGN
  ) ;_ <<IF
  (if (or (eq OBJ "LWPOLYLINE") (eq OBJ "POLYLINE"))
    (setq ENTITY_DATA (entget (car ENT)))
  ) ;_ <<IF
  (while ENTITY_DATA
    (setq 10_LIST (car ENTITY_DATA))
    (if (= (car 10_LIST) 10)
      (if ALL_10_LIST
        (setq ALL_10_LIST (append ALL_10_LIST (list (cdr 10_LIST))))
        (setq ALL_10_LIST (list (cdr 10_LIST)))
      ) ;_ <<if
    ) ;_ <<if
    (setq ENTITY_DATA (cdr ENTITY_DATA))
  ) ;_ <<while
  ALL_10_LIST
) ;_ <<defun

;;; システム変数の一時退避
(defun C9_MOFF ()
  (setq C9_ORTMD (getvar "ORTHOMODE")
        C9_OSMD  (getvar "OSMODE")
        C9_SPMD  (getvar "SNAPMODE")
  ) ;_ <<setq
  (setvar "ORTHOMODE" 0)
  (setvar "OSMODE" 0)
  (setvar "SNAPMODE" 0)
) ;_ <<defun


;;; 退避したシステム変数の再読み込み
(defun C9_MON ()
  (setvar "ORTHOMODE" C9_ORTMD)
  (setvar "OSMODE" C9_OSMD)
  (setvar "SNAPMODE" C9_SPMD)
;;;  (setvar "cmdecho" 1)
) ;_ <<defun


;;; デフォルト値を含むＧＥＴＲＥＡＬ関数
;;;      (C9_GETREAL "\n 数値を入力 :" W)
(defun C9_GETREAL (MSG DEF / A)
  (if (not DEF)
    (setq DEF 0.0)
  ) ;_ <<if
  (prompt (strcat "\n" MSG "<" (rtos DEF 2 1)))
  (setq A (getstring ">: "))
  (if (/= "" A)
    (atof A)
    DEF
  ) ;_ <<if
) ;_ <<defun



;;; エンティティのDXFグループコードの値を返す
;;; 例: (C9_DXFC 8 NAME)  
(defun C9_DXFC (GRP ENAME) (cdr (assoc GRP (entget ENAME))))


;;;----------------------------------------------------------------
;;;PLINEの頂点のリスト、両方の発射点、角度を引数にして
;;;左発射点、右発射点、PLINE上の左着地点、右着地点のLISTを返。
;;; (左発射点 右発射点 左着地点 右着地点)のLIST
;;;----------------------------------------------------------------
(defun SATO_XPTLR (PLIST           ;PLINEの頂点のリスト
              LP              ;発射点（左右問わず）
              RP              ;発射点（左右問わず）
              ANG             ;いつも聞く0.6とかの度
              / ANG1R ANG1L LN RN LP_BACK LFLG RFLG
             )
  (defun XPTCHK (PT LST ANG LR / N XPT FLG)
    (setq N 0)
    (while (nth N LST)
      (if (nth (1+ N) LST)
        (progn (setq XPT (inters (nth N LST) (nth (1+ N) LST) PT (polar PT ANG 100) NIL))
               (if (not
                     (equal (angle (nth N LST) XPT) (angle (nth (1+ N) LST) XPT) 0.000001)
                   ) ;_ <<NOT
                 (progn (if FLG
                          (progn (if (< (distance PT XPT) (distance PT FLG))
                                   (setq FLG XPT)
                                 ) ;_ <<IF
                          ) ;_ <<PROGN
                          (setq FLG XPT)
                        ) ;_ <<IF
                 ) ;_ <<PROGN
               ) ;_ <<IF
        ) ;_ <<PROGN
        (progn
          (if (and (not FLG) (eq LR 11))
            (setq FLG (inters (nth N LST) (nth (- N 1) LST) PT (polar PT ANG 100) NIL))
          ) ;_ <<IF
        ) ;_ <<PROGN
      ) ;_ <<IF
      (setq N (1+ N))
    ) ;_ <<WHILE
    (if (and (eq FLG NIL) (eq LR 10))
      (setq FLG (inters (nth 0 LST) (nth 1 LST) PT (polar PT ANG 100) NIL))
    ) ;_ <<IF
    (setq XPT FLG)
  ) ;_ <<DEFUN
  (if (> (car (car PLIST)) (car (last PLIST)))
    (setq PLIST (reverse PLIST))
  ) ;_ <<if
  (if (> (car LP) (car RP))
    (setq LP_BACK LP
          LP RP
          RP LP_BACK
    ) ;_ <<setq
  ) ;_ <<if
  (setq ANG1R (atan (/ 1 ANG)))
  (setq ANG1L (- (* 0.5 pi) (- ANG1R (* 0.5 pi))))
  (setq XPTL (XPTCHK LP PLIST ANG1L 10))
  (setq XPTR (XPTCHK RP PLIST ANG1R 11))
  (if (< (cadr LP) (cadr XPTL))
    (setq LFLG t)
    (setq LFLG NIL)
  ) ;_ <<IF
  (if (< (cadr RP) (cadr XPTR))
    (setq RFLG t)
    (setq RFLG NIL)
  ) ;_ <<IF
  (list LP RP XPTL XPTR LFLG RFLG)
) ;_ <<defun