[求助]：画中心线问题！

fengjunchina

从网上下载了一个画中心线的LISP程序

帮忙分析一下为什么画椭圆中心线的方向是反的。

还有画圆弧中心线能否加个判断优劣圆弧的。
用在AUTOCAD R14英文版下。源程序如下：


;;   本程序为绘制中心线程序
;;   执行命令：cline
;;
;;确定中心线延伸长度
;(defun adddist (/ defdist)
; (if dist
   ; (progn
    ;  (princ "\n请输入延伸长度<")
    ;  (setq defdist (princ dist))
     ; (setq dist (getdist ">:"))
    ;)
    ;(progn
      ;(setq defdist 5)

     ; (setq dist (getdist "\n请输入延伸长度<5>:"))
   ; )
; )
; (if (= dist nil)
  ;  (setq dist defdist)
; )
; dist
;)

;;确定中心线延伸长度
(defun adddist (/ dist scale)
(setq SCALE (getvar "DIMSCALE"))
   (setq DIST (* 3.5 SCALE))
)

;画圆中心线
(defun circle_cl (en1 / ss i j ent ents ptc r pts adist)
  (setq ss (ssget '((0 . "Circle"))))
  (setq i 0)
  (setq adist(adddist))
  (repeat (sslength ss)
  (setq ent (ssname ss i))
    (setq ents (entget ent))
    (setq ptc (cdr (assoc 10 ents))
   r (cdr (assoc 40 ents))
   j 0
   pts'())
    (repeat 4
      (setq pts (append pts (list (polar ptc (* j (/ pi 2)) (+ r adist)))))
      (setq j (1+ j))
    )
    (command "_.line" (nth 0 pts) (nth 2 pts) ""
      "_.line" (nth 1 pts) (nth 3 pts) "")
    (setq i (1+ i))
  )
  (princ)
  
)


;画弧中心线
(defun arc_cl (en1 / ed1 pto rad ang1 ang2 pto1 pt1 pt2 pto2 objline dd adist)
  (setq ed1 (entget en1))
  (setq pto  (cdr (assoc 10 ed1))
rad  (cdr (assoc 40 ed1))
ang1 (cdr (assoc 50 ed1))
ang2 (cdr (assoc 51 ed1))
  )
  (if (> ang1 ang2)
    (setq ang2(+ ang2 (* PI 2)))
    )
  (setq ang (/ (+ ang1 ang2)2))
   (setq pto1 (polar pto ang rad))
  (setq pt1 (polar pto ang1 rad))
  (setq pt2 (polar pto ang2 rad))
  (setq pto2 (inters pto pto1 pt1 pt2 nil))
(command "_line" pto1 pto2 "")
  (setq objline (entlast)
dd (distance pto1 pto2)
  )
  (setq adist (adddist))
  (command "_lengthen"
    "t"
    (+ dd adist)
    (cons objline (list pto1))
    ""
  )
  (command "_lengthen"
    "t"
    (+ dd (* adist 2))
    (cons objline (list pto2))
    ""
  )


)


;画直线中心线
(defun line_cl (en1 / en2 )
  (setq en2 (car (entsel "\n请选择另外的直线<只绘制单直线中心线>:")))
  (if en2
    (progn
      (while (/= "LINE" (cdr (assoc 0 (entget en2))))
(setq en2 (car (entsel "\n请重新选择另外的直线:")))
      )
      (dline_cl en1 en2)
    )
    (sline_cl en1)
  )
)


(defun dline_cl (en1 en2 /   ed1     ed2     pta1    pta2    ptb1
       ptb2    pto     ptoo    pto1    pto2    anga
       angb    ango    objline dd      adist)
  (setq ed1 (entget en1)
ed2 (entget en2)
  )
  (setq pta1 (cdr (assoc 10 ed1))
pta2 (cdr (assoc 11 ed1))
ptb1 (cdr (assoc 10 ed2))
ptb2 (cdr (assoc 11 ed2))
  )

  (if (setq pto (inters pta1 pta2 ptb1 ptb2 nil)) ;if 2
    (if (inters pta1 pta2 ptb1 ptb2) ;if 3
      (princ "\n两线相交，退出")
      (progn
(setq anga (angle pto pta1)
       angb (angle pto ptb1)
       ango (/ (+ anga angb) 2)
       ptoo (polar pto ango 1)
)    ;setq
(if (inters pta1 ptb1 pta2 ptb2) ;if 4
   (setq pto1 (inters pta1 ptb2 pto ptoo nil)
  pto2 (inters pta2 ptb1 pto ptoo nil)
   )
   (setq pto1 (inters pta1 ptb1 pto ptoo nil)
  pto2 (inters pta2 ptb2 pto ptoo nil)
   )
)    ;if 4
(command "_line" pto1 pto2 "")
(setq objline (entlast)
       dd      (distance pto1 pto2)
)
(setq adist (adddist))
(command "_lengthen"
   "t"
   (+ dd adist)
   (cons objline (list pto1))
   ""
)
(command "_lengthen"
   "t"
   (+ dd (* adist 2))
   (cons objline (list pto2))
   ""
)


      )     ;progn
    )     ;if 3
    (progn
      (arxload "geomcal.arx" nil)
      (if (inters pta1 ptb1 pta2 ptb2) ;if 4
(progn
   (setq pto1 (c:cal "(pta1 + ptb2) / 2")
  pto2 (c:cal "(pta2 + ptb1) / 2")
   )
   (command "_line"
     pto1
     pto2
     ""
   )
)
(progn
   (setq pto1 (c:cal "(pta1+ptb1)/2")
  pto2 (c:cal "(pta2+ptb2)/2")
   )
   (command "_line"
     pto1
     pto2
     ""
   )
)
      )
      (arxunload "geomcal.arx" nil)
      (setq objline (entlast)
     dd     (distance pto1 pto2)
      )
      (setq adist (adddist))
      (command "_lengthen"
        "t"
        (+ dd adist)
        (cons objline (list pto1))
        ""
      )
      (command "_lengthen"
        "t"
        (+ dd (* adist 2))
        (cons objline (list pto2))
        ""
      )

    )     ;px
  )     ;if 2
)


(defun sline_cl (en1 / ed1 pta1 pta2 pto anga ango adist pto1 pto2)
  (arxload "geomcal.arx" nil)
  (setq ed1 (entget en1))
  (setq pta1 (cdr (assoc 10 ed1))
pta2 (cdr (assoc 11 ed1))

  )
  (setq pto (c:cal "(pta1 + pta2) / 2"))
  (setq anga (angle pto pta1))
  (setq ango (+ anga (/  PI 2)))
  (setq adist (adddist))
  (setq pto1 (polar pto ango adist))
  (setq pto2 (polar pto ango (- adist)))
  (command "_line" pto1 pto2 "")
  (arxunload "geomcal.arx" nil)
)

;画椭圆中心线
(defun ellipse_cl (en1 / ss pc px rad rad1 d p1 p2 ri adist ns n lline)
  (setq ss (ssget '((0 . "Ellipse"))))

(setq ns (sslength ss) n 0)
  (
while (< n ns)

(setq adist(adddist))
(setq en1 (ssname ss n))  
(setq pc (dxf 10 en1))
(
    setq px (dxf 11 en1)
       px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)
      rad (distance pc px)
        d (/ (fix (* rad adist)) 100.0)
       p1 (polar pc (angle pc px)(+ rad d))
              p2 (polar pc (angle px pc)(+ rad d))
            rad1 (* (dxf 40 en1) rad)
              ri (/ (+ rad1 d)(+ rad d))
) ;end setq

(if p2 (command "line" p1 p2 ""))
    (setq lline (entlast))
    (command "copy" (entlast) "" pc pc "rotate" (entlast) "" pc 90 "")
    (
if (= (dxf 0 en1) "ELLIPSE") (command "scale" lline "" pc ri )
);end if

    (setq n (1+ n))
  )
  (princ)
  
)


(defun dxf (code ename)(cdr (assoc code (entget ename))))

;主程序
(defun c:cline (/ oldlayer oldecho oldsnap oldortho en1 )
  (setq oldlayer (getvar "clayer"))
  (setq oldecho (getvar "cmdecho"))
  (setq oldsnap (getvar "osmode"))
  (setq oldortho (getvar "orthomode"))
  ;(setvar "clayer" "Center")
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "orthomode" 0)
  (setq en1 (car (entsel "\n请选择直线、圆、圆弧或椭圆<退出>:")))
  (if en1
    (cond
      ((= "LINE" (cdr (assoc 0 (entget en1)))) (line_cl en1))
      ((= "ARC" (cdr (assoc 0 (entget en1)))) (arc_cl en1))
      ((= "CIRCLE" (cdr (assoc 0 (entget en1)))) (circle_cl en1))
      ((= "ELLIPSE" (cdr (assoc 0 (entget en1)))) (ellipse_cl en1))
      (t (princ "\n所选对象不符合要求，程序退出"))
    )
    (princ "\n未选择对象，程序退出")
  )
  (setvar "cmdecho" oldecho)
  (setvar "osmode" oldsnap)
  (setvar "orthomode" oldortho)
  (setvar "clayer" oldlayer)
  (princ)
)




另外，哪位大侠能否给这个程序加个画矩形中心线的程序！[/SIZE]