横断面出图及横断面面积

cjf160204

横断面出图及横断面面积

cjf160204

(SETVAR "cmdecho" 0)
(command "_.undefine")
(command "dmt")
(command "_.undefine")
(command "dmj")
(setq *ACAD-OBJECT* nil)
(DEFUN ACAD-OBJECT () (COND (*ACAD-OBJECT*) (T (setq *ACAD-OBJECT* (vlax-get-acad-object)))))
(setq *ACTIVE-DOCUMENT* nil)
(DEFUN ACTIVE-DOCUMENT () (COND (*ACTIVE-DOCUMENT*) (T (setq *ACTIVE-DOCUMENT* (vla-get-ActiveDocument (ACAD-OBJECT))))))
(setq *MODEL-SPACE* nil)
(DEFUN MODEL-SPACE () (COND (*MODEL-SPACE*) (T (setq *MODEL-SPACE* (vla-get-ModelSpace (ACTIVE-DOCUMENT))))))
(REGAPP "XX_HDM_TFWF")
(if (NOT (TBLOBJNAME "style" "hz"))
    (PROGN
      (ENTMAKE '((0 . "STYLE")
                 (100 . "AcDbSymbolTableRecord")
                 (100 . "AcDbTextStyleTableRecord")
                 (2 . "HZ")
                 (70 . 0)
                 (40 . 0)
                 (41 . 0.8)
                 (50 . 0)
                 (71 . 0)
                 (42 . 0.2)
                 (3 . "rs.shx")
                 (4 . "hztxt.shx")))))
(if (NOT (TBLOBJNAME "LAYER" "XX_原地面里程文字标题"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_原地面里程文字标题")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_收方里程文字标题"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_收方里程文字标题")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_收方高程偏距标线"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_收方高程偏距标线")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_收方高程偏距文字"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_收方高程偏距文字")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_原地面高程偏距标线"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_原地面高程偏距标线")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_原地面高程偏距文字"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_原地面高程偏距文字")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_HDM_TFWF_LCWZ"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_HDM_TFWF_LCWZ")
                (70  . 0)
                (62  . 2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_HDM_TFWF_LCWZ_SF"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_HDM_TFWF_LCWZ_SF")
                (70  . 0)
                (62  . 2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_HDM_TFWF_TWWZ"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_HDM_TFWF_TWWZ")
                (70  . 0)
                (62  . -2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_HDM_TFWF_TWWZ_SF"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_HDM_TFWF_TWWZ_SF")
                (70  . 0)
                (62  . 2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_原地面断面多段线"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_原地面断面多段线")
                (70  . 0)
                (62  . 3)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(if (NOT (TBLOBJNAME "LAYER" "XX_收方断面多段线"))
    (PROGN
        (ENTMAKE
            '(
                (0   . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (2   . "XX_收方断面多段线")
                (70  . 0)
                (62  . 2)
                (6   . "Continuous")
                (290 . 1)
                (370 . -3)
            )
        )
    )
)
(VL-LOAD-COM)
(DEFUN HDM (PTS1 PT0 / XPT0 YPT0 ZPT0 GCWZS PJWZS APP DOC MS POINTS POINTS2 LW)
    (SETVAR "cmdecho" 0)
    (command "ucs")
    (command "")
    (SETVAR "dimzin" 0)
    (setq XPT0 (NTH 0 PT0))
    (setq YPT0 (NTH 1 PT0))
    (setq ZPT0 (NTH 2 PT0))
    (setq PJ0 0)
    (setq LC (NTH 0 (car PTS1)))
    (setq GC0 (NTH 3 (car PTS1)))
    (setq PTS1 (MAPCAR '(LAMBDA (X) (LIST (NTH 1 X) (NTH 2 X))) PTS1))
    (setq PTS2 (MAPCAR '(LAMBDA (X)
        (LIST
            (+ (- (NTH 0 X) PJ0) (NTH 0 PT0))
            (+ (- (NTH 1 X) GC0) (NTH 1 PT0))
        )
    ) PTS1))
    (setq GCWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 1 X) 2 3)) PTS1))
    (setq PJWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 0 X) 2 3)) PTS1))
    (setq APP (ACAD-OBJECT))
    (setq DOC (ACTIVE-DOCUMENT))
    (setq MS (MODEL-SPACE))
    (setq POINTS (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (LENGTH PTS2)) 1))))
    (setq POINTS2 (vlax-make-safearray vlax-vbDouble '(0 . 7)))
    (setq LW nil)
    (vlax-safearray-fill POINTS2 (LIST
        (+ XPT0 0.2138)
        (+ YPT0 0.3144)
        XPT0
        YPT0
        (+ XPT0 -0.2138)
        (+ YPT0 0.3144)
        (+ XPT0 0.9867)
        (+ YPT0 0.3144)
    ))
    (vla-AddLightWeightPolyline MS POINTS2)
    (setq BGFHDDX (ENTLAST))
    (setq BGFHDDX (ENTGET BGFHDDX))
    (setq BGFHDDX (SUBST (cons 8 "XX_标高符号多段线") (ASSOC 8 BGFHDDX) BGFHDDX))
    (ENTMOD BGFHDDX)
    (MAPCAR 'MKGCPJ PTS2 GCWZS PJWZS)
    (vlax-safearray-fill POINTS (APPLY 'APPEND PTS2))
    (setq LW (vla-AddLightWeightPolyline MS POINTS))
    (vla-put-Color LW 256)
    (vla-put-Layer LW "XX_原地面断面多段线")
    (setq EN (HANDENT (vla-get-Handle LW)))
    (setq ED (ENTGET EN))
    (setq ED (APPEND ED (LIST (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3)))))))
    (ENTMOD ED)
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_HDM_TFWF_LCWZ")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -1.2069) (+ (NTH 1 PT0) -3.0795) 0)
        '(40 . 0.6)
        (cons 1 (FORMAT_K LC 3))
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -2.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_HDM_TFWF_TWWZ")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -3.1464) (+ (NTH 1 PT0) -4.0795) 0)
        '(40 . 0.6)
        '(1 . "At=0.00    Aw=0.00")
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -3.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "LINE")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_原地面设计中桩线")
        '(62 . 1)
        '(100 . "AcDbLine")
        (cons 10 PT0)
        (cons 11 (LIST (NTH 0 PT0) (+ (NTH 1 PT0) 4) 0))
        '(210 0 0 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_原地面设计标高文字")
        '(100 . "AcDbMText")
        (LIST 10 (+ (NTH 0 PT0) -0.1639) (+ (NTH 1 PT0) 0.685) 0)
        '(40 . 0.3)
        '(41 . 0)
        '(46 . 0)
        '(71 . 1)
        '(72 . 5)
        (cons 1 (STRCAT "{\\W0.9;\\fSTSong|b0|i0|c134|p2;" (RTOS GC0 2 3) "}"))
        '(11 1 0 0)
        '(50 . 0)
        '(73 . 1)
        '(44 . 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_原地面里程文字标题")
        '(100 . "AcDbMText")
        (LIST 10 (+ (NTH 0 PT0) -1.9292) (+ (NTH 1 PT0) 9.569) 0)
        '(40 . 0.4)
        '(41 . 18.6)
        '(46 . 0)
        '(71 . 1)
        '(72 . 5)
        (cons 1 (STRCAT "{\\W0.9;\\fSTSong|b0|i0|c134|p2;" (FORMAT_K LC 3) "断面图}"))
        '(210 0 0 1)
        '(11 1 0 0)
        '(42 . 3.36109)
        '(43 . 0.567273)
        '(50 . 0)
        '(73 . 1)
        '(44 . 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (PRINC)
)
(DEFUN HDM2 (PTS1 PT0 / XPT0 YPT0 ZPT0 GCWZS PJWZS APP DOC MS POINTS POINTS2 LW)
    (SETVAR "cmdecho" 0)
    (command "ucs")
    (command "")
    (SETVAR "dimzin" 0)
    (setq XPT0 (NTH 0 PT0))
    (setq YPT0 (NTH 1 PT0))
    (setq ZPT0 (NTH 2 PT0))
    (setq PJ0 0)
    (setq LC (NTH 0 (car PTS1)))
    (setq GC0 (NTH 3 (car PTS1)))
    (setq PTS1 (MAPCAR '(LAMBDA (X) (LIST (NTH 1 X) (NTH 2 X))) PTS1))
    (setq PTS2 (MAPCAR '(LAMBDA (X)
        (LIST
            (+ (- (NTH 0 X) PJ0) (NTH 0 PT0))
            (+ (- (NTH 1 X) GC0) (NTH 1 PT0))
        )
    ) PTS1))
    (setq GCWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 1 X) 2 3)) PTS1))
    (setq PJWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 0 X) 2 3)) PTS1))
    (setq APP (ACAD-OBJECT))
    (setq DOC (ACTIVE-DOCUMENT))
    (setq MS (MODEL-SPACE))
    (setq POINTS (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (LENGTH PTS2)) 1))))
    (setq POINTS2 (vlax-make-safearray vlax-vbDouble '(0 . 7)))
    (setq LW nil)
    (vlax-safearray-fill POINTS2 (LIST
        (+ XPT0 0.2138)
        (+ YPT0 0.3144)
        XPT0
        YPT0
        (+ XPT0 -0.2138)
        (+ YPT0 0.3144)
        (+ XPT0 0.9867)
        (+ YPT0 0.3144)
    ))
    (vla-AddLightWeightPolyline MS POINTS2)
    (setq BGFHDDX (ENTLAST))
    (setq BGFHDDX (ENTGET BGFHDDX))
    (setq BGFHDDX (SUBST (cons 8 "XX_收方标高符号多段线") (ASSOC 8 BGFHDDX) BGFHDDX))
    (ENTMOD BGFHDDX)
    (MAPCAR 'MKGCPJ PTS2 GCWZS PJWZS)
    (vlax-safearray-fill POINTS (APPLY 'APPEND PTS2))
    (setq LW (vla-AddLightWeightPolyline MS POINTS))
    (vla-put-Color LW 256)
    (vla-put-Layer LW "XX_收方断面多段线")
    (setq EN (HANDENT (vla-get-Handle LW)))
    (setq ED (ENTGET EN))
    (setq ED (APPEND ED (LIST (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3)))))))
    (ENTMOD ED)
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_HDM_TFWF_LCWZ_SF")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -1.2069) (+ (NTH 1 PT0) -3.0795) 0)
        '(40 . 0.6)
        (cons 1 (FORMAT_K LC 3))
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -2.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_HDM_TFWF_TWWZ_SF")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -3.1464) (+ (NTH 1 PT0) -4.0795) 0)
        '(40 . 0.6)
        '(1 . "At=0.00    Aw=0.00")
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -3.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "LINE")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_收方设计中桩线")
        '(62 . 1)
        '(100 . "AcDbLine")
        (cons 10 PT0)
        (cons 11 (LIST (NTH 0 PT0) (+ (NTH 1 PT0) 4) 0))
        '(210 0 0 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_收方设计标高文字")
        '(100 . "AcDbMText")
        (LIST 10 (+ (NTH 0 PT0) -0.1639) (+ (NTH 1 PT0) 0.685) 0)
        '(40 . 0.3)
        '(41 . 0)
        '(46 . 0)
        '(71 . 1)
        '(72 . 5)
        (cons 1 (STRCAT "{\\W0.9;\\fSTSong|b0|i0|c134|p2;" (RTOS GC0 2 3) "}"))
        '(11 1 0 0)
        '(50 . 0)
        '(73 . 1)
        '(44 . 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (ENTMAKE (LIST
        '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_收方里程文字标题")
        '(100 . "AcDbMText")
        (LIST 10 (+ (NTH 0 PT0) -1.9292) (+ (NTH 1 PT0) 9.569) 0)
        '(40 . 0.4)
        '(41 . 18.6)
        '(46 . 0)
        '(71 . 1)
        '(72 . 5)
        (cons 1 (STRCAT "{\\W0.9;\\fSTSong|b0|i0|c134|p2;" (FORMAT_K LC 3) "断面图}"))
        '(210 0 0 1)
        '(11 1 0 0)
        '(42 . 3.36109)
        '(43 . 0.567273)
        '(50 . 0)
        '(73 . 1)
        '(44 . 1)
        (LIST -3 (LIST "XX_HDM_TFWF" (cons 1000 (FORMAT_K LC 3))))
    ))
    (PRINC)
)
(DEFUN HDM_ORG (/ XPT0 YPT0 ZPT0 GCWZS PJWZS APP DOC MS POINTS POINTS2 LW)
    (SETVAR "cmdecho" 0)
    (command "ucs")
    (command "")
    (SETVAR "dimzin" 0)
    (setq PT0 (GETPOINT "请选择参照点:"))
    (setq XPT0 (NTH 0 PT0))
    (setq YPT0 (NTH 1 PT0))
    (setq ZPT0 (NTH 2 PT0))
    (setq PJ0 (if (NOT (setq PJ0 (GETREAL "请输入参照点偏距:<0>"))) 0 PJ0))
    (setq GC0 (if (NOT (setq GC0 (GETREAL "请输入参照点高程:<530.698>"))) 530.698 GC0))
    (setq PTS1 '((-35.96 537.14)
                  (-31.68 537.13)
                  (5.11 536.42)
                  (16.23 536.3)
                  (21.23 536.28)
                  (36.2 536.29)))
    (setq PTS2 (MAPCAR '(LAMBDA (X)
        (LIST
            (+ (- (NTH 0 X) PJ0) (NTH 0 PT0))
            (+ (- (NTH 1 X) GC0) (NTH 1 PT0))
        )
    ) PTS1))
    (setq GCWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 1 X) 2 3)) PTS1))
    (setq PJWZS (MAPCAR '(LAMBDA (X) (RTOS (NTH 0 X) 2 3)) PTS1))
    (setq APP (ACAD-OBJECT))
    (setq DOC (ACTIVE-DOCUMENT))
    (setq MS (MODEL-SPACE))
    (setq POINTS (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (LENGTH PTS2)) 1))))
    (setq POINTS2 (vlax-make-safearray vlax-vbDouble '(0 . 7)))
    (setq LW nil)
    (vlax-safearray-fill POINTS2 (LIST
        (+ XPT0 0.2138)
        (+ YPT0 0.3144)
        XPT0
        YPT0
        (+ XPT0 -0.2138)
        (+ YPT0 0.3144)
        (+ XPT0 0.9867)
        (+ YPT0 0.3144)
    ))
    (vla-AddLightWeightPolyline MS POINTS2)
    (MAPCAR 'MKGCPJ PTS2 GCWZS PJWZS)
    (vlax-safearray-fill POINTS (APPLY 'APPEND PTS2))
    (setq LW (vla-AddLightWeightPolyline MS POINTS))
    (vla-put-Color LW 256)
    (vla-put-Layer LW "XX_原地面断面多段线")
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_DMTK")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -1.2069) (+ (NTH 1 PT0) -3.0795) 0)
        '(40 . 0.6)
        '(1 . "K0+000")
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -2.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        '(-3 ("XX_HDM_TFWF" (1000 . "990440")))
    ))
    (ENTMAKE (LIST
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_DMTK")
        '(6 . "Continuous")
        '(100 . "AcDbText")
        (LIST 10 (+ (NTH 0 PT0) -3.1464) (+ (NTH 1 PT0) -4.0795) 0)
        '(40 . 0.6)
        '(1 . "At=0.00    Aw=0.00")
        '(50 . 0)
        '(41 . 0.8)
        '(51 . 0)
        '(7 . "HZ")
        '(71 . 0)
        '(72 . 4)
        (LIST 11 (+ (NTH 0 PT0) 0.1759) (+ (NTH 1 PT0) -3.7795) 0)
        '(210 0 0 1)
        '(100 . "AcDbText")
        '(73 . 0)
        '(-3 ("XX_HDM_TFWF" (1000 . "990400")))
    ))
    (ENTMAKE (LIST
        '(0 . "LINE")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_原地面设计中桩线")
        '(62 . 1)
        '(100 . "AcDbLine")
        (cons 10 PT0)
        (cons 11 (LIST (NTH 0 PT0) (+ (NTH 1 PT0) 4) 0))
        '(210 0 0 1)
    ))
    (ENTMAKE (LIST
        '(0 . "MTEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        '(8 . "XX_0")
        '(100 . "AcDbMText")
        (LIST 10 (+ (NTH 0 PT0) -0.1639) (+ (NTH 1 PT0) 0.685) 0)
        '(40 . 0.3)
        '(41 . 0)
        '(46 . 0)
        '(71 . 1)
        '(72 . 5)
        '(1 . "{\\W0.9;\\fSTSong|b0|i0|c134|p2;463.50}")
        '(11 1 0 0)
        '(50 . 0)
        '(73 . 1)
        '(44 . 1)
    ))
    (PRINC)
)
(DEFUN MKGCPJ (PT GCWZ PJWZ)
    (if (OR (= nil TP) (= "D" TP))
        (PROGN
            (ENTMAKE (LIST
                '(0 . "MTEXT")
                '(100 . "AcDbEntity")
                '(67 . 0)
                '(410 . "Model")
                '(8 . "XX_原地面高程偏距文字")
                '(100 . "AcDbMText")
                (LIST 10 (NTH 0 PT) (+ (NTH 1 PT) 1.3193) 0)
                '(40 . 0.25)
                '(41 . 0)
                '(46 . 0)
                '(71 . 5)
                '(72 . 5)
                (cons 1 (STRCAT "\\pxqc;{\\fFangSong|b0|i0|c134|p49;高程:" GCWZ "\r\n偏距:" PJWZ "}"))
                '(7 . "Standard")
                '(210 0 0 1)
                '(11 1 1 0)
                '(42 . 2.13857)
                '(43 . 0.806667)
                '(50 . 1.5708)
                '(73 . 1)
                '(44 . 1)
            ))
            (ENTMAKE (LIST
                '(0 . "LINE")
                '(100 . "AcDbEntity")
                '(67 . 0)
                '(410 . "Model")
                '(8 . "XX_原地面高程偏距标线")
                '(100 . "AcDbLine")
                (LIST 10 (NTH 0 PT) (NTH 1 PT) 0)
                (LIST 11 (NTH 0 PT) (+ (NTH 1 PT) 2.5186) 0)
                '(210 0 0 1)
            ))
        )
        (PROGN
            (ENTMAKE (LIST
                '(0 . "MTEXT")
                '(100 . "AcDbEntity")
                '(67 . 0)
                '(410 . "Model")
                '(8 . "XX_收方高程偏距文字")
                '(100 . "AcDbMText")
                (LIST 10 (NTH 0 PT) (+ (NTH 1 PT) 1.3193) 0)
                '(40 . 0.25)
                '(41 . 0)
                '(46 . 0)
                '(71 . 5)
                '(72 . 5)
                (cons 1 (STRCAT "\\pxqc;{\\fFangSong|b0|i0|c134|p49;高程:" GCWZ "\r\n偏距:" PJWZ "}"))
                '(7 . "Standard")
                '(210 0 0 1)
                '(11 1 1 0)
                '(42 . 2.13857)
                '(43 . 0.806667)
                '(50 . 1.5708)
                '(73 . 1)
                '(44 . 1)
            ))
            (ENTMAKE (LIST
                '(0 . "LINE")
                '(100 . "AcDbEntity")
                '(67 . 0)
                '(410 . "Model")
                '(8 . "XX_收方高程偏距标线")
                '(100 . "AcDbLine")
                (LIST 10 (NTH 0 PT) (NTH 1 PT) 0)
                (LIST 11 (NTH 0 PT) (+ (NTH 1 PT) 2.5186) 0)
                '(210 0 0 1)
            ))
        )
    )
)
(DEFUN PARSE2 (STR DELIM / LST POS)
    (while (and (setq POS (VL-STRING-SEARCH DELIM STR)))
        (setq LST (APPEND LST (LIST (SUBSTR STR 1 POS))))
        (setq STR (SUBSTR STR (+ 2 POS)))
    )
    (if (> (STRLEN STR) 0)
        (APPEND LST (LIST STR))
        LST
    )
)
(DEFUN GETDATA (CLST DT / N0 N1 N2 N3 FN WJM P S)
    (if (AND (LISTP CLST) DT (/= DT ""))
        (PROGN
            (setq FN (GETFILED "请选择断面数据文件" "G:/" "txt" 128))
            (setq WJM nil)
            (setq P nil)
            (if (/= nil FN)
                (PROGN
                    (setq F (OPEN FN "r"))
                    (if (/= nil F)
                        (PROGN
                            (setq WJM (VL-FILENAME-BASE FN))
                            (while (and (AND (/= nil (setq S (READ-LINE F))) (/= S "")))
                                (setq S (PARSE2 S DT))
                                (setq P (APPEND P (LIST (MAPCAR '(LAMBDA (X) (ATOF (NTH X S))) CLST)))))
                            (CLOSE F)
                        )
                    )
                )
            )
        )
        (PROGN
            (ALERT "Error in getData Function! \ncLst must be a list!\ndt shouldn't be null or \"\" !")
            (EXIT)
        )
    )
    (MYSORT P)
)
(DEFUN MYSORT (TMP / PP X TS Q)
    (setq PP nil)
    (setq Q nil)
    (while TMP
        (setq X (car TMP))
        (setq Q (LIST X))
        (setq X (car X))
        (setq TMP (cdr TMP))
        (setq TS (LENGTH TMP))
        (setq I 0)
        (setq TTP nil)
        (REPEAT TS
            (setq TTP (NTH I TMP))
            (if (> 0.001 (ABS (- (car TTP) X)))
                (PROGN
                    (setq Q (APPEND Q (LIST TTP)))
                )
            )
            (setq I (1+ I))
        )
        (MAPCAR '(LAMBDA (X) (SETQ TMP (VL-REMOVE X TMP))) Q)
        (setq PP (APPEND PP (LIST Q)))
    )
    (setq PP (MAPCAR '(LAMBDA (X)
        (VL-SORT X (QUOTE (LAMBDA (S1 S2) (< (CAR S1) (CAR S2)))))
    ) PP))
    PP
)
(defun LWPLTWREG (YDM SJX DRAWAREA JULI
                       / CORS1 CORS2 I J N UB1 UB2 YDMPT LMPT YDMPL2 LMPL2 TFREGARR WFREGARR
                         TFREG WFREG OBJARR SFARR1 SFARR2 YDMPT2 LMPT2 TMPREGARR TFLA WFLA)
  (setq CORS1 (vlax-variant-value (vla-get-Coordinates YDM)))
  (setq CORS2 (vlax-variant-value (vla-get-Coordinates SJX)))
  (setq UB1 (vlax-safearray-get-u-bound CORS1 1))
  (setq UB2 (vlax-safearray-get-u-bound CORS2 1))
  (setq YDMPT (vlax-safearray->list CORS1))
  (setq LMPT (vlax-safearray->list CORS2))
  (setq YDMPT2 (append (list (nth 0 YDMPT) (+ (nth 1 YDMPT) JULI)) YDMPT))
  (setq YDMPT2 (append YDMPT2 (list (nth (- UB1 1) YDMPT) (+ (nth UB1 YDMPT) JULI))))
  (setq LMPT2 (append (list (nth 0 LMPT) (- (nth 1 LMPT) JULI)) LMPT))
  (setq LMPT2 (append LMPT2 (list (nth (- UB2 1) LMPT) (- (nth UB2 LMPT) JULI))))
  (setq SFARR1 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB1 4))))
  (setq SFARR2 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB2 4))))
  (vlax-safearray-fill SFARR1 YDMPT2)
  (vlax-safearray-fill SFARR2 LMPT2)
  (setq YDMPL2 (vla-AddLightWeightPolyline (model-space) SFARR1))
  (setq LMPL2 (vla-AddLightWeightPolyline (model-space) SFARR2))
  (vla-put-Closed YDMPL2 T)
  (vla-put-Closed LMPL2 T)
  (setq OBJARR (vlax-make-safearray vlax-vbObject (cons 0 0)))
  (vlax-safearray-fill OBJARR (list YDMPL2))
  (setq TFREGARR (vla-AddRegion (model-space) OBJARR))
  (vlax-safearray-fill OBJARR (list LMPL2))
  (setq TMPREGARR (vla-AddRegion (model-space) OBJARR))
  (setq TFREG (vlax-safearray-get-element (vlax-variant-value TFREGARR) 0))
  (vla-Boolean TFREG acIntersection (vlax-safearray-get-element (vlax-variant-value TMPREGARR) 0))
  (vla-Delete YDMPL2)
  (vla-Delete LMPL2)
  (setq YDMPT2 (append (list (nth 0 YDMPT) (- (nth 1 YDMPT) JULI)) YDMPT))
  (setq YDMPT2 (append YDMPT2 (list (nth (- UB1 1) YDMPT) (- (nth UB1 YDMPT) JULI))))
  (setq LMPT2 (append (list (nth 0 LMPT) (+ (nth 1 LMPT) JULI)) LMPT))
  (setq LMPT2 (append LMPT2 (list (nth (- UB2 1) LMPT) (+ (nth UB2 LMPT) JULI))))
  (setq SFARR1 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB1 4))))
  (setq SFARR2 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB2 4))))
  (vlax-safearray-fill SFARR1 YDMPT2)
  (vlax-safearray-fill SFARR2 LMPT2)
  (setq YDMPL2 (vla-AddLightWeightPolyline (model-space) SFARR1))
  (setq LMPL2 (vla-AddLightWeightPolyline (model-space) SFARR2))
  (vla-put-Closed YDMPL2 T)
  (vla-put-Closed LMPL2 T)
  (setq OBJARR (vlax-make-safearray vlax-vbObject (cons 0 0)))
  (vlax-safearray-fill OBJARR (list YDMPL2))
  (setq WFREGARR (vla-AddRegion (model-space) OBJARR))
  (vlax-safearray-fill OBJARR (list LMPL2))
  (setq TMPREGARR (vla-AddRegion (model-space) OBJARR))
  (setq WFREG (vlax-safearray-get-element (vlax-variant-value WFREGARR) 0))
  (vla-Boolean WFREG acIntersection (vlax-safearray-get-element (vlax-variant-value TMPREGARR) 0))
  (vla-Delete YDMPL2)
  (vla-Delete LMPL2)
  (if DRAWAREA
      (progn
        (setq TFLA (vla-Add (vla-get-Layers (active-document)) "XX-填方区域面积"))
        (setq WFLA (vla-Add (vla-get-Layers (active-document)) "XX-挖方区域面积"))
        (vla-put-Color TFLA acBlue)
        (vla-put-Color WFLA acMagenta)
        (vla-put-Layer TFREG "XX-填方区域面积")
        (vla-put-Layer WFREG "XX-挖方区域面积")
        (vla-put-Color TFREG acByLayer)
        (vla-put-Color WFREG acByLayer)
      )
  )
  (list TFREG WFREG)
)
(defun LWPLTWREGYS (YDM SJX DRAWAREA JULI
                        / CORS1 CORS2 I J N UB1 UB2 YDMPT LMPT YDMPL2 LMPL2 TFREGARR WFREGARR
                          TFREG WFREG OBJARR SFARR1 SFARR2 YDMPT2 LMPT2 TMPREGARR TFLA WFLA
                          TFYDMX0 TFYDMY0 TFLMX0 TFLMY0 WFYDMX0 WFYDMY0 WFLMX0 WFLMY0
                          TFYDMXN TFYDMYN TFLMXN TFLMYN WFYDMXN WFYDMYN WFLMXN WFLMYN
                          YDMX0 YDMY0 LMX0 LMY0 YDMXN YDMYN LMXN LMYN)
  (setq CORS1 (vlax-variant-value (vla-get-Coordinates YDM)))
  (setq CORS2 (vlax-variant-value (vla-get-Coordinates SJX)))
  (setq UB1 (vlax-safearray-get-u-bound CORS1 1))
  (setq UB2 (vlax-safearray-get-u-bound CORS2 1))
  (setq YDMPT (vlax-safearray->list CORS1))
  (setq LMPT (vlax-safearray->list CORS2))
  (setq YDMX0 (nth 0 YDMPT))
  (setq YDMY0 (nth 1 YDMPT))
  (setq LMX0 (nth 0 LMPT))
  (setq LMY0 (nth 1 LMPT))
  (setq YDMXN (nth (- UB1 1) YDMPT))
  (setq YDMYN (nth UB1 YDMPT))
  (setq LMXN (nth (- UB2 1) LMPT))
  (setq LMYN (nth UB2 LMPT))
  (if (< LMX0 YDMX0)
      (progn
        (setq TFYDMX0 LMX0)
        (setq TFYDMY0 LMY0)
        (setq TFLMX0 LMX0)
        (setq TFLMY0 LMY0)
        (setq WFYDMX0 LMX0)
        (setq WFYDMY0 LMY0)
        (setq WFLMX0 LMX0)
        (setq WFLMY0 LMY0)
      )
      (progn
        (if (= LMX0 YDMX0)
            (progn
              (setq TFYDMX0 YDMX0)
              (setq TFYDMY0 YDMY0)
              (setq TFLMX0 LMX0)
              (setq TFLMY0 LMY0)
              (setq WFYDMX0 YDMX0)
              (setq WFYDMY0 YDMY0)
              (setq WFLMX0 LMX0)
              (setq WFLMY0 LMY0)
            )
            (progn
              (setq TFYDMX0 YDMX0)
              (setq TFYDMY0 YDMY0)
              (setq TFLMX0 YDMX0)
              (setq TFLMY0 YDMY0)
              (setq WFYDMX0 YDMX0)
              (setq WFYDMY0 YDMY0)
              (setq WFLMX0 YDMX0)
              (setq WFLMY0 YDMY0)
            )
        )
      )
  )
  (if (> LMXN YDMXN)
      (progn
        (setq TFYDMXN LMXN)
        (setq TFYDMYN LMYN)
        (setq TFLMXN LMXN)
        (setq TFLMYN LMYN)
        (setq WFYDMXN LMXN)
        (setq WFYDMYN LMYN)
        (setq WFLMXN LMXN)
        (setq WFLMYN LMYN)
      )
      (progn
        (if (= LMXN YDMXN)
            (progn
              (setq TFYDMXN YDMXN)
              (setq TFYDMYN YDMYN)
              (setq TFLMXN LMXN)
              (setq TFLMYN LMYN)
              (setq WFYDMXN YDMXN)
              (setq WFYDMYN YDMYN)
              (setq WFLMXN LMXN)
              (setq WFLMYN LMYN)
            )
            (progn
              (setq TFYDMXN YDMXN)
              (setq TFYDMYN YDMYN)
              (setq TFLMXN YDMXN)
              (setq TFLMYN YDMYN)
              (setq WFYDMXN YDMXN)
              (setq WFYDMYN YDMYN)
              (setq WFLMXN YDMXN)
              (setq WFLMYN YDMYN)
            )
        )
      )
  )
  (setq YDMPT2 (append (list TFYDMX0 (+ TFYDMY0 JULI))
                       (list TFYDMX0 TFYDMY0)
                       YDMPT
                       (list TFYDMXN TFYDMYN)
                       (list TFYDMXN (+ TFYDMYN JULI))
              )
  )
  (setq LMPT2 (append (list TFLMX0 (- TFLMY0 JULI))
                      (list TFLMX0 TFLMY0)
                      LMPT
                      (list TFLMXN TFLMYN)
                      (list TFLMXN (- TFLMYN JULI))
              )
  )
  (setq SFARR1 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB1 8))))
  (setq SFARR2 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB2 8))))
  (vlax-safearray-fill SFARR1 YDMPT2)
  (vlax-safearray-fill SFARR2 LMPT2)
  (setq YDMPL2 (vla-AddLightWeightPolyline (model-space) SFARR1))
  (setq LMPL2 (vla-AddLightWeightPolyline (model-space) SFARR2))
  (vla-put-Closed YDMPL2 T)
  (vla-put-Closed LMPL2 T)
  (setq OBJARR (vlax-make-safearray vlax-vbObject (cons 0 0)))
  (vlax-safearray-fill OBJARR (list YDMPL2))
  (setq TFREGARR (vla-AddRegion (model-space) OBJARR))
  (vlax-safearray-fill OBJARR (list LMPL2))
  (setq TMPREGARR (vla-AddRegion (model-space) OBJARR))
  (setq TFREG (vlax-safearray-get-element (vlax-variant-value TFREGARR) 0))
  (vla-Boolean TFREG acIntersection (vlax-safearray-get-element (vlax-variant-value TMPREGARR) 0))
  (vla-Delete YDMPL2)
  (vla-Delete LMPL2)
  (setq YDMPT2 (append (list WFYDMX0 (- WFYDMY0 JULI))
                       (list WFYDMX0 WFYDMY0)
                       YDMPT
                       (list WFYDMXN WFYDMYN)
                       (list WFYDMXN (- WFYDMYN JULI))
              )
  )
  (setq LMPT2 (append (list WFLMX0 (+ WFLMY0 JULI))
                      (list WFLMX0 WFLMY0)
                      LMPT
                      (list WFLMXN WFLMYN)
                      (list WFLMXN (+ WFLMYN JULI))
              )
  )
  (setq SFARR1 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB1 8))))
  (setq SFARR2 (vlax-make-safearray vlax-vbDouble (cons 0 (+ UB2 8))))
  (vlax-safearray-fill SFARR1 YDMPT2)
  (vlax-safearray-fill SFARR2 LMPT2)
  (setq YDMPL2 (vla-AddLightWeightPolyline (model-space) SFARR1))
  (setq LMPL2 (vla-AddLightWeightPolyline (model-space) SFARR2))
  (vla-put-Closed YDMPL2 T)
  (vla-put-Closed LMPL2 T)
  (setq OBJARR (vlax-make-safearray vlax-vbObject (cons 0 0)))
  (vlax-safearray-fill OBJARR (list YDMPL2))
  (setq WFREGARR (vla-AddRegion (model-space) OBJARR))
  (vlax-safearray-fill OBJARR (list LMPL2))
  (setq TMPREGARR (vla-AddRegion (model-space) OBJARR))
  (setq WFREG (vlax-safearray-get-element (vlax-variant-value WFREGARR) 0))
  (vla-Boolean WFREG acIntersection (vlax-safearray-get-element (vlax-variant-value TMPREGARR) 0))
  (vla-Delete YDMPL2)
  (vla-Delete LMPL2)
  (if DRAWAREA
      (progn
        (setq TFLA (vla-Add (vla-get-Layers (active-document)) "XX-填方区域面积"))
        (setq WFLA (vla-Add (vla-get-Layers (active-document)) "XX-挖方区域面积"))
        (vla-put-Color TFLA acBlue)
        (vla-put-Color WFLA acMagenta)
        (vla-put-Layer TFREG "XX-填方区域面积")
        (vla-put-Layer WFREG "XX-挖方区域面积")
        (vla-put-Color TFREG acByLayer)
        (vla-put-Color WFREG acByLayer)
      )
  )
  (list TFREG WFREG)
)
(defun GETENTLC (ENTOBJ / XDT XDV)
  (if (= nil ENTOBJ)
      (progn
        nil
      )
      (progn
        (vla-GetXData ENTOBJ "XX_HDM_TFWF" 'XDT 'XDV)
        (if (= nil XDV)
            (progn
              nil
            )
            (progn
              (vlax-variant-value (vlax-safearray-get-element XDV 1))
            )
        )
      )
  )
)
(defun GETINTARR (LST / INTARR)
  (if (and (listp LST) (> (length LST) 0))
      (progn
        (setq INTARR (vlax-make-safearray vlax-vbInteger (cons 0 (- (length LST) 1))))
        (vlax-safearray-fill INTARR LST)
      )
  )
)
(defun GETVARARR (LST / VARARR)
  (if (and (listp LST) (> (length LST) 0))
      (progn
        (setq VARARR (vlax-make-safearray vlax-vbVariant (cons 0 (- (length LST) 1))))
        (vlax-safearray-fill VARARR LST)
      )
  )
)
(vl-ACAD-defun (DEFUN C:dmj( / SFSS YDMSS TWSS LC1 LC2 TW I J K M N B1 B2 TP2 )  (INITGET "D F" )
(setq TP2 (GETKWORD "请输入计算两期断面线面积的方式[上下断面线两端垂直相交(D)/上下断面线两端直接相连(F)]<D>:"))  
(if (= nil TP2 ) (PROGN   
(setq TP2 "D") )) (VL-CATCH-ALL-APPLY 'vla-Delete (LIST (VL-CATCH-ALL-APPLY 'vla-Item (LIST (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "sfSS-tyhdm" ) ) ) ) (VL-CATCH-ALL-APPLY 'vla-Delete (LIST (VL-CATCH-ALL-APPLY 'vla-Item (LIST (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "ydmSS-tyhdm" ) ) ) ) (VL-CATCH-ALL-APPLY 'vla-Delete (LIST (VL-CATCH-ALL-APPLY 'vla-Item (LIST (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "twSS-tyhdm" ) ) ) )
(setq SFSS (vla-Add (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "sfSS-tyhdm" ))
(setq YDMSS (vla-Add (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "ydmSS-tyhdm" ))
(setq TWSS (vla-Add (vla-get-SelectionSets (ACTIVE-DOCUMENT ) ) "twSS-tyhdm" )) (vla-Select SFSS acSelectionSetAll nil nil (GETINTARR '(0 8 ) )
(GETVARARR '("LWPOLYLINE" "XX_收方断面多段线" ) ) ) (vla-Select YDMSS acSelectionSetAll nil nil (GETINTARR '(0 8 ) )
(GETVARARR '("LWPOLYLINE" "XX_原地面断面多段线" ) ) ) (vla-Select TWSS acSelectionSetAll nil nil (GETINTARR '(0 8 ) )
(GETVARARR '("TEXT" "XX_HDM_TFWF_TWWZ_SF" ) ) )
(setq K (vla-get-Count SFSS ))
(setq M (vla-get-Count YDMSS ))
(setq N (vla-get-Count TWSS ))
(setq I 0)  (if (/= K M ) (PROGN   (ALERT "原地面线与收放线数量不一致！" ) ))
(setq B1 T) (setq B2 T) (while (and (AND B1 (< I K ) )  )
(setq LC1 (GETENTLC (vla-Item SFSS I ) ))
(setq J 0) (setq B2 T) (while (and (AND B2 (< J M ) )  )
(setq LC2 (GETENTLC (vla-Item YDMSS J ) ))  
(if (= LC1 LC2 ) (PROGN   
(setq B2 nil) )(PROGN   
(setq J (1+ J )) )) )  
(if (= J M ) (PROGN   (ALERT (STRCAT "没有找到" (GETENTLC (vla-Item SFSS I ) ) "里程的原地面线" ) ) )
(PROGN    (if (= TP2 "D" ) (PROGN   
(setq TW (LWPLTWREG (vla-Item YDMSS J ) (vla-Item SFSS I ) T 30 )) )
(PROGN   (setq TW (LWPLTWREGYS (vla-Item YDMSS J ) (vla-Item SFSS I ) T 30 )) ))
(setq J 0) (setq B2 T) (while (and (AND B2 (< J N ) )  )
(setq LC2 (GETENTLC (vla-Item TWSS J ) ))  
(if (= LC1 LC2 ) (PROGN  
(setq B2 nil) )(PROGN   (setq J (1+ J )) )) )  (if (< J N ) (PROGN   (vla-put-TextString (vla-Item TWSS J ) (STRCAT "At=" (RTOS (vla-get-Area (NTH 0 TW ) ) 2 3 ) "    Aw=" (RTOS (vla-get-Area (NTH 1 TW ) ) 2 3 ) ) ) ))  ))
(setq I (1+ I )) )
(PRINC )  ) )
'C:dmj
(DEFUN FORMAT_K( F I  / A B L )  
(setq F (RTOS F 2 I ))
(setq F (ATOF F ))
(setq A (FIX (/ F 1000 ) ))
(setq F (- F (* A 1000 ) ))
(setq A (STRCAT "K" (RTOS A 2 0 ) "+" ))
(setq B (FIX F )) (setq F (- F B ))
(setq B (RTOS B 2 0 )) (setq L (STRLEN B )) (COND ((= 1 L )
(setq B (STRCAT "00" B )) ) ((= 2 L )
(setq B (STRCAT "0" B )) ) )  
(if (> I 0 ) (PROGN   
(STRCAT A B "." (SUBSTR (RTOS F 2 I ) 3 I ) ) )(PROGN   (STRCAT A B ) ))  )
(PRINC "\n通用横断面绘制插件 V1.1  已加载\n" )
(vl-ACAD-defun (DEFUN C:dmt( / DAT PT TP ZXJJ )  
(PRINC "输入命令: dmt 画断面图.\n" ) (PRINC "数据文件格式为: 里程,偏距,高程,中桩高程\n" )
(PRINC "输入命令: dmj 自动计算本插件绘制的两期断面线方量.\n" )
(setq ZXJJ (GETREAL "请输入断面线间的纵向间距:\n   输入正值从上往下绘图\n   输入负值从下往上绘图\n   回车使用当前值<25>:" ))  
(if (= nil ZXJJ ) (PROGN   (setq ZXJJ 25) ))  
(if (setq  PT (GETPOINT "请选择放置点:" )) (PROGN   
(SETVAR "cmdecho" 0 ) (command "ucs" ) (command "" )
(setq DAT (GETDATA '(0 1 2 3 ) "," )) (INITGET "D F" )
(setq TP (GETKWORD "请输入要绘制的断面线类型[原地面线(D)/收方线断面线(F)]<D>:" ))  
(if (OR (= nil TP ) (= "D" TP ) ) (PROGN   (FOREACH E DAT (HDM E PT )
(setq PT (LIST (car PT ) (- (car (cdr PT ) ) ZXJJ ) (car (cdr (cdr PT ) ) ) )) ) )(PROGN   (FOREACH E DAT (HDM2 E PT )
(setq PT (LIST (car PT ) (- (car (cdr PT ) ) ZXJJ ) (car (cdr (cdr PT ) ) ) )) ) ))
(command "_zoom" )
(command "e" )
(PRINC "横断面绘制完成.\n" ) )) (PRINC )  ) )
'C:dmt
(PRINC "输入命令: dmt 画断面图.\n" )
(PRINC "数据文件格式为: 里程,偏距,高程,中桩高程\n" )
(PRINC "输入命令: dmj 自动计算本插件绘制的两期断面线方量.\n" )
(PRINC )

技术工作室

附一个数据格式及动画说明一下，就更完美。

nijiea123

要是介绍一下怎么用就好了

hzyhzjjzh

谢谢楼主分享

lxl217114

谢谢楼主分享

kugoo999

发一个横断面格式可以不

cjf160204

命令hdmht和hdmmj

cjf160204

效果图就是这样

技术工作室

谢谢楼主分享

danyangzi

谢谢楼主分享