iDwgLsp 프로그램을 설치하면 구글 블로거에 등록된 리습코드를 구동 시켜주는 기능을 지원합니다. - 다운로드 사이트 : http://arx119.egloos.com/10973367 - 지원버전 오토캐드 (2007~2013)
2012년 12월 25일 화요일
[LISP-GSJ] MensurationFunc.lsp (포스트아이디 : 3534858698934110297)
;;======================================================================================================
;;======================================================================================================
;;======================================================================================================
(defun Mensuration_Main(/ *error* pNumFlag pTableLabel01 pTableLabel02 pTableLabel03 pTableLabel04 pTableLabel05 pUnitFlag pPlacesFlag
pPyongFlag pExcelFlag pCommaFlag pZeroFlag pNumberSize pNumberLayer pNumberColor pTriangleLayer pTriangleColor
pCircleLayer pCircleColor pTableLayer pTableColor pNumberStyle pTableSize pCircleSize pPerpendicularSize MkList
osmode_old cmdecho_old ortho_old gridmode_old snapmode_old blipmode_old dimzin_old pAreaList pTextList pCAreaList
pAddFlag pTrangleDataList pTablePT )
;;--------------------------------------------------------------------------------------------------
(setq osmode_old (getvar "osmode"))
(setq cmdecho_old (getvar "cmdecho"))
(setq ortho_old (getvar "orthomode"))
(setq gridmode_old (getvar "gridmode"))
(setq snapmode_old (getvar "snapmode"))
(setq blipmode_old (getvar "blipmode"))
(setq dimzin_old (getvar "dimzin"))
;;--------------------------------------------------------------------------------------------------
;(defun *error* (msg)
; (command "undo" "e")
; (setvar "osmode" osmode_old)
; (setvar "cmdecho" cmdecho_old)
; (setvar "orthomode" ortho_old)
; (setvar "gridmode" gridmode_old)
; (setvar "snapmode" snapmode_old)
; (setvar "blipmode" blipmode_old)
; (setvar "dimzin" dimzin_old)
; (princ "\n구적도 작성을 취소하였습니다!")
;)
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
(setq pNumFlag 1) ;; 넘버링
;;--------------------------------------------------------------------------------------------------
(setq pTableLabel01 (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label1"))
(setq pTableLabel02 (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label2"))
(setq pTableLabel03 (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label3"))
(setq pTableLabel04 (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label4"))
(setq pTableLabel05 (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "Label5"))
(setq pUnitFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "UnitFlag")) ;; 단위
(setq pPlacesFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PlacesFlag")) ;; 소수점
(setq pPyongFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PyongFlag")) ;; 평면적
;(setq pExcelFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "ExcelFlag")) ;; 엑셀
(setq pCommaFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CommaFlag")) ;; 컴마
(setq pZeroFlag (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "ZeroFlag")) ;; 0 억제
(setq pNumberSize (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextSize")) ;; 문자 크기
(setq pNumberLayer (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextLayer")) ;; 문자 레이어
(setq pNumberColor (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextColor")) ;; 문자 색상
(setq pTriangleLayer (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriLayer")) ;; 도형 레이어
(setq pTriangleColor (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TriColor")) ;; 도형 색상
(setq pCircleLayer (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleLayer")) ;; 원 레이어
(setq pCircleColor (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleColor")) ;; 원 색상
(setq pTableLayer (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableLayer")) ;; 표 레이어
(setq pTableColor (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TableColor")) ;; 표 색상
(setq pNumberStyle (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "TextStyle")) ;; 문자 스타일
(setq pTableSize (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CellSize")) ;; 표 셀 높이
(setq pCircleSize (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "CircleSize")) ;; 원 표시 크기
(setq pPerpendicularSize (vl-registry-read "HKEY_CURRENT_USER\\Software\\LispCenter\\Mensuration" "PerpendicularSize")) ;; 수직 표시 크기
;;--------------------------------------------------------------------------------------------------
(setq pUnitFlag (atoi pUnitFlag)) ;; 단위 1->mm², 2->cm², 3->m²
(setq pPlacesFlag (atoi pPlacesFlag)) ;; 소수점 자릿수
(setq pZeroFlag (atoi pZeroFlag)) ;; 후행 0 억제 0->억제 하지 않음, 1->억제
(setq pPyongFlag (atoi pPyongFlag)) ;; 평면적 -> 아직 X
;(setq pExcelFlag (atoi pExcelFlag)) ;; Excel -> 아직 X
(setq pCommaFlag (atoi pCommaFlag)) ;; 컴마
;;--------------------------------------------------------------------------------------------------
(setq pPerpendicularSize (atof pPerpendicularSize)) ;; 수직 표시 크기
;;--------------------------------------------------------------------------------------------------
(Func_MakeLayer pTriangleLayer 7 "Continuous" 1)
(if (or (= pTriangleColor "0") (= (strcase pTriangleColor) "BYLAYER"))
(setq pTriangleLayer (list pTriangleLayer 256 256)) ;; 도형 레이어
(setq pTriangleLayer (list pTriangleLayer (atoi pTriangleColor) 256)) ;; 도형 레이어
)
;;--------------------------------------------------------------------------------------------------
(Func_MakeLayer pNumberLayer 7 "Continuous" 1)
(if (or (= pNumberColor "0") (= (strcase pNumberColor) "BYLAYER"))
(setq pNumberLayer (list pNumberLayer 256 256)) ;; 문자 레이어
(setq pNumberLayer (list pNumberLayer (atoi pNumberColor) 256)) ;; 문자 레이어
)
;;--------------------------------------------------------------------------------------------------
(Func_MakeLayer pCircleLayer 7 "Continuous" 1)
(if (or (= pCircleColor "0") (= (strcase pCircleColor) "BYLAYER"))
(setq pCircleLayer (list pCircleLayer 256 256)) ;; 원 레이어
(setq pCircleLayer (list pCircleLayer (atoi pCircleColor) 256)) ;; 원 레이어
)
;;--------------------------------------------------------------------------------------------------
(Func_MakeLayer pTableLayer 7 "Continuous" 1)
(if (or (= pTableColor "0") (= (strcase pTableColor) "BYLAYER"))
(setq pTableLayer (list pTableLayer 256 256)) ;; 표 레이어
(setq pTableLayer (list pTableLayer (atoi pTableColor) 256)) ;; 표 레이어
)
;;--------------------------------------------------------------------------------------------------
(setq pNumberSize (atof pNumberSize)) ;; 문자 크기
(setq pCircleSize (* (atof pCircleSize) pNumberSize)) ;; 원 표시 크기
(setq pTableSize (* (atof pTableSize) pNumberSize)) ;; 표 셀 높이
;;--------------------------------------------------------------------------------------------------
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "blipmode" 0)
(if (= pZeroFlag 1)
(setvar "dimzin" 8) ;; 후행 0 억제
(setvar "dimzin" 1) ;; 후행 0 억제 하지 않음
)
;;--------------------------------------------------------------------------------------------------
(command "undo" "be")
;;--------------------------------------------------------------------------------------------------
(setq pAreaList (list )) ;; 삼각형 면적 List 초기화
(setq pTextList (list )) ;; 수식 텍스트 List 초기화
(setq pCAreaList (list )) ;; AREA 명령을 이용한 면적값 List 초기화
(setq pExcelList (list )) ;; Excel로 보낼 텍스트 리스트
;;--------------------------------------------------------------------------------------------------
(setq pAddFlag "Yes")
(while (= pAddFlag "Yes")
(setq pTrangleDataList (Trangle_Func pNumFlag pTriangleLayer pNumberLayer pNumberSize pCircleLayer pCircleSize pPlacesFlag pZeroFlag pUnitFlag pPerpendicularSize pNumberStyle))
;;----------------------------------------------------------------------------------------------
(initget "Yes No")
(setq pAddFlag (getkword "\n추가할 부분이 있습니까? <No>/Yes:"))
(if (or (= pAddFlag nil) (= pAddFlag "No"))
(setq pAddFlag "No")
(setq pAddFlag "Yes")
)
(setq pNumFlag (nth 0 pTrangleDataList))
(setq pAreaList (append pAreaList (nth 1 pTrangleDataList)))
(setq pTextList (append pTextList (nth 2 pTrangleDataList)))
(setq pCAreaList (append pCAreaList (nth 3 pTrangleDataList)))
(setq pExcelList (append pExcelList (nth 4 pTrangleDataList)))
;;---------------------------------------------------------------------------------------------
)
;;--------------------------------------------------------------------------------------------------
(command "undo" "e")
(command "undo" "be")
;;--------------------------------------------------------------------------------------------------
(setq pTablePT (getpoint "\n구적표가 그려질 점을 지정 :"))
(if (/= pTablePT nil)
(DrawTable_Func pTablePT pPlacesFlag pPyongFlag pUnitFlag pCommaFlag pTableLabel01 pTableLabel02 pTableLabel03 pTableLabel04 pTableLabel05 pAreaList pTextList pCAreaList pNumberSize pNumberLayer pTableSize pTableLayer pNumberStyle)
)
(if (= pExcelFlag 1)
(MensurationExcel pTableLabel01 pTableLabel02 pTableLabel03 pTableLabel04 pTableLabel05 pPlacesFlag pUnitFlag pPyongFlag pExcelList)
)
;;--------------------------------------------------------------------------------------------------
(command "undo" "e")
;;--------------------------------------------------------------------------------------------------
(setvar "osmode" osmode_old)
(setvar "cmdecho" cmdecho_old)
(setvar "orthomode" ortho_old)
(setvar "gridmode" gridmode_old)
(setvar "snapmode" snapmode_old)
(setvar "blipmode" blipmode_old)
(setvar "dimzin" dimzin_old)
;;--------------------------------------------------------------------------------------------------
(princ)
)
;;=====================================================================================================
;;=====================================================================================================
;; 구적 삼각형을 작도하는 루틴을 호출
;;=====================================================================================================
(defun Trangle_Func( iNumFlag iTriangleLayer iNumberLayer iNumberSize iCircleLayer iCircleSize iPlacesFlag iZeroFlag
iUnitFlag iPerpendicularSize iNumberStyle
/ iNumFlag iTriangleLayer iNumberLayer iNumberSize iCircleLayer iCircleSize iPlacesFlag iZeroFlag
iUnitFlag iPerpendicularSize iNumberStyle
iTriangleFlag iReverseFlag iDrawEntity iPickPoint iDrawDataList iAllEntity )
;;--------------------------------------------------------------------------------------------------
(setq iTriangleFlag "Yes") ;; 삼각형 모양 마음에 드는가 선택값
(setq iReverseFlag 0) ;; 삼각형의 모양이 마음에 들지 않을때 쉬프트할 갯수
;;--------------------------------------------------------------------------------------------------
(setq iDrawEntity (entlast)) ;; 이후 그려질 모든 도형의 기준
;;--------------------------------------------------------------------------------------------------
(setq iPickPoint (getpoint "\n구적도를 작성할 내부점 선택 :"))
;(setq iPickPoint (list 2049.59 -277.926 0.0))
;;--------------------------------------------------------------------------------------------------
;; 구적도 작성
(setq iDrawDataList (Draw_Triangle iPickPoint iNumFlag iReverseFlag iPlacesFlag iZeroFlag iUnitFlag iTriangleLayer iNumberLayer iNumberSize iTableLayer iTableSize iCircleLayer iCircleSize iPerpendicularSize iNumberStyle))
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
(initget "Yes No")
(setq iTriangleFlag (getkword "\n이 모양이 마음에 듭니까? No/<Yes>:"))
(if (or (= iTriangleFlag nil) (= iTriangleFlag "Yes"))
(progn
(setq iReverseFlag 1)
(setq iTriangleFlag "Yes")
)
(setq iReverseFlag 0)
)
;;--------------------------------------------------------------------------------------------------
(while (= iTriangleFlag "No") ;; 모양이 마음에 들지 않으면
(setq iAllEntity (Func_AfterEntitySelect iDrawEntity)) ;; 작도된 모든 엔티티 선택
(Command "Erase" iAllEntity "") ;; 작도된 모든 엔티티 삭제
;; 구적도 작성
(setq iDrawEntity (entlast))
(setq iDrawDataList (Draw_Triangle iPickPoint iNumFlag iReverseFlag iPlacesFlag iZeroFlag iUnitFlag iTriangleLayer iNumberLayer iNumberSize iTableLayer iTableSize iCircleLayer iCircleSize iPerpendicularSize iNumberStyle))
(setq iReverseFlag (+ iReverseFlag 1)) ;; 쉬프트 갯수 증가
(initget "Yes No")
(setq iTriangleFlag (getkword "\n이 모양이 마음에 듭니까? No/<Yes>:"))
(if (or (= iTriangleFlag nil) (= iTriangleFlag "Yes"))
(setq iTriangleFlag "Yes")
(setq iTriangleFlag "No")
)
)
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
iDrawDataList
)
;;=====================================================================================================
;;=====================================================================================================
;; 구적 삼각형을 작도하고 면적을 계산한다.
;;=====================================================================================================
(defun Draw_Triangle( PickPoint NumFlag ReverseFlag PlacesFlag ZeroFlag UnitFlag TriangleLayer NumberLayer NumberSize TableLayer
TableSize CircleLayer CircleSize PerpendicularSize NumberStyle
/ PickPoint NumFlag ReverseFlag PlacesFlag ZeroFlag UnitFlag TriangleLayer NumberLayer NumberSize TableLayer
TableSize CircleLayer CircleSize PerpendicularSize NumberStyle
EntityFlag PolyEntity PolyPTList ListLength DumyEntity AreaList TextList CAreaList ExcelList BulgsCheck BulgsList
lTemp01 lTemp02 ARCDataList TotalArea TempList RepNum MPT01 MPT02 MPT03 MidPT InOut TmpPT01 TmpPT02 LineEntity
IntersPTList TriangleEntity TempList PerpendicularList TriPT01 TriPT02 TriPT03 TriPT04 TriPT05 CommandArea TRIDataList )
;;--------------------------------------------------------------------------------------------------
;(setq EntityFlag (bpoly PickPoint))
(setq EntityFlag (Func_ZWBPoly PickPoint))
;;--------------------------------------------------------------------------------------------------
(if (= EntityFlag nil)
;;(MessageBox "구적도를 작성한 도형의 내부점 선택 " "error" "okonly")
(alert "구적도를 작성한 도형의 내부점 선택 ")
(setq PolyEntity (entlast)) ;; 원본과 동일한 LWPolyLine Entity
)
;;--------------------------------------------------------------------------------------------------
(setq PolyPTList (Func_EntityToPoint PolyEntity)) ;; LWPolyLine 좌표 리스트
;;--------------------------------------------------------------------------------------------------
(setq ListLength (length PolyPTList)) ;; 좌표 갯수
(setq DumyEntity (AddLWPolyLine PolyPTList 0 1 TriangleLayer)) ;; 원 또는 호를 직선으로 변환한 도형
;;--------------------------------------------------------------------------------------------------
(setq AreaList (list )) ;; 삼각형 면적 List 초기화
(setq TextList (list )) ;; 수식 텍스트 List 초기화
(setq CAreaList (list )) ;; AREA 명령을 이용한 면적값 List 초기화
(setq ExcelList (list )) ;; Excel로 보낼 계산식이 분리된 List 초기화
;;--------------------------------------------------------------------------------------------------
;; ARC 관련
(setq BulgsCheck (LWPolyLineBulgsCheck PolyEntity)) ;; ARC 존재 여부
(setq BulgsList (LWPolyLineBulgs PolyEntity)) ;; LWPolyLine ARC 정보 리스트
;;--------------------------------------------------------------------------------------------------
;; 모양이 마음에 들지 않을때 좌표를 쉬프트한다.
(repeat ReverseFlag
(setq lTemp01 (car PolyPTList))
(setq lTemp02 (car BulgsList))
(setq PolyPTList (append (cdr PolyPTList) (list lTemp01)))
(setq BulgsList (append (cdr BulgsList) (list lTemp02)))
)
;;--------------------------------------------------------------------------------------------------
(if (= BulgsCheck 'T) ;; 도형내에 ARC가 존재하면
(progn
(setq ARCDataList (BulgsAreaList BulgsList PolyPTList PolyEntity NumFlag PlacesFlag ZeroFlag UnitFlag TriangleLayer NumberLayer NumberSize CircleLayer CircleSize NumberStyle ReverseFlag))
(setq NumFlag (nth 0 ARCDataList))
(setq AreaList (nth 1 ARCDataList))
(setq TextList (nth 2 ARCDataList))
(setq CAreaList (nth 3 ARCDataList))
(setq ExcelList (nth 4 ARCDataList))
)
)
;;--------------------------------------------------------------------------------------------------
(setq TotalArea (Func_EntityAreaCommand PolyEntity)) ;; 원본 도형 전체 면적 구하기
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
;; 직선 관련
(setq TempList (list)) ;; 버려질 좌표를 저장할 임시 리스트
(setq RepNum 0)
(While (> (- ListLength 2 1) RepNum) ;;
(setq MPT01 (nth 0 PolyPTList)) ;; 시작 좌표
(setq MPT02 (nth 1 PolyPTList)) ;; 종료 좌표
(setq MPT03 (nth 2 PolyPTList))
;;-------------------------------------------------------------------------------------------
;; 삼각형의 밑변의 중심이 내부점인지 판단
(setq MidPT (Func_MidPoint MPT03 MPT01))
(setq InOut (Func_EntityInternal MidPT DumyEntity))
;;-------------------------------------------------------------------------------------------
;; 삼각형의 밑변이 더미 객체에 포함되는지 판단
;; 교차점이 존재하지 않으면 내부에 존재하는 객체이다.
(setq TmpPT01 (polar MPT01 (angle MPT01 MPT03) 0.1)) ;;
(setq TmpPT02 (polar MPT03 (angle MPT03 MPT01) 0.1)) ;;
(command "line" TmpPT01 TmpPT02 "")
(setq LineEntity (entlast))
(setq IntersPTList (Func_IntersectEntityExtendNone DumyEntity LineEntity))
(entdel LineEntity)
;;-------------------------------------------------------------------------------------------
(if (and (= InOut 'T) (= (length IntersPTList) 0) (/= (angle MPT01 MPT02) (angle MPT02 MPT03)))
(progn
(setq TriangleEntity (AddLWPolyLine (list MPT01 MPT02 MPT03) 0 1 TriangleLayer))
(setq TempList (append TempList (list MPT01)))
;;----------------------------------------------------------------------------------
(setq RepNum (+ RepNum 1)) ;; 삼각형 갯수 추가
(setq PolyPTList (cdr PolyPTList)) ;; 사용된 좌표 삭제 -> MPT01
(setq PolyPTList (cdr PolyPTList)) ;; 사용된 좌표 삭제 -> MPT02
;;----------------------------------------------------------------------------------
(setq TriangleEntity (entlast))
;;----------------------------------------------------------------------------------
;; 수직선 그리기
(setq PerpendicularList (PerpendicularDraw TriangleEntity MPT01 MPT02 MPT03 PerpendicularSize TriangleLayer))
(setq TriPT01 (nth 0 PerpendicularList))
(setq TriPT02 (nth 1 PerpendicularList))
(setq TriPT03 (nth 2 PerpendicularList))
(setq TriPT04 (nth 3 PerpendicularList))
(setq TriPT05 (Func_MidPoint TriPT01 TriPT02))
(AddText (itoa NumFlag) "MC" TriPT05 NumberSize 0 NumberStyle NumberLayer) ;; 넘버링
(AddCircle TriPT05 (/ CircleSize 2.0) CircleLayer)
;;----------------------------------------------------------------------------------
(setq CommandArea (Func_EntityAreaCommand TriangleEntity)) ;; AREA 명령을 이용한 면적값
;;----------------------------------------------------------------------------------
(setq TRIDataList (CalculationTri TriPT01 TriPT02 TriPT03 TriPT04 PlacesFlag ZeroFlag UnitFlag))
(setq AreaList (append AreaList (list (nth 0 TRIDataList))))
(setq TextList (append TextList (list (nth 1 TRIDataList))))
(setq CAreaList (append CAreaList (list CommandArea)))
(setq ExcelList (append ExcelList (list (append (list 5) (nth 2 TRIDataList))))) ;; Excel로 보낸 텍스트 리스트
;;----------------------------------------------------------------------------------
(setq NumFlag (+ NumFlag 1)) ;; 삼각형 넘버링 증가
)
(progn
(setq PolyPTList (cdr PolyPTList))
(setq TempList (append TempList (list MPT01)))
)
)
;;-------------------------------------------------------------------------------------------
(if (<= (length PolyPTList) 2)
(progn
(setq PolyPTList (append PolyPtList TempList))
(setq TempList (list))
)
)
;;-------------------------------------------------------------------------------------------
)
;;--------------------------------------------------------------------------------------------------
(setq TriangleEntity (AddLWPolyLine PolyPTList 0 1 TriangleLayer)) ;; 마지막 삼각형 작도
;;--------------------------------------------------------------------------------------------------
(setq TriangleEntity (entlast))
;;--------------------------------------------------------------------------------------------------
;; 수직선 그리기
(setq MPT01 (nth 0 PolyPTList))
(setq MPT02 (nth 1 PolyPTList))
(setq MPT03 (nth 2 PolyPTList))
(setq PerpendicularList (PerpendicularDraw TriangleEntity MPT01 MPT02 MPT03 PerpendicularSize TriangleLayer))
(setq TriPT01 (nth 0 PerpendicularList))
(setq TriPT02 (nth 1 PerpendicularList))
(setq TriPT03 (nth 2 PerpendicularList))
(setq TriPT04 (nth 3 PerpendicularList))
(setq TriPT05 (Func_MidPoint TriPT01 TriPT02))
(AddText (itoa NumFlag) "MC" TriPT05 NumberSize 0 NumberStyle NumberLayer)
(AddCircle TriPT05 (/ CircleSize 2.0) CircleLayer)
;;--------------------------------------------------------------------------------------------------
(setq CommandArea (Func_EntityAreaCommand TriangleEntity)) ;; AREA 명령을 이용한 면적값
;;--------------------------------------------------------------------------------------------------
(setq TRIDataList (CalculationTri TriPT01 TriPT02 TriPT03 TriPT04 PlacesFlag ZeroFlag UnitFlag))
(setq AreaList (append AreaList (list (nth 0 TRIDataList))))
(setq TextList (append TextList (list (nth 1 TRIDataList))))
(setq CAreaList (append CAreaList (list CommandArea)))
(setq ExcelList (append ExcelList (list (append (list 5) (nth 2 TRIDataList))))) ;; Excel로 보낸 텍스트 리스트
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
(setq NumFlag (+ NumFlag 1)) ;; 삼각형 넘버링 증가
(entdel DumyEntity) ;; 더미 도형 삭제
;;--------------------------------------------------------------------------------------------------
(list NumFlag AreaList TextList CAreaList ExcelList)
)
;;=====================================================================================================
;;=====================================================================================================
;; 구적표를 작성하는 함수
;;=====================================================================================================
(defun DrawTable_Func( TablePT PlacesFlag PyongFlag UnitFlag CommaFlag TableLabel01 TableLabel02 TableLabel03 TableLabel04 TableLabel05
AreaList TextList CAreaList NumberSize NumberLayer TableSize TableLayer NumberStyle
/ TablePT PlacesFlag PyongFlag UnitFlag CommaFlag TableLabel01 TableLabel02 TableLabel03 TableLabel04 TableLabel05 TableLabel06
AreaList TextList CAreaList NumberSize NumberLayer TableSize TableLayer NumberStyle
RepNum MaxLength02 MaxLength03 CellLength01 CellLength02 CellLength03 CellLength04 CellLength05 TextLength01
TextLength02 TextLength03 TransNumber TablePT TablePT01 TablePT02 TablePT03 TablePT04 TablePT05 TablePT06 TablePT07
TextPT01 TextPT02 TextPT03 CellText01 CellText02 CellText03 SumArea )
(setq RepNum 0)
(setq MaxLength02 (Func_MaxLengthStringList TextList)) ;; 수식 텍스트 리스트에서 가장 길이가 긴 요소의 리스트 길이
(setq MaxLength03 (Func_MaxLengthNumberList AreaList PlacesFlag)) ;; 면적 리스트에서 가장 길이가 긴 요소의 리스트 길이
;;--------------------------------------------------------------------------------------------------
(setq CellLength01 (+ (* NumberSize 2.0) (* NumberSize 2.0)))
(setq CellLength02 (+ (* NumberSize MaxLength02) NumberSize))
(setq CellLength03 (+ (* NumberSize MaxLength03) (* NumberSize 2.0)))
(if (= PyongFlag 1)
(setq CellLength04 CellLength03)
(setq CellLength04 0.0)
)
(setq TextLength01 (* NumberSize 3.0))
(setq TextLength02 (* NumberSize MaxLength02))
(setq TextLength03 (* NumberSize (+ MaxLength03 1)))
;;--------------------------------------------------------------------------------------------------
(cond ;; 평면적 계산시 단위에 따른 변환값
((= UnitFlag 0)
(setq TransNumber 1000000.0)
)
((= UnitFlag 1)
(setq TransNumber 10000.0)
)
((= UnitFlag 2)
(setq TransNumber 1.0)
)
)
(setq TableLabel06 (strcat TableLabel04 "(평)"))
(cond
((= UnitFlag 0) ;; mm²
(setq TableLabel04 (strcat TableLabel04 "(㎟)"))
)
((= UnitFlag 1) ;; cm²
(setq TableLabel04 (strcat TableLabel04 "(㎠)"))
)
((= UnitFlag 2) ;; m²
(setq TableLabel04 (strcat TableLabel04 "(㎡)"))
)
)
;;--------------------------------------------------------------------------------------------------
;; Table Title
(AddMText TableLabel01 "TL" TablePT (* NumberSize 1.5) 0 (+ CellLength01 CellLength02 CellLength03) NumberStyle NumberLayer)
(setq TablePT (polar TablePT (* PI 1.5) TableSize))
;;--------------------------------------------------------------------------------------------------
(setq TablePT01 (Polar TablePT 0 CellLength01))
(setq TablePT02 (Polar TablePT 0 (+ CellLength01 CellLength02)))
(setq TablePT03 (polar TablePT 0 (+ CellLength01 CellLength02 CellLength03)))
(setq TablePT04 (Polar TablePT (* PI 1.5) TableSize))
(setq TablePT05 (Polar TablePT01 (* PI 1.5) TableSize))
(setq TablePT06 (Polar TablePT02 (* PI 1.5) TableSize))
(setq TablePT07 (Polar TablePT03 (* PI 1.5) TableSize))
;;--------------------------------------------------------------------------------------------------
(AddLWPolyLine (list TablePT TablePT03) 0 0 TableLayer)
(AddLWPolyLine (list TablePT TablePT04) 0 0 TableLayer)
(AddLWPolyLine (list TablePT01 TablePT05) 0 0 TableLayer)
(AddLWPolyLine (list TablePT02 TablePT06) 0 0 TableLayer)
(AddLWPolyLine (list TablePT03 TablePT07) 0 0 TableLayer)
;;--------------------------------------------------------------------------------------------------
;; Table Label
(setq TextPT01 (polar TablePT04 (/ PI 2.0) (/ TableSize 2.0)))
(setq TextPT02 (polar TablePT05 (/ PI 2.0) (/ TableSize 2.0)))
(setq TextPT03 (polar TablePT06 (/ PI 2.0) (/ TableSize 2.0)))
(AddMText TableLabel02 "MC" TextPT01 NumberSize 0 CellLength01 NumberStyle NumberLayer)
(AddMText TableLabel03 "MC" TextPT02 NumberSize 0 CellLength02 NumberStyle NumberLayer)
(AddMText TableLabel04 "MC" TextPT03 NumberSize 0 CellLength03 NumberStyle NumberLayer)
;;--------------------------------------------------------------------------------------------------
;; 평면적 추가
(if (= PyongFlag 1)
(progn
(setq TextPT03 (polar TablePT07 (/ PI 2.0) (/ TableSize 2.0)))
(AddLWPolyLine (list TablePT03 (polar TablePT03 0 CellLength04)) 0 0 TableLayer)
(AddLWPolyLine (list (polar TablePT03 0 CellLength04) (polar TablePT07 0 CellLength04)) 0 0 TableLayer)
(AddMText TableLabel06 "MC" TextPT03 NumberSize 0 CellLength04 NumberStyle NumberLayer)
(setq TablePT03 (polar TablePT03 0 CellLength04))
(setq TablePT07 (polar TablePT07 0 CellLength04))
)
)
;;--------------------------------------------------------------------------------------------------
(setq TablePT (polar TablePT (* PI 1.5) TableSize))
;;--------------------------------------------------------------------------------------------------
(repeat (length TextList)
(setq CellText01 (itoa (+ RepNum 1))) ;; 번호
(setq CellText02 (nth RepNum TextList)) ;; 수식 텍스트
(setq CellText03 (rtos (nth RepNum AreaList) 2 PlacesFlag)) ;; 면적
;;------------------------------------------------------------------------------------------
(setq TablePT01 (Polar TablePT 0 CellLength01))
(setq TablePT02 (Polar TablePT 0 (+ CellLength01 CellLength02)))
(setq TablePT03 (polar TablePT 0 (+ CellLength01 CellLength02 CellLength03)))
(setq TablePT04 (Polar TablePT (* PI 1.5) TableSize))
(setq TablePT05 (Polar TablePT01 (* PI 1.5) TableSize))
(setq TablePT06 (Polar TablePT02 (* PI 1.5) TableSize))
(setq TablePT07 (Polar TablePT03 (* PI 1.5) TableSize))
;;------------------------------------------------------------------------------------------
(AddLWPolyLine (list TablePT TablePT03) 0 0 TableLayer)
(AddLWPolyLine (list TablePT TablePT04) 0 0 TableLayer)
(AddLWPolyLine (list TablePT01 TablePT05) 0 0 TableLayer)
(AddLWPolyLine (list TablePT02 TablePT06) 0 0 TableLayer)
(AddLWPolyLine (list TablePT03 TablePT07) 0 0 TableLayer)
;;------------------------------------------------------------------------------------------
(setq TextPT01 (polar TablePT04 (/ PI 2.0) (/ TableSize 2.0)))
(setq TextPT02 (polar TablePT05 (/ PI 2.0) (/ TableSize 2.0)))
(setq TextPT02 (polar TextPT02 0 TableSize))
(setq TextPT03 (polar TablePT06 (/ PI 2.0) (/ TableSize 2.0)))
(AddMText CellText01 "MR" TextPT01 NumberSize 0 TextLength01 NumberStyle NumberLayer)
(AddMText CellText02 "ML" TextPT02 NumberSize 0 TextLength02 NumberStyle NumberLayer)
(AddMText CellText03 "MR" TextPT03 NumberSize 0 TextLength03 NumberStyle NumberLayer)
;;------------------------------------------------------------------------------------------
;; 평면적 추가
(if (= PyongFlag 1)
(progn
(AddLWPolyLine (list TablePT03 (polar TablePT03 0 CellLength04)) 0 0 TableLayer)
(AddLWPolyLine (list (polar TablePT03 0 CellLength04) (polar TablePT07 0 CellLength04)) 0 0 TableLayer)
(setq TablePT03 (polar TablePT03 0 CellLength04))
(setq TablePT07 (polar TablePT07 0 CellLength04))
)
)
;;------------------------------------------------------------------------------------------
(setq TablePT (polar TablePT (* PI 1.5) TableSize))
(setq RepNum (+ RepNum 1))
)
;;--------------------------------------------------------------------------------------------------
(setq TablePT01 (Polar TablePT 0 CellLength01))
(setq TablePT02 (Polar TablePT 0 (+ CellLength01 CellLength02)))
(setq TablePT03 (polar TablePT 0 (+ CellLength01 CellLength02 CellLength03)))
(setq TablePT04 (Polar TablePT (* PI 1.5) TableSize))
(setq TablePT05 (Polar TablePT01 (* PI 1.5) TableSize))
(setq TablePT06 (Polar TablePT02 (* PI 1.5) TableSize))
(setq TablePT07 (Polar TablePT03 (* PI 1.5) TableSize))
;;--------------------------------------------------------------------------------------------------
(AddLWPolyLine (list TablePT TablePT03) 0 0 TableLayer)
(AddLWPolyLine (list TablePT TablePT04) 0 0 TableLayer)
(AddLWPolyLine (list TablePT01 TablePT05) 0 0 TableLayer)
(AddLWPolyLine (list TablePT02 TablePT06) 0 0 TableLayer)
(AddLWPolyLine (list TablePT03 TablePT07) 0 0 TableLayer)
(AddLWPolyLine (list TablePT04 TablePT07) 0 0 TableLayer)
;;--------------------------------------------------------------------------------------------------
;; 면적 합계 텍스트
(setq SumArea (Func_ListSum AreaList))
(setq TextPT01 (polar TablePT04 (/ PI 2.0) (/ TableSize 2.0)))
(setq TextPT03 (polar TablePT06 (/ PI 2.0) (/ TableSize 2.0)))
(setq CellText01 TableLabel05)
(setq CellText03 (rtos SumArea 2 PlacesFlag))
(setq TextLength01 (* (strlen CellText01) NumberSize))
(setq TextLength03 (* NumberSize (+ MaxLength03 1)))
(AddMText CellText01 "MC" TextPT01 NumberSize 0 TextLength01 NumberStyle NumberLayer) ;; 총계 라벨
(AddMText CellText03 "MR" TextPT03 NumberSize 0 TextLength03 NumberStyle NumberLayer) ;; 면적
;;--------------------------------------------------------------------------------------------------
;; 평면적 추가
(if (= PyongFlag 1)
(progn
(setq SumArea (* (/ SumArea TransNumber) 0.3025)) ;; 평으로 변환
(setq TextPT03 (polar TablePT07 (/ PI 2.0) (/ TableSize 2.0)))
(AddLWPolyLine (list TablePT03 (polar TablePT03 0 CellLength04)) 0 0 TableLayer)
(AddLWPolyLine (list (polar TablePT03 0 CellLength04) (polar TablePT07 0 CellLength04)) 0 0 TableLayer)
(AddLWPolyLine (list TablePT07 (polar TablePT07 0 CellLength04)) 0 0 TableLayer)
(AddMText (rtos SumArea 2 PlacesFlag) "MC" TextPT03 NumberSize 0 CellLength04 NumberStyle NumberLayer)
(setq TablePT03 (polar TablePT03 0 CellLength04))
(setq TablePT07 (polar TablePT07 0 CellLength04))
)
)
;;--------------------------------------------------------------------------------------------------
(princ)
)
;;=====================================================================================================
;;=====================================================================================================
;; ARC의 계산
;;=====================================================================================================
(defun BulgsAreaList( lBulgsList lPolyPTList lPolyEntity lNumFlag lPlacesFlag lZeroFlag lUnitFlag lTriangleLayer lNumberLayer
lNumberSize lCircleLayer lCircleSize lNumberStyle lReverseFlag
/ lAreaList lTextList lCAreaList lTempNum lPolyPTList lBulgsValue lPT01 lPT02 lMidPT lInOut lArcList lArcRadius lArcCenter
lArcEntity lGravityPoint lWidth lHeight lArcAngle lArcCalculationList lArcCalculationArea lArcCalculationText lArcCommandArea lArcExcelLength)
(setq lAreaList (list )) ;; 면적 계산값 리스트
(setq lTextList (list )) ;; 수식 텍스트 리스트
(setq lCAreaList (list )) ;; Area 명령을 이용한 면적값 리스트
(setq lExcelList (list )) ;; Excel로 보낼 분리된 계산식 리스트
(setq lTempNum 0)
(setq lPolyPTList (append lPolyPTList (list (car lPolyPTList))))
;;--------------------------------------------------------------------------------------------------
(repeat (length lBulgsList)
(setq lBulgsValue (nth lTempNum lBulgsList)) ;; ARC 정보(Bulgs)
(if (/= lBulgsValue 0.0)
(progn
(setq lPT01 (nth lTempNum lPolyPTList))
(setq lPT02 (nth (+ lTempNum 1) lPolyPTList))
;;---------------------------------------------------------------------------------
;;(command "line" lPT01 lPT02 "")
;;---------------------------------------------------------------------------------
(setq lMidPT (Func_MidPoint lPT01 lPT02)) ;; ARC 밑변의 중점
(setq lInOut (Func_EntityInternal lMidPT lPolyEntity))
;;---------------------------------------------------------------------------------
;;(entdel (entlast)) ;; 임시 ARC 밑변 삭제
;;---------------------------------------------------------------------------------
(setq lArcList (Func_BulgeToARC lPT01 lPT02 lBulgsValue)) ;; ARC 정보 가지고 오기
(setq lArcRadius (nth 1 lArcList)) ;; ARC Radius
(setq lArcCenter (nth 0 lArcList)) ;; ARC Center
;;---------------------------------------------------------------------------------
(setq lArcEntity (AddLWpolyLineARC lPT01 lPT02 lBulgsValue lTriangleLayer)) ;; Close된 ARC 그리기
;;---------------------------------------------------------------------------------
(setq lGravityPoint (Func_EntityGravity lArcEntity)) ;; 무게중심
(setq lWidth (distance lPT01 lPT02)) ;; 양끝점의 길이
(setq lHeight (distance lMidPT lArcCenter)) ;; 양끝점의 중점에서 Arc의 중심점까지 거리
(setq lArcAngle (* (acosDegree (/ lHeight lArcRadius)) 2.0)) ;; ARC 각도
;;---------------------------------------------------------------------------------
(AddText (itoa lNumFlag) "MC" lGravityPoint lNumberSize 0 lNumberStyle lNumberLayer) ;; ARC의 무게 중심에 넘버 표시
(AddCircle lGravityPoint (/ lCircleSize 2.0) lCircleLayer) ;; 무게 중심에 넘버 원 표시
;;---------------------------------------------------------------------------------
;;(command "line" lPT01 lArcCenter "")
;;(command "line" lPT02 lArcCenter "")
;;---------------------------------------------------------------------------------
(setq lNumFlag (+ lNumFlag 1)) ;; 넘버링 증가
;;---------------------------------------------------------------------------------
(setq lArcCalculationList (CalculationARC lArcRadius lArcAngle lArcCenter lPT01 lPT02 lPlacesFlag lZeroFlag lUnitFlag))
(setq lArcCalculationArea (nth 0 lArcCalculationList)) ;; 면적
(setq lArcCalculationText (nth 1 lArcCalculationList)) ;; 계산식
(setq lArcExcelText (nth 2 lArcCalculationList)) ;; 엑셀로 보내 분리된 계산식 리스트
(setq lArcCommandArea (Func_EntityAreaCommand lArcEntity)) ;; AREA 명령을 이용한 면적값
(if (/= lInOut 'T) ;; 내부 점이면
(progn
(setq lAreaList (append lAreaList (list (* lArcCalculationArea -1))))
(setq lTextList (append lTextList (list (strcat "-(" lArcCalculationText ")"))))
(setq lCAreaList (append lCAreaList (list (* lArcCommandArea -1))))
(setq lArcExcelLength (+ (length lArcExcelText) 3)) ;; Excle로 보낸 리스트 길이
(setq lExcelList (append lExcelList (list (append (list lArcExcelLength "-" "(") lArcExcelText (list ")"))))) ;; Excel로 보낼 분리된 계산식 문자 리스트의 리스트
)
(progn
(setq lAreaList (append lAreaList (list lArcCalculationArea)))
(setq lTextList (append lTextList (list lArcCalculationText)))
(setq lCAreaList (append lCAreaList (list lArcCommandArea)))
(setq lArcExcelLength (length lArcExcelText)) ;; Excle로 보낸 리스트 길이
(setq lExcelList (append lExcelList (list (append (list lArcExcelLength) lArcExcelText)))) ;; Excel로 보낼 분리된 계산식 문자 리스트의 리스트
)
)
;;---------------------------------------------------------------------------------
)
)
(setq lTempNum (+ lTempNum 1))
)
(list lNumFlag lAreaList lTextList lCAreaList lExcelList) ;; 증가된 넘버링,
)
;;=====================================================================================================
;;=====================================================================================================
;; ARC 정보를 전달받아 ARC의 면적과 계산식을 리턴한다.
;;=====================================================================================================
(defun CalculationARC( dArcRadius dArcAngle dArcCenter dAPT01 dAPT02 dPlacesFlag dZeroFlag dUnitFlag
/ dArcRadius dArcAngle dArcCenter dAPT01 dAPT02 dPlacesFlag dZeroFlag dUnitFlag
dTriLength dTriHeight dARCArea dARCText dExcelText)
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
;; 완전한 호인지 삼각형 부분이 짤린 것인지 판단
;; 호의 중점-끝점 간의 길이와 호 양끝점의 길이/2.0이 일치하면 완전한 이다.
;; 단위 변환, 자릿수 변환 후에 하면 오차가 발생할 수 있으므로 미리 계산
;;--------------------------------------------------------------------------------------------------
;; (if (= (distance dArcCenter dAPT01) (/ (distance dAPT01 dAPT02) 2.0))
(if (equal (angle dArcCenter dAPT01) (angle dAPT02 dAPT01) 0.00001)
(progn ;; 완전한 호
(setq dARCText "")
(setq dARCArea 0.0)
(setq dExcelText (list )) ;; Excel로 보낼 분리된 계산식 텍스트 리스트
)
(progn ;; 불완전 호 -> 삼각형 부부의 면적을 빼주어야 한다.
(setq dTriLength (distance dAPT01 dAPT02))
(setq dTriHeight (/ (distance dArcCenter (Func_MidPoint dAPT01 dAPT02))))
(setq dTriLength (UnitPlaces dTriLength dUnitFlag)) ;; 단위
(setq dTriLength (DecimalPlaces dTriLength dPlacesFlag)) ;; 소수점
(setq dTriHeight (UnitPlaces dTriHeight dUnitFlag)) ;; 단위
(setq dTriHeight (DecimalPlaces dTriHeight dPlacesFlag)) ;; 소수점
(setq dARCArea (/ (* dTriLength dTriHeight) 2.0))
(setq dARCText (strcat "-" (rtos dTriHeight 2 dPlacesFlag) "X" (rtos dTriLength 2 dPlacesFlag) "/2"))
(setq dExcelText (list "-" (rtos dTriHeight 2 dPlacesFlag) "X" (rtos dTriLength 2 dPlacesFlag) "/" "2")) ;; Excel로 보낼 분리된 계산식 텍스트 리스트
)
)
;;--------------------------------------------------------------------------------------------------
(setq dArcRadius (UnitPlaces dArcRadius dUnitFlag)) ;; 반지름 단위 변환
(setq dArcRadius (DecimalPlaces dArcRadius dPlacesFlag)) ;; 반지름 소수점 자릿수 변환
(setq dArcAngle (DecimalPlaces dArcAngle dPlacesFlag)) ;; 각 도 소수점 자릿수 변환
;; (setq dARCText (strcat (rtos dArcRadius 2 dPlacesFlag) "X" (rtos dArcRadius 2 dPlacesFlag) "X" "π" "X" (rtos dArcAngle 2 dPlacesFlag) "/360" dARCText))
(setq dARCText (strcat (rtos dArcRadius 2 dPlacesFlag) "X" (rtos dArcRadius 2 dPlacesFlag) "X" "3.141592" "X" (rtos dArcAngle 2 dPlacesFlag) "/360" dARCText))
(setq dARCArea (- (* dArcRadius dArcRadius 3.141592 (/ dArcAngle 360.0)) dArcArea))
(setq dARCArea (DecimalPlaces dARCArea dPlacesFlag)) ;; 소수점
(setq dExcelText (append (list (rtos dArcRadius 2 dPlacesFlag) "X" (rtos dArcRadius 2 dPlacesFlag) "X" "3.141592" "X" (rtos dArcAngle 2 dPlacesFlag) "/" "360") dExcelText)) ;; Excel로 보낼 분리된 계산식 텍스트 리스트
(list dARCArea dARCText dExcelText)
)
;;=====================================================================================================
;;=====================================================================================================
;; 삼각형에서 수직선, 수직표 그리기
;; 수직점이 삼각형 내부(실제 교차)인지 판별하여 외부이면 좌표를 쉬프트 시킨다.
;;=====================================================================================================
(defun PerpendicularDraw( lEntityName00 lTRI01 lTRI02 lTRI03 lPerpendicularSize lTriangleLayer
/ lEntityName00 lTRI01 lTRI02 lTRI03 lPerpendicularSize lTriangleLayer
lTri00 lTri04 lTRI05 lTRI06 lTRI07 lTRI08 lEntityName01 lEntityName02 lEntityName03 lTRIAngle01 lTRIAngle02 lTRIAngle03)
(setq lTri04 nil) ;; 수직점 초기화
(while (= lTri04 nil)
(command "pline" lTRI01 lTRI02 lTRI03 "") ;; 윗변 그리기
(setq lEntityName01 (entlast))
(command "pline" lTRI01 lTRI03 "") ;; 밑변 그리기
(setq lEntityName02 (entlast))
;;-------------------------------------------------------------------------------------------------
(setq lTRI04 (Func_MidPoint lTRI01 lTRI03)) ;; 밑면의 중점
;;-------------------------------------------------------------------------------------------------
(setq lTRIAngle01 (angle lTRI01 lTRI03)) ;; 밑변의 각도
(setq lTRIAngle02 (- lTRIAngle01 (/ PI 2.0))) ;; 밑변에서 수직 각도
;;-------------------------------------------------------------------------------------------------
(if (= (substr (ver) 1 4) "LISP") ;; -> ZWCAD
(progn
(setq lTRI05 (polar lTRI04 lTRIAngle02 (distance lTRI01 lTRI03))) ;; 밑변에서 수직
(command "line" (polar lTRI04 (+ lTRIAngle02 PI) (distance lTRI01 lTRI03)) lTRI05 "") ;; 밑변에서 수직선 작도
)
(progn
(setq lTRI05 (polar lTRI04 lTRIAngle02 10)) ;; 밑변에서 수직
(command "line" lTRI04 lTRI05 "") ;; 밑변에서 수직선 작도
)
)
(setq lEntityName03 (entlast))
;;-------------------------------------------------------------------------------------------------
(setq lTRI05 (Func_IntersectEntityExtend lEntityName01 lEntityName03)) ;; 윗변과 수직선의 교차점 찾기
(setq lTRI05 (car lTRI05)) ;; 교차점
(setq lTRIAngle03 (angle lTRI05 lTRI04)) ;; 윗변 꼭지점과 수직점의 각도
;;-------------------------------------------------------------------------------------------------
(setq lTri04 (polar lTRI02 lTRIAngle03 10)) ;; 꼭지점에서 수직점으로
(setq lTri04 (inters lTri02 lTri04 lTri01 lTri03 nil)) ;; 밑변과 가상 교차점
(setq lTri04 (inters lTri02 lTri04 lTri01 lTri03 'T)) ;; 밑변과 실제 교차점
;;-------------------------------------------------------------------------------------------------
(if (= lTri04 nil) ;; 교차하지 않으면 좌표를 쉬프트한다.
(progn
(setq lTri04 nil)
(setq lTri00 lTri01)
(setq lTri01 lTri02)
(setq lTri02 lTri03)
(setq lTri03 lTri00)
)
)
(entdel lEntityName01)
(entdel lEntityName02)
(entdel lEntityName03)
)
;;-----------------------------------------------------------------------------------------------------
(AddLWPolyLine (list lTRI02 lTRI04) 0 0 lTriangleLayer)
(setq lTRI06 (polar lTRI04 lTRIAngle02 lPerpendicularSize))
(setq lTRI07 (polar lTRI06 (+ lTRIAngle01 PI) lPerpendicularSize))
(if (/= (Func_EntityInternal lTRI07 lEntityName00) 'T) ;; 직각 삼각형일 경우 수직 표시가 외부에 표시 될 수 있슴
(progn ;; 각도 계산을 잘하면 이 조건문이 필요 없을것 같으나 현재는 이 상태로...
(setq lTRI07 (polar lTRI06 lTRIAngle01 lPerpendicularSize))
(setq lTRI08 (polar lTRI04 lTRIAngle01 lPerpendicularSize))
)
(setq lTRI08 (polar lTRI04 (+ lTRIAngle01 PI) lPerpendicularSize))
)
(AddLWPolyLine (list lTRI06 lTRI07 lTRI08) 0 0 lTriangleLayer)
;;-----------------------------------------------------------------------------------------------------
(list lTri02 lTri04 lTri01 lTri03) ;; 변형된 삼각형의 꼭지점, 수직점, 밑변 좌표1, 밑변 좌표2
)
;;=====================================================================================================
;;=====================================================================================================
;; Radian -> Degree
;;=====================================================================================================
(defun rtd (a / a)
(* 180.0 (/ a PI))
)
;;=====================================================================================================
;;=====================================================================================================
;; Degree -> Radian
;;=====================================================================================================
(defun dtr (a)
(* PI (/ a 180.0))
)
;;=====================================================================================================
;;=====================================================================================================
;; 단위 변환
;;=====================================================================================================
(defun UnitPlaces(lNumber lUnitFlag / lNumber lUnitFlag lDivision)
(cond
((= lUnitFlag 0)
(setq lDivision 1.0)
)
((= lUnitFlag 1)
(setq lDivision 10.0)
)
((= lUnitFlag 2)
(setq lDivision 1000.0)
)
)
; (setq lDivision 1)
; (repeat lUnitFlag
; (setq lDivision (/ lDivision 10.0))
; )
(/ lNumber lDivision)
)
;;=====================================================================================================
;;=====================================================================================================
;; 소수점 자리수 맞추기
;;=====================================================================================================
(defun DecimalPlaces(lNumber lPlacesFlag / lNumber lPlacesFlag lMultiplication)
(setq lMultiplication 1)
(repeat lPlacesFlag
(setq lMultiplication (* lMultiplication 10.0))
)
(/ (fix (+ (* lNumber lMultiplication) 0.5)) lMultiplication)
)
;;==============================================================================================
;;==============================================================================================
;; Entity Add Circle
;; 삽입점, 반지름, Layer name, 색상, (list Name Color LType)
;;==============================================================================================
(defun AddCircle( iCenterPT iRadius iLayerSetList
/ iCenterPT iRadius iLayerSetList iLayerName iLayerColor iLayerLType MkList)
(setq iLayerName (nth 0 iLayerSetList))
(setq iLayerColor (nth 1 iLayerSetList))
(setq iLayerLType (nth 2 iLayerSetList))
(if (= iLayerLType 256)
(setq iLayerLType "ByLayer")
)
(setq MkList (list '(0 . "CIRCLE") (cons 8 iLayerName) (cons 10 iCenterPT)
(cons 40 iRadius) (cons 62 iLayerColor) (cons 6 iLayerLType)
)
)
(entmake MkList)
)
;;==============================================================================================
;;==============================================================================================
;; String, 정렬방식, 삽입점, 높이, 각도, LayerSetList
;; 을 전달 받아 Text를 EntMake 한다.
;;==============================================================================================
(defun AddText( iText iMode iptBase iHeight iRotation iStyle iLayerSetList
/ iText iMode iptBase iHeight iRotation iStyle iLayerSetList iLayerName iLayerColor iLayerLType MkList )
(if (= (tblsearch "style" iStyle) nil)
(progn
;(if (= (MessageBox (strcat "[ " iStyle " ] Style이(가) 존재하지 않습니다. \n\nStyle을 생성합니까?") "question" "okcancel") 1)
(command "style" iStyle "굴림체" 0 1 0 "N" "N")
; (exit)
;)
)
)
(setq iLayerName (nth 0 iLayerSetList))
(setq iLayerColor (nth 1 iLayerSetList))
(setq iLayerLType (nth 2 iLayerSetList))
(setq MkList (list '(0 . "TEXT") (cons 1 iText) (cons 7 iStyle) (cons 8 iLayerName ) (cons 10 iptBase)
(cons 40 iHeight) (cons 41 1) (cons 50 iRotation) (cons 62 iLayerColor)))
(cond
((= iMode "TC") (progn (setq MkList (append MkList (list (cons 11 iptBase) (cons 72 1) (cons 73 3)) )) ))
((= iMode "ML") (progn (setq MkList (append MkList (list (cons 11 iptBase) (cons 73 2)) )) ))
((= iMode "MC") (progn (setq MkList (append MkList (list (cons 11 iptBase) (cons 72 1) (cons 73 2)) )) ))
((= iMode "MR") (progn (setq MkList (append MkList (list (cons 11 iptBase) (cons 72 1) (cons 73 2)) )) ))
((= iMode "BC") (progn (setq MkList (append MkList (list (cons 11 iptBase) (cons 72 1) (cons 73 1)) )) ))
) ;; cond
(entmake MkList)
)
;;==============================================================================================
;;==============================================================================================
;; String, 정렬방식, 삽입점, 높이, 각도, LayerSetList
;; 을 전달 받아 Text를 EntMake 한다.
;;==============================================================================================
(defun AddMText( iText iMode iptBase iTextSize iRotation iTextLength iStyle iLayerSetList
/ iText iMode iptBase iTextSize iRotation iTextLength iStyle iLayerSetList MkList)
(if (= (tblsearch "style" iStyle) nil)
(progn
;(if (= (MessageBox (strcat "[ " iStyle " ] Style이(가) 존재하지 않습니다. \n\nStyle을 생성합니까?") "question" "okcancel") 1)
(command "style" iStyle "굴림체" 0 1 0 "N" "N")
; (exit)
;)
)
)
(setq iLayerName (nth 0 iLayerSetList))
(setq iLayerColor (nth 1 iLayerSetList))
(setq iLayerLType (nth 2 iLayerSetList))
(if (or (= iMode "TC") (= iMode "MC") (= iMode "BC"))
(setq iptBase (polar iptBase 0 (/ iTextLength 2.0)))
)
(if (or (= iMode "TR") (= iMode "MR") (= iMode "BR"))
(setq iptBase (polar iptBase 0 iTextLength))
)
(setq MkList (list '(0 . "MTEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 410 "Model") (cons 8 iLayerName) (cons 62 iLayerColor) (cons 100 "AcDbMText")
(cons 10 iptBase) (cons 40 iTextSize) (cons 41 iTextLength) (cons 1 iText) (cons 7 iStyle) (cons 50 iRotation)
(cons 43 iTextSize)
;;(cons 42 iHeight)
;;(cons 44 1.0)
;; SpacerTop SpacerBottom SpacerLeft SpacerRight
;; 10 : insert
;; 40 Nominal (initial) text height
;; 41 Reference rectangle width
;; 43 : 높이 -> 확인 필요
))
;;1 = Top left; 2 = Top center; 3 = Top right;
;;4 = Middle left; 5 = Middle center; 6 = Middle right;
;;7 = Bottom left; 8 = Bottom center; 9 = Bottom right
(cond
((= iMode "TL") (progn (setq MkList (append MkList (list (cons 71 1) (cons 72 5)) )) ))
((= iMode "TC") (progn (setq MkList (append MkList (list (cons 71 2) (cons 72 5)) )) ))
((= iMode "TR") (progn (setq MkList (append MkList (list (cons 71 3) (cons 72 5)) )) ))
((= iMode "ML") (progn (setq MkList (append MkList (list (cons 71 4) (cons 72 5)) )) ))
((= iMode "MC") (progn (setq MkList (append MkList (list (cons 71 5) (cons 72 5)) )) ))
((= iMode "MR") (progn (setq MkList (append MkList (list (cons 71 6) (cons 72 5)) )) ))
((= iMode "BL") (progn (setq MkList (append MkList (list (cons 71 7) (cons 72 5)) )) ))
((= iMode "BC") (progn (setq MkList (append MkList (list (cons 71 8) (cons 72 5)) )) ))
((= iMode "BR") (progn (setq MkList (append MkList (list (cons 71 9) (cons 72 5)) )) ))
) ;; cond
(entmake MkList)
(entlast)
)
;;=====================================================================================================
;;=====================================================================================================
;; LWPolyLine Entity에 ARC 존재여부 리턴
;;=====================================================================================================
(defun LWPolyLineBulgsCheck(eName / eName nRE lEntGet nLen lAss42 lCheck lTemp)
(setq nRE 0)
(setq lEntGet (entget eName)) ;; 정보
(setq nLen (length lEntGet)) ;; 포인트 갯수
(setq lCheck nil)
(setq lTemp 0)
(while (and (= lCheck nil) (> nLen lTemp))
(setq lAss42 (nth lTemp lEntGet))
(setq lTemp (+ lTemp 1))
(if (= (car lAss42) 42)
(if (= (cdr lAss42) 0.0)
(setq lCheck nil)
(setq lCheck T)
)
)
)
lCheck ;; ARC 존재 여부 리턴
)
;;=====================================================================================================
;;=====================================================================================================
;; LWPolyLine Entity를 ARC 정보 List를 전달한다.
;;=====================================================================================================
(defun LWPolyLineBulgs(eName / eName nRE lEntGet nLen lAss42 lptVertexs )
(setq nRE 0)
(setq lEntGet (entget eName)) ;; 정보
(setq nLen (length lEntGet)) ;; 포인트 갯수
(setq lptVertexs nil) ;; 초기화
(repeat nLen
(setq lAss42 (nth nRE lEntGet))
(setq nRE (+ nRE 1))
(if (= (car lAss42) 42)
(if (= lptVertexs nil)
(setq lptVertexs (list (cdr lAss42)))
(setq lptVertexs (append lptVertexs (list (cdr lAss42))))
)
)
)
lptVertexs ;; 포인트 리스트 반환
)
;;=====================================================================================================
;;=====================================================================================================
;; 두개의 점을 전달받아 Close된 아크인 도형을 작성한다.
;; PT01, PT02, ARC 정보, LayerList
;;=====================================================================================================
(defun AddLWpolyLineARC(lSTPT lEDPT lBulgs lLayerList / lSTPT lEDPT lBulgs lLayerList lLayerName lLayerColor lLayerLType lMakeList)
(setq lLayerName (nth 0 lLayerList))
(setq lLayerColor (nth 1 lLayerList))
(setq lLayerLType (nth 2 lLayerList))
(setq lMakeList (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 lLayerName) '(100 . "AcDbPolyline")
'(38 . 0.0) '(39 . 0.0) (cons 90 4) (cons 70 1) (cons 62 lLayerColor)
)
)
(if (and (/= lLayerLType "ByBlock") (/= lLayerLType "ByLayer") (/= lLayerLType 256))
(progn
(setq lMakeList (append lMakeList (list (cons 6 lLayerLType))))
)
)
(setq lMakeList (append lMakeList (list (cons 10 lSTPT) (cons 40 0) (cons 41 0) (cons 42 lBulgs))))
(setq lMakeList (append lMakeList (list (cons 10 lEDPT) (cons 40 0) (cons 41 0) (cons 42 0.0))))
(entmake lMakeList)
(redraw)
(entlast)
)
;;=====================================================================================================
;;=====================================================================================================
;; LWPolyLine을 EntMake 한다
;; Vertex List, Line Thick, Close or Open, Layer Name , LineType, Color을 전달 받는다.
;;=====================================================================================================
(defun AddLWPolyLine( iVertexs iWidth iMode iLayerSetList
/ iVertexs iWidth iMode iLayerSetList MkList VerLen re ptNext )
(setq iLayerName (nth 0 iLayerSetList))
(setq iLayerColor (nth 1 iLayerSetList))
(setq iLayerLType (nth 2 iLayerSetList))
(setq VerLen (length iVertexs) re 0)
(setq MkList (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 iLayerName) '(100 . "AcDbPolyline")
'(38 . 0.0) '(39 . 0.0) (cons 90 VerLen) (cons 70 iMode) (cons 62 iLayerColor)))
;; Line Type Load
(if (and (/= iLayerLType "ByBlock") (/= iLayerLType "ByLayer") (/= iLayerLType 256))
(progn
(setq MkList (append MkList (list (cons 6 iLayerLType))))
)
)
(repeat VerLen ;; Add Vertex List
(setq ptNext (nth re iVertexs) re (+ re 1))
(setq MkList (append MkList (list (cons 10 ptNext) (cons 40 iWidth) (cons 41 iWidth)) ))
)
(if (> VerLen 1)
(progn
(entmake MkList)
(setq iEntName (entlast))
)
(setq iEntName nil)
)
(redraw)
iEntName
)
;;=====================================================================================================
;;=====================================================================================================
;; 삼각형의 세개의 좌표와 수직점의 좌표를 전달받아 면적과 계산식을 리턴한다.
;; 삼각형의 꼭지점, 수직점, 밑변 좌표1, 밑변 좌표2
;;=====================================================================================================
(defun CalculationTri( dMPT01 dMPT02 dMPT03 dMPT04 dPlacesFlag dZeroFlag dUnitFlag
/ dMPT01 dMPT02 dMPT03 dMPT04 dPlacesFlag dZeroFlag dUnitFlag dTriHeight dTriLength dTriArea dTriText)
(setq dTriHeight (distance dMPT01 dMPT02))
(setq dTriLengtH (distance dMPT03 dMPT04))
(setq dTriHeight (UnitPlaces dTriHeight dUnitFlag)) ;; 단위
(setq dTriHeight (DecimalPlaces dTriHeight dPlacesFlag)) ;; 소수점
(setq dTriLength (UnitPlaces dTriLength dUnitFlag)) ;; 단위
(setq dTriLength (DecimalPlaces dTriLength dPlacesFlag)) ;; 소수점
(setq dTriArea (/ (* dTriLength dTriHeight) 2.0)) ;; 면적 계산
(setq dTriArea (DecimalPlaces dTriArea dPlacesFlag)) ;; 소수점
(setq dTriText (strcat (rtos dTriHeight 2 dPlacesFlag) "X" (rtos dTriLength 2 dPlacesFlag) "/2"))
(setq dExcelText (list (rtos dTriHeight 2 dPlacesFlag) "X" (rtos dTriLength 2 dPlacesFlag) "/" "2"))
(list dTriArea dTriText dExcelText)
)
;;=====================================================================================================
;;=====================================================================================================
;; acos를 계산해서 Degree 값으로 리턴
;;=====================================================================================================
(defun acosDegree(ixx / ixx)
(cond
((> (abs ixx) 1)
(alert "arguement to acos out of range ")
)
((= ixx 0)
(* (/ (/ PI 2.0) PI) 180.0)
)
((> ixx 0)
(* (/ (atan (/ (sqrt (- 1 (* ixx ixx))) ixx)) PI) 180.0)
)
((< ixx 0)
(* (/ (- PI (acos (abs ixx))) PI) 180.0)
)
)
)
;;=====================================================================================================
(princ)
피드 구독하기:
댓글 (Atom)
댓글 없음:
댓글 쓰기
즐거운 하루되세요...^^