[LISP-GSJ] Mensuration.lsp (포스트아이디 : 6660460655412597664)

;;=========================================================================================================
;; http://cafe.daum.net/zwcad & http://www.lispcenter.net
;;=========================================================================================================
;;=========================================================================================================
(defun C:DP()
;;-----------------------------------------------------------------------------------------------------
 (vl-load-com)
 (setq lPathMainDCL    (gsave "6466820720807560467" "dcl")) ;; Mensuration.dcl
 (setq lPathConfigDCL  (gsave "6162421951571463798" "dcl")) ;; MensurationConfig.dcl
 (setq lPathImage      "c:/Table_Image.sld")
 (setq lPathMensration (gsave "3534858698934110297" "lsp")) ;; MensurationFunc.lsp
 (setq lFuncList       (gsave "2104168976269955871" "lsp")) ;; FuncList.lsp
 (setq lFuncGeometry   (gsave "3536210793345284536" "lsp")) ;; FuncGeometry.lsp
 (setq lFuncEntity     (gsave "5412586620614814752" "lsp")) ;; FuncEntity.lsp
 ;;-----------------------------------------------------------------------------------------------------
 ;;(setq lPathBTDCL      "F:/LispCenter/BitmapToDCL/BitmapToDCL.lsp")
 (if (= Mensuration_Main nil)
  (if (findfile lPathMensration)
   (load lPathMensration)
   (alert (strcat "[ MensurationFunc.LSP ] LISP 경로 오류     \n\n" lPathMensration "   "))
  )
 )
 (if (= (findfile lPathConfigDCL) nil)
  (alert (strcat "[ MensurationConfig.DCL ] DCL 경로 오류     \n\n" lPathConfigDCL "   "))
 )
 (if (= (findfile lPathMainDCL) nil)
  (alert (strcat "[ Mensuration.DCL ] DCL 경로 오류     \n\n" lPathMainDCL "   "))
 )
 (if (= BitmapToDCL nil)
  (if (findfile lPathBTDCL)
   (load lPathBTDCL)
   (alert (strcat "[ BitmapToDCL.LSP ] LISP 경로 오류     \n\n" lPathBTDCL "   "))
  )
 )
 (if (= BitmapToDCL nil)
  (if (findfile lPathBTDCL)
   (load lPathBTDCL)
   (alert (strcat "[ BitmapToDCL.LSP ] LISP 경로 오류     \n\n" lPathBTDCL "   "))
  )
 )

 (if (= FuncList nil)
  (if (findfile lFuncList)
   (load lFuncList)
   (alert (strcat "[ FuncList.LSP ] LISP 경로 오류     \n\n" lFuncList "   "))
  )
 )
 (if (= FuncGeometry nil)
  (if (findfile lFuncGeometry)
   (load lFuncGeometry)
   (alert (strcat "[ FuncGeometry.LSP ] LISP 경로 오류     \n\n" lFuncGeometry "   "))
  )
 )
 (if (= FuncEntity nil)
  (if (findfile lFuncEntity)
   (load lFuncEntity)
   (alert (strcat "[ FuncEntity.LSP ] LISP 경로 오류     \n\n" lFuncEntity "   "))
  )
 )
 ;;-----------------------------------------------------------------------------------------------------
 (setq lTableLabel01  (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label1"))
 (setq lTableLabel02  (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label2"))
 (setq lTableLabel03  (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label3"))
 (setq lTableLabel04  (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label4"))
 (setq lTableLabel05  (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label5"))
 (setq lUnitFlag      (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "UnitFlag"))     ;; 단위
 (setq lPlacesFlag    (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PlacesFlag"))   ;; 소수점
 (setq lPyongFlag     (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PyongFlag"))    ;; 평면적
 (setq lCommaFlag     (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CommaFlag"))    ;; 컴마
 (setq lZeroFlag      (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "ZeroFlag"))     ;; 0 억제
 (setq lNumberSize    (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextSize"))     ;; 문자 크기
 (setq lNumberLayer   (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextLayer"))    ;; 문자 레이어
 (setq lNumberColor   (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextColor"))    ;; 문자 색상
 (setq lTriangleLayer (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriLayer"))     ;; 도형 레이어
 (setq lTriangleColor (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriColor"))     ;; 도형 색상
 (setq lCircleLayer   (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleLayer"))  ;; 원 레이어
 (setq lCircleColor   (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleColor"))  ;; 원 색상
 (setq lTableLayer    (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableLayer"))   ;; 표 레이어
 (setq lTableColor    (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableColor"))   ;; 표 색상
 (setq lNumberStyle   (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextStyle"))    ;; 문자 스타일
 (setq lTableSize     (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CellSize"))     ;; 표 셀 높이
 (setq lCircleSize    (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleSize"))   ;; 원 표시 크기
 (setq lPerpendicularSize (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PerpendicularSize"))  ;; 수직 표시 크기
 ;;-----------------------------------------------------------------------------------------------------
 (setq lConfigList (list lTriangleLayer lTriangleColor lNumberLayer lNumberColor lCircleLayer lCircleColor lTableLayer lTableColor lNumberStyle lTableSize lCircleSize lPerpendicularSize))
 ;;-----------------------------------------------------------------------------------------------------
 (setq lXPT (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "XPT"))
 (setq lYPT (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "YPT"))
 (if (or (= lXPT nil) (= lYPT nil))
  (setq lDlgPT (list -1 -1))
  (setq lDlgPT (list lXPT lYPT))
 )
 ;;-----------------------------------------------------------------------------------------------------
 (setq ldcl_dp (load_dialog lPathMainDCL))
 (if (not (new_dialog "MENSURATION" ldcl_dp "" lDlgPT))(exit))
 ;;-----------------------------------------------------------------------------------------------------
 (start_list "UnitFlag")
 (mapcar 'add_list (list "mm²" "cm²" "m²"))
 (end_list)
 (start_list "PlacesFlag")
 (mapcar 'add_list (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"))
 (end_list)
 ;;-----------------------------------------------------------------------------------------------------
 ;;(BitmapToDCL "table_image" lPathImage 284 128 0 0 1)
 ;;(slide_image  10 10 15 20 "image.sld")
 (start_image "table_image")
 (slide_image 30 0 (dimx_tile "table_image") (dimy_tile "table_image")  lPathImage)
 (end_image)
 ;;-----------------------------------------------------------------------------------------------------
 (set_tile "NameNo1"    lTableLabel01)
 (set_tile "NameNo2"    lTableLabel02)
 (set_tile "NameNo3"    lTableLabel03)
 (set_tile "NameNo4"    lTableLabel04)
 (set_tile "NameNo5"    lTableLabel05)
 (set_tile "PyongFlag"  lPyongFlag)
 (set_tile "CommaFlag"  lCommaFlag)
 (set_tile "ZeroFlag"   lZeroFlag)
 (set_tile "NumberSize" lNumberSize)
 (set_tile "UnitFlag"   lUnitFlag)
 ;;-----------------------------------------------------------------------------------------------------
 (action_tile "NameNo1"    "(setq lTableLabel01 $value)")
 (action_tile "NameNo2"    "(setq lTableLabel02 $value)")
 (action_tile "NameNo3"    "(setq lTableLabel03 $value)")
 (action_tile "NameNo4"    "(setq lTableLabel04 $value)")
 (action_tile "NameNo5"    "(setq lTableLabel05 $value)")
 (action_tile "PyongFlag"  "(setq lPyongFlag    $value)")
 (action_tile "CommaFlag"  "(setq lCommaFlag    $value)")
 (action_tile "ZeroFlag"   "(setq lZeroFlag     $value)")
 (action_tile "NumberSize" "(setq lNumberSize   $value)")
 (action_tile "UnitFlag"   "(setq lUnitFlag     $value)")
 (action_tile "accept"     "(setq lDlgPT (done_dialog 1))")
 (action_tile "Config"     "(setq lConfigList (ConfigDlg lPathConfigDCL lConfigList))")
 ;;-----------------------------------------------------------------------------------------------------
 (setq lRtnDLG (start_dialog))
 ;;-----------------------------------------------------------------------------------------------------
 (if (= lRtnDLG 1)
  (progn
   ;;---------------------------------------------------------------------------------------------
   (setq lTriangleLayer    (nth  0 lConfigList))
   (setq lTriangleColor    (nth  1 lConfigList))
   (setq lNumberLayer      (nth  2 lConfigList))
   (setq lNumberColor      (nth  3 lConfigList))
   (setq lCircleLayer      (nth  4 lConfigList))
   (setq lCircleColor      (nth  5 lConfigList))
   (setq lTableLayer       (nth  6 lConfigList))
   (setq lTableColor       (nth  7 lConfigList))
   (setq lNumberStyle      (nth  8 lConfigList))
   (setq lTableSize        (nth  9 lConfigList))
   (setq lCircleSize       (nth 10 lConfigList))
   (setq lPerpendicularSize(nth 11 lConfigList))
   ;;---------------------------------------------------------------------------------------------
   (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label1"      lTableLabel01)
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label2"      lTableLabel02)
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label3"      lTableLabel03)
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label4"      lTableLabel04)
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label5"      lTableLabel05)
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "UnitFlag"    lUnitFlag)     ;; 단위
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PlacesFlag"  lPlacesFlag)   ;; 소수점
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PyongFlag"   lPyongFlag)    ;; 평면적
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CommaFlag"   lCommaFlag)    ;; 컴마
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "ZeroFlag"    lZeroFlag)     ;; 0 억제
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextSize"    lNumberSize)    ;; 문자 크기
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextLayer"   lNumberLayer)   ;; 문자 레이어
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextColor"   lNumberColor)   ;; 문자 색상
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriLayer"    lTriangleLayer) ;; 도형 레이어
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriColor"    lTriangleColor) ;; 도형 색상
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleLayer" lCircleLayer) ;; 원 레이어
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleColor" lCircleColor) ;; 원 색상
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableLayer"  lTableLayer)  ;; 표 레이어
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableColor"  lTableColor)  ;; 표 색상
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextStyle"   lNumberStyle) ;; 문자 스타일
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CellSize"    lTableSize)   ;; 표 셀 높이
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleSize"  lCircleSize)  ;; 원 표시 크기
            (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PerpendicularSize" lPerpendicularSize)   ;; 수직 표시 크기
   ;;---------------------------------------------------------------------------------------------
   (setq lXPT (car  lDlgPT))
   (setq lYPT (cadr lDlgPT))
   (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "XPT" lXPT)
   (vl-registry-write "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "YPT" lYPT)
   (Mensuration_Main)
   ;;---------------------------------------------------------------------------------------------
  )
 )
 (term_dialog)
 ;;-----------------------------------------------------------------------------------------------------
 (unload_dialog ldcl_dp)
 ;;-----------------------------------------------------------------------------------------------------
 (princ)
)
;;=========================================================================================================
;;=========================================================================================================
;;=========================================================================================================
(defun ConfigDlg(dPathConfigDCL dConfigList)
 (setq dTriangleLayer    (nth  0 dConfigList))
 (setq dTriangleColor    (nth  1 dConfigList))
 (setq dNumberLayer      (nth  2 dConfigList))
 (setq dNumberColor      (nth  3 dConfigList))
 (setq dCircleLayer      (nth  4 dConfigList))
 (setq dCircleColor      (nth  5 dConfigList))
 (setq dTableLayer       (nth  6 dConfigList))
 (setq dTableColor       (nth  7 dConfigList))
 (setq dNumberStyle      (nth  8 dConfigList))
 (setq dTableSize        (nth  9 dConfigList))
 (setq dCircleSize       (nth 10 dConfigList))
 (setq dPerpendicularSize(nth 11 dConfigList))
 ;;-----------------------------------------------------------------------------------------------------
 (setq ddcl_dp (load_dialog dPathConfigDCL))
 (if (not (new_dialog "MENSURATIONCONFIG" ddcl_dp))(exit))
 ;;-----------------------------------------------------------------------------------------------------
 (set_tile "TriangleLayer"      dTriangleLayer)
 (set_tile "TriangleColor"      dTriangleColor)
 (set_tile "NumberLayer"        dNumberLayer)
 (set_tile "NumberColor"        dNumberColor)
 (set_tile "CircleLayer"       dCircleLayer)
 (set_tile "CircleColor"       dCircleColor)
 (set_tile "TableLayer"        dTableLayer)
 (set_tile "TableColor"        dTableColor)
 (set_tile "NumberStyle"       dNumberStyle)
 (set_tile "TableSize"         dTableSize)
 (set_tile "CircleSize"        dCircleSize)
 (set_tile "PerpendicularSize" dPerpendicularSize)
 ;;-----------------------------------------------------------------------------------------------------
 (action_tile "TriangleLayer"     "(setq dTriangleLayer $value)")
 (action_tile "TriangleColor"     "(setq dTriangleColor $value)")
 (action_tile "NumberLayer"       "(setq dNumberLayer $value)")
 (action_tile "NumberColor"       "(setq dNumberColor $value)")
 (action_tile "CircleLayer"       "(setq dCircleLayer $value)")
 (action_tile "CircleColor"       "(setq dCircleColor $value)")
 (action_tile "TableLayer"        "(setq dTableLayer $value)")
 (action_tile "TableColor"        "(setq dTableColor $value)")
 (action_tile "NumberStyle"       "(setq dNumberStyle $value)")
 (action_tile "TableSize"         "(setq dTableSize $value)")
 (action_tile "CircleSize"        "(setq dCircleSize $value)")
 (action_tile "PerpendicularSize" "(setq dPerpendicularSize $value)")
 ;;-----------------------------------------------------------------------------------------------------
 (setq dRtnDLG (start_dialog))
 ;;-----------------------------------------------------------------------------------------------------
 (if (= dRtnDLG 1)
  (progn
   (setq dConfigList (list dTriangleLayer dTriangleColor dNumberLayer dNumberColor dCircleLayer dCircleColor dTableLayer dTableColor dNumberStyle dTableSize dCircleSize dPerpendicularSize))
  )
 )
 ;;-----------------------------------------------------------------------------------------------------
 (unload_dialog ddcl_dp)
 ;;-----------------------------------------------------------------------------------------------------
 dConfigList
)
;;=============================================================================================================
;;=============================================================================================================
(princ "\nhttp://cafe.daum.net/zwcad  &  http://www.lispcenter.net")
(princ)