找高手帮忙改

( DEFUN C:tt1 ()
(defun getmidpoint(pt1 pt2) (mapcar ’(lambda (x y)(/(+ x y) 2.0)) pt1 pt2) )

(SETQ PT_1 (GETPOINT "选择塔段左下角端点 : ")) ;;塔段左下角坐标
(SETQ width_low (GETREAL "输入塔段下宽 : ")) ;;塔段下宽
(SETQ width_high (GETREAL "输入塔段上宽 : ")) ;;塔段上宽
(SETQ high (GETREAL "输入塔段高度 : ")) ;;塔段高度
(SETQ PT_2 (LIST (+ (CAR PT_1) width_low) (CADR PT_1) )) ;;计算塔段右下角点坐标
(SETQ PT_3 (LIST (+ (CAR PT_1) (* 0.5 (- width_low width_high ) ) ) (+ (CADR PT_1) high) ) )
;;计算塔段左上角点坐标
(SETQ PT_4 (LIST (+ (CAR PT_3) width_high) (CADR PT_3) ) )
;;计算塔段右上角点坐标
(SETQ PT_5 (LIST (/ (+ (CAR PT_1) (CAR PT_3) ) 2) (/ (+ (CADR PT_1) (CADR PT_3) ) 2) ))
;;计算塔段左中点坐标
(SETQ PT_6 (LIST (/ (+ (CAR PT_2) (CAR PT_4) ) 2) (/ (+ (CADR PT_2) (CADR PT_4) ) 2) ))
;;计算塔段右中点坐标
(SETQ PT_7 (inters PT_6 PT_3 PT_5 PT_4 )) ;;找到两条线的交点
(SETQ PT_8 (inters PT_6 PT_1 PT_5 PT_2 )) ;;找到两条线的交点
(SETQ mi_1 (getmidpoint PT_3 PT_7)) ;;找到两点中点
(SETQ mi_2 (getmidpoint PT_5 PT_7))
(SETQ mi_3 (getmidpoint PT_3 PT_5))
(SETQ mi_4 (getmidpoint PT_4 PT_7))
(SETQ mi_5 (getmidpoint PT_6 PT_7))
(SETQ mi_6 (getmidpoint PT_6 PT_4))
(SETQ mi_7 (getmidpoint PT_1 PT_5))
(SETQ mi_8 (getmidpoint PT_1 PT_8))
(SETQ mi_9 (getmidpoint PT_5 PT_8))
(SETQ mi_10 (getmidpoint PT_2 PT_6))
(SETQ mi_11 (getmidpoint PT_2 PT_8))
(SETQ mi_12 (getmidpoint PT_6 PT_8)) ;;给出了腹杆的节点位置


(COMMAND "LINE" PT_1 PT_2 PT_4 PT_3 "C" ) ;;用线连接1，2，3，4，并封闭
(COMMAND "LINE" PT_1 PT_6 PT_3 "" )
(COMMAND "LINE" PT_2 PT_5 PT_4 "" )
(COMMAND "LINE" mi_1 mi_2 mi_3 "c" )
(COMMAND "LINE" mi_4 mi_5 mi_6 "c" )
(COMMAND "LINE" mi_7 mi_8 mi_9 "c" )
(COMMAND "LINE" mi_10 mi_11 mi_12 "c" )



(defun layer()

;;; 建立一个名为"ABC" 的新图层(红色)
;;; 接着指定给图层 "ABC"
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument))
;;; 建立新的图层
(setq layerSel(vla-get-Layers AcadDocument))
(setq layerObj(vla-add layerSel "ABC"))
(vla-put-Color layerObj acRed)
;; 建立选择集
(setq ttlk (ssget ＂X＂) )
;; 将新图层设成 "ABC"
(vla-put-Layer ttlk "ABC")
;;; 更新视图
(vla-Regen AcadDocument :vlax-true)
(princ (STRCAT "圆当前在图层: " (vla-get-Layer CircleObj) " 范例\n"))
(princ)
)






(princ)
)