原代码公开

(setq PrefStage "偏轴距："
PrefLevel "高程："
)
(setq NPopenFileName nil)
(setq defaulteditfilepath "c:\\")
(setq ReturnOffDist nil)
(setq ReturnLayerName nil)
;设置原点
(setq filepath "c:\\")
(setq judge 1)
(setq Ju 0)
(setq Je 0)

;读断面点坐标
(defun c:RO3 ()

(grtext -1
"读出点位坐标(相对于设置的原点) 按 F1 获取帮助"
)

(if (/= (setq ro (getpoint "\n请输入一点：")) nil)
(progn
(setq ResultCorX (+ (- (car ro) (car Ori)) (car OriV)))
(setq ResultCorY (+ (- (cadr ro) (cadr Ori)) (cadr OriV)))
(setq ResultCorZ (+ (- (caddr ro) (caddr Ori)) (caddr OriV)))
(princ)


(setq StrX (rtos ResultCorX 2 3))
(setq stringX (strcat "X=" StrX))

(setq StrY (rtos ResultCorY 2 3))
(setq stringY (strcat "Y=" StrY))


(setq StrZ (rtos ResultCorZ 2 3))
(setq stringZ (strcat "H=" StrZ))


)
)
(princ "\n")
(princ stringX)
(princ " ")
(princ stringY)
(princ " ")
(princ stringZ)
(grtext)
(princ)
)

(defun c:aa ()
(princ "\n")
(command "setvar" "CMDECHO" "0")
(grtext -1 "求断面面积 按 F1 获取帮助")
(princ)
(princ "\n\n")
(command "-style" "qdong" "宋体" "0.4" "1" "0" "" "")
(princ)
(if (= AreaFile nil)
(progn
(setq AreaFile (getfiled "保存面积" "c:/断面面积" "AREA" 1))
(setq Af (open AreaFile "w"))
;(write-line "" Af)
(close Af)
)
)
(setq Af (open AreaFile "a"))

(setq D (getvar "cdate"))
(setq D (rtos D 2 0))
(setq year (substr D 1 4))
(setq month (substr D 5 2))
(setq dat (substr D 7 2))
(setq D (strcat year "/" month "/" Dat))
(princ)




(setq PromptArea (getstring "请输入断面桩号："))
(setq pt (getpoint "请输入封闭图形内的一点："))

(if (/= nil (car pt))
(progn
(command "boundary" pt "")
(setq pl (ssget "L"))
(command "area" "o" pl)
(command "erase" pl "")
(setq AreaP (getvar "AREA"))
(setq AreaP (rtos AreaP 2 3))
(princ (strcat "面积:" AreaP "㎡"))
(command "text" pt "0" (strcat Areap "㎡"))
(princ)

(setq Areap (strcat PromptArea "," AreaP))
(write-line AreaP af)

(close af)
(command "setvar" "CMDECHO" "1")
(princ)
)
(progn
(princ "取消")
(princ)
)
)

(grtext)
(princ)

)



;读断面点坐标
(defun c:RO ()
(command "-style" "qdong" "宋体" "0.4" "1" "0" "" "")
(princ)

(grtext -1
"读出点位坐标(相对于设置的原点) 按 F1 获取帮助"
)

(if (/= (setq ro (getpoint "请输入一点："