lisp填挖横断面提取_求助，AUTOLISP语言的这个程序流程图怎么写。关于纵横断面绘制的...

该楼层疑似违规已被系统折叠 隐藏此楼查看此楼

(defun huitu(p1 p2)

(setq topleft (list (- (car p1) 4.5) (- (cadr p1) 6.0))

topright (list (+ (car p2) 1.0) (- (cadr p1) 6.0))

pt1 topleft

pt2 topright

nn 0

)

(command "layer" "set" "表格" "")

(command "rectang" "w" 0.05 (list (car topleft) (- (cadr topleft) 11.0)) topright)

(repeat 7 (setq dts (nth nn '(1.5 1.0 1.0 1.5 1.5 1.5 1.5)))

(setq pt1 (list (car pt1) (- (cadr pt1) dts))

pt2 (list (car pt2) (- (cadr pt2) dts))

nn (+ nn 1)

)

(command "line" pt1 pt2 "")

)

(command "line" (list (car p1) (- (cadr p1) 6.0)) (list (car p1) (- (cadr p1) 17.0)) "")

(command "line" topleft (list (car p1) (- (cadr topleft) 1.5)) "")

(setq wth '("坡度(%)" "坡长(M)" "填 土" "挖 土"

"路面设计高程" "路基设计高程" "地面高程" "桩 号" "平 曲 线")

nn 0

pt1 (list (- (car p1) 1.0) (- (cadr p1) 6.5))

dth '(1.0 1.25 1.5 1.5 1.5 1.5 0)

)

(repeat 9 (setq wtt (nth nn wth))

(if (< nn 2) (xiezhi pt1 "st" 0.4 0 (nth nn wth))

(xiezhi pt1 "st" 0.5 0 (nth nn wth))

)

(if (< nn 2) (if (= nn 0) (setq pt1 (list (- (car p1) 3.5) (- (cadr p1) 7.0)))

(setq pt1 (list (- (car p1) 2.25) (- (cadr p1) 8.0)))

)

(setq pt1 (list (car pt1) (- (cadr pt1) (nth (- nn 2) dth))))

)

(setq nn (+ nn 1))

)

(setq bchmax (+ (fix (cadr p2)) 3)

bchmin (- (fix (cadr p1)) 3)

anv (+ (- bchmax bchmin) 1)

anh (- (fix (car p2)) (fix (car p1)))

)

(command "line" (list (car p1) bchmax)

(list (car p1) bchmin)

"@-0.2,0"

(list (- (car p1) 0.2) bchmax) "c"

)

(command "layer" "set" "虚线" "")

(command "line" (list (+ (fix (car p1)) 1) bchmin)

(list (+ (fix (car p1)) 1) bchmax) ""

)

(setq temp1 (cdar (entget (entlast))))

(command "array" temp1 "" "r" 1 anh 1)

(command "line" (list (+ (fix (car p1)) 1) bchmax)

(list (fix (car p2)) bchmax) ""

)

(setq temp1 (cdar (entget (entlast))))

(command "array" temp1 "" "r" anv 1 -1)

(command "layer" "set" "表格" "")

(setq ptem1 (list (- (car p1) 0.1) bchmax)

ptem2 (list (car p1) bchmax)

ptem3 (list (- (car p1) 0.1) (- bchmax 1))

ptem4 (list (car p1) (- bchmax 1))

lo 1

)

(while (<= bchmin (cadr ptem4))

(command "solid" ptem1 ptem2 ptem3 ptem4 "")

(setq ptem5 (list (- (car p1) 1.3) (cadr ptem1))

wth (rtos (cadr ptem1) 2 0)

)

(command "text" "s" "standard" ptem5 0.3 0 wth);(command "text" "s" "txt" ptem5 0.3 0 wth)

(if (= bchmin (cadr ptem4))

(progn (setq ptem5 (list (- (car p1) 1.3) (cadr ptem4))

wth (rtos (cadr ptem4) 2 0)

)

(command "text" "s" "standard" ptem5 0.3 0 wth)

)

)

(if (= lo 1) (setq ptem1 (list (- (car ptem1) 0.1) (- (cadr ptem1) 1.0))

ptem2 (list (- (car ptem2) 0.1) (- (cadr ptem2) 1.0))

ptem3 (list (- (car ptem3) 0.1) (- (cadr ptem3) 1.0))

ptem4 (list (- (car ptem4) 0.1) (- (cadr ptem4) 1.0))

lo 0

)

(setq ptem1 (list (+ (car ptem1) 0.1) (- (cadr ptem1) 1.0))

ptem2 (list (+ (car ptem2) 0.1) (- (cadr ptem2) 1.0))

ptem3 (list (+ (car ptem3) 0.1) (- (cadr ptem3) 1.0))

ptem4 (list (+ (car ptem4) 0.1) (- (cadr ptem4) 1.0))

lo 1

)

)

)

(gc)

)