442 lines
19 KiB
Common Lisp
Executable File
442 lines
19 KiB
Common Lisp
Executable File
;;; ==============================================
|
|
;;; csauto.lsp - Complex Dam Section (Area, CSV, Plan Lines, STA Labels v2)
|
|
;;; Command: CSAUTO
|
|
;;; ==============================================
|
|
(vl-load-com)
|
|
|
|
;; -------------------------
|
|
;; 기본 벡터 함수
|
|
;; -------------------------
|
|
(defun vec-sub (a b) (mapcar '- a b))
|
|
(defun vec-dot (a b) (apply '+ (mapcar '* a b)))
|
|
(defun vec-len (v) (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) v))))
|
|
(defun vec-unit (v / L)
|
|
(setq L (vec-len v))
|
|
(if (> L 1e-9)
|
|
(mapcar '(lambda (x) (/ x L)) v)
|
|
'(0.0 0.0 0.0)
|
|
)
|
|
)
|
|
|
|
(defun group-3 (lst / res)
|
|
(while (and lst (caddr lst))
|
|
(setq res (cons (list (car lst) (cadr lst) (caddr lst)) res))
|
|
(setq lst (cdddr lst))
|
|
)
|
|
(reverse res)
|
|
)
|
|
|
|
(defun my-last (lst / cur)
|
|
(if lst
|
|
(progn
|
|
(setq cur (car lst))
|
|
(while (cdr lst)
|
|
(setq lst (cdr lst)
|
|
cur (car lst))
|
|
)
|
|
cur
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun merge-same-d (pts / res curD sumZ cnt p tolD)
|
|
(setq tolD 0.5)
|
|
(setq res '() curD nil sumZ 0.0 cnt 0)
|
|
(foreach p pts
|
|
(if (or (null curD) (> (abs (- (car p) curD)) tolD))
|
|
(progn
|
|
(if curD (setq res (append res (list (list curD (/ sumZ cnt))))))
|
|
(setq curD (car p) sumZ (cadr p) cnt 1)
|
|
)
|
|
(progn
|
|
(setq sumZ (+ sumZ (cadr p)) cnt (1+ cnt))
|
|
)
|
|
)
|
|
)
|
|
(if curD (setq res (append res (list (list curD (/ sumZ cnt))))))
|
|
res
|
|
)
|
|
|
|
(defun smooth-section (pts / res prev cur next avg ztol rest)
|
|
(setq ztol 50.0)
|
|
(cond
|
|
((<= (length pts) 2) pts)
|
|
(T
|
|
(setq res (list (car pts)))
|
|
(setq prev (car pts))
|
|
(setq rest (cdr pts))
|
|
(while (> (length rest) 1)
|
|
(setq cur (car rest) next (cadr rest))
|
|
(setq avg (/ (+ (cadr prev) (cadr next)) 2.0))
|
|
(if (> (abs (- (cadr cur) avg)) ztol)
|
|
(setq res (append res (list (list (car cur) avg))))
|
|
(setq res (append res (list cur)))
|
|
)
|
|
(setq prev cur rest (cdr rest))
|
|
)
|
|
(setq res (append res (list (car rest))))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; -------------------------
|
|
;; STA 레이블 형식 생성 함수
|
|
;; 예: 0번째 -> "STA.00", 1번째 -> "STA.01", 5번째 -> "STA.05"
|
|
;; -------------------------
|
|
(defun format-sta-label (idx / lbl)
|
|
(setq lbl (rtos idx 2 0))
|
|
(while (< (strlen lbl) 2) (setq lbl (strcat "0" lbl)))
|
|
(strcat "STA." lbl)
|
|
)
|
|
|
|
;; -------------------------
|
|
;; 레이어 생성
|
|
;; -------------------------
|
|
(defun make-crosssection-layer (/)
|
|
(if (not (tblsearch "LAYER" "CROSSSECTION"))
|
|
(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 "CROSSSECTION") (cons 70 0) (cons 62 7) (cons 6 "CONTINUOUS")))
|
|
)
|
|
(if (not (tblsearch "LAYER" "CROSSSECTION_DAM"))
|
|
(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 "CROSSSECTION_DAM") (cons 70 0) (cons 62 1) (cons 6 "CONTINUOUS")))
|
|
)
|
|
)
|
|
|
|
(defun get-curve-z (obj / p)
|
|
(setq p (vlax-curve-getPointAtParam obj 0.0))
|
|
(if (and p (numberp (caddr p))) (caddr p) nil)
|
|
)
|
|
|
|
(defun make-section-polyline (basePt hScale vScale secOffset pts / drawBase drawPts n vlist)
|
|
(setq drawBase (list (car basePt) (+ (cadr basePt) secOffset) 0.0))
|
|
(setq drawPts '())
|
|
(foreach p pts
|
|
(if (and (numberp (car p)) (numberp (cadr p)))
|
|
(setq drawPts (append drawPts (list (list (+ (car drawBase) (* (car p) hScale)) (+ (cadr drawBase) (* (cadr p) vScale)) 0.0))))
|
|
)
|
|
)
|
|
(if (> (length drawPts) 1)
|
|
(progn
|
|
(setq n (length drawPts))
|
|
(setq vlist (mapcar '(lambda (pt) (cons 10 (list (car pt) (cadr pt)))) drawPts))
|
|
(entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "CROSSSECTION") (cons 90 n) (cons 70 0)) vlist))
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun add-center-marker (basePt vScale secOff centerZ / baseX baseY centerX centerY p1 p2 txtPt txtStr)
|
|
(if (not (numberp centerZ)) (setq centerZ 0.0))
|
|
(setq baseX (car basePt) baseY (cadr basePt))
|
|
(setq centerX baseX)
|
|
(setq centerY (+ baseY secOff (* centerZ vScale)))
|
|
|
|
(setq p1 (list centerX (- centerY 2.5) 0.0))
|
|
(setq p2 (list centerX (+ centerY 2.5) 0.0))
|
|
(entmakex (list (cons 0 "LINE") (cons 8 "CROSSSECTION") (cons 10 p1) (cons 11 p2)))
|
|
|
|
(setq txtPt (list centerX (- centerY 5.0) 0.0))
|
|
(setq txtStr (rtos centerZ 2 2))
|
|
(entmakex (list (cons 0 "TEXT") (cons 8 "CROSSSECTION") (cons 62 1) (cons 10 txtPt) (cons 40 3.0) (cons 1 txtStr) (cons 72 1) (cons 73 2) (cons 11 txtPt)))
|
|
)
|
|
|
|
(defun find-dam-intersection (relPts startPt slopeDir / p1 p2 p3 p4 x1 y1 x2 y2 x3 y3 x4 y4 dx1 dy1 dx2 dy2 det ua ub ints i)
|
|
(setq p3 startPt)
|
|
(setq p4 (list (+ (car p3) (car slopeDir)) (+ (cadr p3) (cadr slopeDir))))
|
|
(setq x3 (car p3) y3 (cadr p3) x4 (car p4) y4 (cadr p4) dx2 (- x4 x3) dy2 (- y4 y3))
|
|
(setq ints '() i 0)
|
|
(while (< i (1- (length relPts)))
|
|
(setq p1 (nth i relPts) p2 (nth (1+ i) relPts))
|
|
(setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2) dx1 (- x2 x1) dy1 (- y2 y1))
|
|
(setq det (- (* dx1 dy2) (* dy1 dx2)))
|
|
(if (not (equal det 0.0 1e-6))
|
|
(progn
|
|
(setq ua (/ (- (* (- x3 x1) dy2) (* (- y3 y1) dx2)) det))
|
|
(setq ub (/ (- (* (- x3 x1) dy1) (* (- y3 y1) dx1)) det))
|
|
(if (and (>= ua 0.0) (<= ua 1.0) (>= ub 0.0))
|
|
(setq ints (cons (list ub (list (+ x1 (* ua dx1)) (+ y1 (* ua dy1)))) ints))
|
|
)
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
(if ints (cadr (assoc (apply 'min (mapcar 'car ints)) ints)) nil)
|
|
)
|
|
|
|
;; -------------------------
|
|
;; 댐 단면 생성 및 면적 데이터 반환
|
|
;; -------------------------
|
|
(defun draw-dam-complex (basePt hScale vScale secOff crestZ crestW slopeML slopeMR bottomW relPts /
|
|
relPts5 relPts10 ptCrestL ptCrestR intL10 intR5out botR intR5in
|
|
terrainBetween damPts drawPts vlist drawBase damEnt damArea txtPt
|
|
intL_orig intR_orig terrainFill fillPts drawPtsF vlistF fillEnt fillArea fillTxtPt)
|
|
(setq damArea 0.0 fillArea 0.0) ;; 기본값 0
|
|
(setq relPts5 (mapcar '(lambda (p) (list (car p) (- (cadr p) 5.0))) relPts))
|
|
(setq relPts10 (mapcar '(lambda (p) (list (car p) (- (cadr p) 10.0))) relPts))
|
|
|
|
(make-section-polyline basePt hScale vScale secOff relPts5)
|
|
(make-section-polyline basePt hScale vScale secOff relPts10)
|
|
|
|
(setq ptCrestL (list (/ crestW -2.0) crestZ))
|
|
(setq ptCrestR (list (/ crestW 2.0) crestZ))
|
|
|
|
(setq intL10 (find-dam-intersection relPts10 ptCrestL (list (- slopeML) -1.0)))
|
|
(setq intR5out (find-dam-intersection relPts5 ptCrestR (list slopeMR -1.0)))
|
|
|
|
(if (and intL10 intR5out)
|
|
(progn
|
|
(setq botR (list (+ (car intL10) bottomW) (cadr intL10)))
|
|
(setq intR5in (find-dam-intersection relPts5 botR (list slopeMR 1.0)))
|
|
|
|
(if intR5in
|
|
(progn
|
|
(setq terrainBetween '())
|
|
(foreach p relPts5
|
|
(if (and (> (car p) (car intR5in)) (< (car p) (car intR5out)))
|
|
(setq terrainBetween (cons p terrainBetween))
|
|
)
|
|
)
|
|
(setq terrainBetween (reverse terrainBetween))
|
|
(setq damPts (append (list ptCrestL intL10 botR intR5in) terrainBetween (list intR5out ptCrestR)))
|
|
(setq drawBase (list (car basePt) (+ (cadr basePt) secOff) 0.0))
|
|
(setq drawPts (mapcar '(lambda (p) (list (+ (car drawBase) (* (car p) hScale)) (+ (cadr drawBase) (* (cadr p) vScale)))) damPts))
|
|
(setq vlist (mapcar '(lambda (pt) (cons 10 pt)) drawPts))
|
|
|
|
(setq damEnt
|
|
(entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
|
|
(cons 8 "CROSSSECTION_DAM") (cons 90 (length drawPts)) (cons 70 1)) vlist)))
|
|
|
|
(if damEnt
|
|
(progn
|
|
(setq damArea (vlax-curve-getArea (vlax-ename->vla-object damEnt)))
|
|
(setq txtPt (list (+ (car drawBase) 500.0) (+ (cadr drawBase) (* crestZ vScale)) 0.0))
|
|
(entmakex (list '(0 . "TEXT") (cons 8 "CROSSSECTION_DAM") (cons 62 3) (cons 10 txtPt)
|
|
(cons 40 (* 8.0 vScale)) (cons 1 (rtos damArea 2 2))))
|
|
|
|
;; ★ 원지반과 댐 사이 성토 단면적 계산 ★
|
|
(setq intL_orig (find-dam-intersection relPts ptCrestL (list (- slopeML) -1.0)))
|
|
(setq intR_orig (find-dam-intersection relPts ptCrestR (list slopeMR -1.0)))
|
|
(if (and intL_orig intR_orig)
|
|
(progn
|
|
(setq terrainFill '())
|
|
(foreach p relPts
|
|
(if (and (> (car p) (car intL_orig)) (< (car p) (car intR_orig)))
|
|
(setq terrainFill (cons p terrainFill))
|
|
)
|
|
)
|
|
(setq terrainFill (reverse terrainFill))
|
|
;; 성토 폴리곤: 좌측마루 → 좌측경사 → 원지반 → 우측경사 → 우측마루 (폐합)
|
|
(setq fillPts (append (list ptCrestL intL_orig) terrainFill (list intR_orig ptCrestR)))
|
|
(setq drawPtsF (mapcar '(lambda (p) (list (+ (car drawBase) (* (car p) hScale)) (+ (cadr drawBase) (* (cadr p) vScale)))) fillPts))
|
|
(setq vlistF (mapcar '(lambda (pt) (cons 10 pt)) drawPtsF))
|
|
(setq fillEnt
|
|
(entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
|
|
(cons 8 "CROSSSECTION_DAM") (cons 90 (length drawPtsF)) (cons 70 1)) vlistF)))
|
|
(if fillEnt
|
|
(progn
|
|
(setq fillArea (vlax-curve-getArea (vlax-ename->vla-object fillEnt)))
|
|
(entdel fillEnt) ;; 임시 폴리곤 삭제 (면적 계산 용도로만 사용)
|
|
(setq fillTxtPt (list (+ (car drawBase) 800.0) (+ (cadr drawBase) (* crestZ vScale)) 0.0))
|
|
(entmakex (list '(0 . "TEXT") (cons 8 "CROSSSECTION_DAM") (cons 62 6)
|
|
(cons 10 fillTxtPt) (cons 40 (* 8.0 vScale)) (cons 1 (rtos fillArea 2 2))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(list damArea fillArea) ;; 댐 전체 면적, 성토 단면적 리스트로 반환
|
|
)
|
|
|
|
;; -------------------------
|
|
;; 메인 명령: CSAUTO
|
|
;; -------------------------
|
|
(defun c:csauto ( /
|
|
alignEnt alignObj startPt paramStart startDist maxLen
|
|
dirPt closestOnAlign paramDir distDir dir availLen rangeLen stepDist
|
|
halfWidth hScale vScale basePt secSpace
|
|
crestZ crestW slopeML slopeMR bottomW
|
|
s d param cen der tan2D unitPerp
|
|
allCurves ssContours i ent obj zc
|
|
leftXY rightXY cenXY lnEnt lnObj inters p3list p
|
|
v dloc rawPts relPts secIdx first lastPt
|
|
centerZ secOff pPrev pCur dPrev dCur zPrev zCur lst nearest
|
|
endProcessed areaVal results exportFile f
|
|
staStr staPlanH staPlanPt staSecPt
|
|
areaResult fillAreaVal
|
|
)
|
|
|
|
(princ "\n=== Cross section & Complex Dam automation ===")
|
|
(make-crosssection-layer)
|
|
|
|
(setq alignEnt (car (entsel "\nSelect alignment (center line polyline): ")))
|
|
(if (null alignEnt) (progn (princ "\nNo alignment selected.") (princ) (exit)))
|
|
(setq alignObj (vlax-ename->vla-object alignEnt))
|
|
(setq maxLen (vlax-curve-getDistAtParam alignObj (vlax-curve-getEndParam alignObj)))
|
|
|
|
(setq startPt (getpoint "\nPick start point on alignment (Station 0): "))
|
|
(if (null startPt) (progn (princ "\nNo start point selected.") (princ) (exit)))
|
|
(setq paramStart (vlax-curve-getParamAtPoint alignObj startPt))
|
|
(setq startDist (vlax-curve-getDistAtParam alignObj paramStart))
|
|
|
|
(setq dirPt (getpoint startPt "\nPick direction point: "))
|
|
(if (null dirPt) (progn (princ "\nNo direction point selected.") (princ) (exit)))
|
|
(setq closestOnAlign (vlax-curve-getClosestPointTo alignObj dirPt))
|
|
(setq distDir (vlax-curve-getDistAtParam alignObj (vlax-curve-getParamAtPoint alignObj closestOnAlign)))
|
|
|
|
(if (>= distDir startDist) (setq dir 1 availLen (- maxLen startDist)) (setq dir -1 availLen startDist))
|
|
|
|
(setq rangeLen (getreal "\nLength along alignment from picked point (Enter = full available): "))
|
|
(if (or (null rangeLen) (<= rangeLen 0.0) (> rangeLen availLen)) (setq rangeLen availLen))
|
|
|
|
(setq stepDist (getreal "\nStation interval (e.g. 20): "))
|
|
(if (or (null stepDist) (<= stepDist 0.0)) (setq stepDist 20.0))
|
|
|
|
(setq halfWidth (getreal "\nHalf cross-section width (e.g. 100 => total 200): "))
|
|
(if (or (null halfWidth) (<= halfWidth 0.0)) (setq halfWidth 100.0))
|
|
|
|
(setq hScale (getreal "\nHorizontal scale (e.g. 1.0 or 0.01 for 1:100): "))
|
|
(if (or (null hScale) (<= hScale 0.0)) (setq hScale 1.0))
|
|
|
|
(setq vScale (getreal "\nVertical scale (e.g. 0.01 for 1:100): "))
|
|
(if (or (null vScale) (<= vScale 0.0)) (setq vScale 1.0))
|
|
|
|
(setq basePt (getpoint "\nPick base point to draw first cross-section: "))
|
|
(if (null basePt) (progn (princ "\nNo base point selected.") (princ) (exit)))
|
|
|
|
(setq secSpace (getreal "\nSpacing between sections (positive, will go downward in Y): "))
|
|
(if (or (null secSpace) (<= secSpace 0.0)) (setq secSpace 50.0))
|
|
|
|
;; ★ 입력창 예시 및 기본값 복구 부분 ★
|
|
(setq crestZ (getreal "\nDam Crest Elevation (ex: 150.0): "))
|
|
(if (null crestZ) (setq crestZ 150.0))
|
|
|
|
(setq crestW (getreal "\nDam Crest Width (ex: 5.0): "))
|
|
(if (null crestW) (setq crestW 5.0))
|
|
|
|
(setq slopeML (getreal "\nLeft Slope (1:m) - Enter 'm' for Left (ex: 1.5): "))
|
|
(if (null slopeML) (setq slopeML 1.5))
|
|
|
|
(setq slopeMR (getreal "\nRight Slope (1:m) - Enter 'm' for Right (ex: 1.5): "))
|
|
(if (null slopeMR) (setq slopeMR 1.5))
|
|
|
|
(setq bottomW (getreal "\nBottom Width (ex: 10.0): "))
|
|
(if (null bottomW) (setq bottomW 10.0))
|
|
|
|
(setq allCurves (ssget "X" '((0 . "LWPOLYLINE,POLYLINE,3DPOLY,3DPOLYLINE,SPLINE,LINE,ARC"))))
|
|
(if (or (null allCurves) (= (sslength allCurves) 0)) (progn (princ "\nNo curves found.") (princ) (exit)))
|
|
(setq ssContours allCurves)
|
|
|
|
(setq s 0.0 secIdx 0 results '() endProcessed nil)
|
|
|
|
(while (not endProcessed)
|
|
(if (>= s (- rangeLen 1e-4)) (progn (setq s rangeLen) (setq endProcessed T)))
|
|
(princ (strcat "\nProcessing station " (rtos s 2 2) "..."))
|
|
(setq d (+ startDist (* dir s)))
|
|
(setq cen (vlax-curve-getPointAtDist alignObj d))
|
|
(setq param (vlax-curve-getParamAtDist alignObj d))
|
|
(setq der (vlax-curve-getFirstDeriv alignObj param))
|
|
|
|
(if (and cen der)
|
|
(progn
|
|
(setq tan2D (vec-unit (list (* dir (car der)) (* dir (cadr der)) 0.0)))
|
|
(setq unitPerp (list (- (cadr tan2D)) (car tan2D) 0.0))
|
|
(setq cenXY (list (car cen) (cadr cen) 0.0))
|
|
(setq leftXY (list (- (car cenXY) (* (car unitPerp) halfWidth)) (- (cadr cenXY) (* (cadr unitPerp) halfWidth)) 0.0))
|
|
(setq rightXY (list (+ (car cenXY) (* (car unitPerp) halfWidth)) (+ (cadr cenXY) (* (cadr unitPerp) halfWidth)) 0.0))
|
|
|
|
;; ★ 평면도 댐 축에 횡단면 추출 라인(하늘색) 표시 추가 ★
|
|
(entmakex (list '(0 . "LINE") (cons 8 "CROSSSECTION") (cons 62 4) (cons 10 leftXY) (cons 11 rightXY)))
|
|
|
|
;; ★ 평면도 측선에 STA 레이블 표시 (좌측 끝점 외부, 하늘색) ★
|
|
(setq staStr (format-sta-label secIdx))
|
|
(setq staPlanH (* halfWidth 0.05))
|
|
(setq staPlanPt (list
|
|
(- (car leftXY) (* (car unitPerp) staPlanH 3.0))
|
|
(- (cadr leftXY) (* (cadr unitPerp) staPlanH 3.0))
|
|
0.0))
|
|
(entmakex (list '(0 . "TEXT") (cons 8 "CROSSSECTION") (cons 62 4)
|
|
(cons 10 staPlanPt) (cons 40 staPlanH) (cons 1 staStr)
|
|
(cons 72 1) (cons 73 2) (cons 11 staPlanPt)))
|
|
|
|
(setq rawPts '() i 0)
|
|
(while (< i (sslength ssContours))
|
|
(setq ent (ssname ssContours i) obj (vlax-ename->vla-object ent) zc (get-curve-z obj))
|
|
(if (and (numberp zc) (not (equal zc 0.0 1e-6)))
|
|
(progn
|
|
(setq lnEnt (entmakex (list (cons 0 "LINE") (cons 10 (list (car leftXY) (cadr leftXY) zc)) (cons 11 (list (car rightXY) (cadr rightXY) zc)))))
|
|
(if lnEnt
|
|
(progn
|
|
(setq lnObj (vlax-ename->vla-object lnEnt) inters (vlax-invoke obj 'IntersectWith lnObj 0))
|
|
(if (and inters (listp inters) (>= (length inters) 3))
|
|
(foreach p (group-3 inters)
|
|
(setq v (vec-sub p (list (car cenXY) (cadr cenXY) zc)) dloc (vec-dot v unitPerp))
|
|
(if (<= (abs dloc) halfWidth) (setq rawPts (cons (list dloc zc) rawPts)))))
|
|
(entdel lnEnt)))))
|
|
(setq i (1+ i)))
|
|
|
|
(if rawPts
|
|
(progn
|
|
(setq relPts (smooth-section (merge-same-d (vl-sort rawPts '(lambda (a b) (< (car a) (car b)))))))
|
|
(setq first (car relPts) lastPt (my-last relPts))
|
|
(if (> (car first) (- halfWidth)) (setq relPts (cons (list (- halfWidth) (cadr first)) relPts)))
|
|
(if (< (car lastPt) halfWidth) (setq relPts (append relPts (list (list halfWidth (cadr lastPt))))))
|
|
|
|
(setq centerZ 0.0 pPrev (car relPts) lst (cdr relPts) nearest pPrev)
|
|
(while lst
|
|
(setq pCur (car lst) dPrev (car pPrev) dCur (car pCur))
|
|
(if (< (abs (car pCur)) (abs (car nearest))) (setq nearest pCur))
|
|
(if (or (and (<= dPrev 0.0) (>= dCur 0.0)) (and (>= dPrev 0.0) (<= dCur 0.0)))
|
|
(setq centerZ (if (equal dPrev dCur 1e-9) (/ (+ (cadr pPrev) (cadr pCur)) 2.0) (+ (cadr pPrev) (* (/ (- 0.0 dPrev) (- dCur dPrev)) (- (cadr pCur) (cadr pPrev))))) lst nil))
|
|
(setq pPrev pCur lst (cdr lst)))
|
|
|
|
(setq secOff (- (* -1 secIdx secSpace) (* centerZ vScale)))
|
|
(make-section-polyline basePt hScale vScale secOff relPts)
|
|
|
|
;; ★ 횡단면 좌측에 STA 레이블 표시 (우측 정렬, 노란색) ★
|
|
(setq staSecPt (list
|
|
(- (car basePt) (* halfWidth hScale))
|
|
(+ (cadr basePt) secOff (* crestZ vScale))
|
|
0.0))
|
|
(entmakex (list '(0 . "TEXT") (cons 8 "CROSSSECTION") (cons 62 2)
|
|
(cons 10 staSecPt) (cons 40 (* 8.0 vScale)) (cons 1 staStr)
|
|
(cons 72 2) (cons 73 2) (cons 11 staSecPt)))
|
|
|
|
(add-center-marker basePt vScale secOff centerZ)
|
|
|
|
;; 댐을 그리고 면적을 가져와 리스트에 저장
|
|
(setq areaResult (draw-dam-complex basePt hScale vScale secOff crestZ crestW slopeML slopeMR bottomW relPts))
|
|
(setq areaVal (car areaResult)) ;; 댐 전체 면적
|
|
(setq fillAreaVal (cadr areaResult)) ;; 성토 단면적
|
|
(setq results (cons (list s areaVal fillAreaVal) results))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(setq s (+ s stepDist)) (setq secIdx (1+ secIdx))
|
|
)
|
|
|
|
;; === CSV 내보내기 부분 ===
|
|
(if results
|
|
(progn
|
|
(setq results (reverse results))
|
|
(setq exportFile (getfiled "Save Dam Area Data" "DamAreaResults" "csv" 1))
|
|
(if exportFile
|
|
(progn
|
|
(setq f (open exportFile "w"))
|
|
(write-line "Station,DamArea,FillArea" f)
|
|
(foreach line results
|
|
(write-line (strcat (rtos (car line) 2 2) "," (rtos (cadr line) 2 2) "," (rtos (caddr line) 2 2)) f)
|
|
)
|
|
(close f)
|
|
(princ (strcat "\nData exported to: " exportFile))
|
|
)
|
|
(princ "\nExport cancelled.")
|
|
)
|
|
)
|
|
)
|
|
(princ "\n=== csauto finished ===")
|
|
(princ)
|
|
) |