求大侠高手帮忙完成下周长源码不全 样条曲线椭圆与圆与弧都量不出来。

tang87

求大侠高手帮忙完成下周长源码不全　样条曲线椭圆与圆与弧都量不出来。求帮助。(defun c:zc ( / a b1 box ee len ls1 lsn odlst p1 p2 pa sn ss sx th x y ebox ssbox new_ss lstcj ss2lst mkmtext qxcd);;周长
(progn
(defun qxcd (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun ebox (ent / ll ur)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
  (mapcar 'safearray-value (list ll ur))
)
(defun new_ss (lastobj / ss obj)
  (setq ss (ssadd))
        (setq obj (entnext lastobj))
        (while obj
            (setq ss (ssadd obj ss))
            (setq obj (entnext obj))
        )
ss
)
(defun ssbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)
(defun lstcj ( l1 l2 )
  (vl-remove-if '(lambda ( x ) (member x l2)) l1)
)
(defun ss2lst ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (ssname ss (setq i (1- i))) l))
        )
    )
)
(if (not (tblsearch "Style" "样式 1"))
(progn
;;;entmake *** "STYLE" *** object:
  (entmake (list
    '(0 . "STYLE")
    '(100 . "AcDbSymbolTableRecord")
    '(100 . "AcDbTextStyleTableRecord")
    '(2 . "样式 1")
    '(70 . 0)
    '(40 . 0.0)
    '(41 . 1.0)
    '(50 . 0.0)
    '(71 . 0)
    '(42 . 20.0)
    '(3 . "simkai.ttf")
    '(4 . "")
      )
    )
  );End Progn
)
(defun mkmtext (la str pt th a71 a72 a73)
  (entmakex (list '(0 . "MTEXT")
  '(100 . "AcDbEntity") '(100 . "AcDbMText")
                 (cons 8 la)
                 (cons 1 str)
                 (cons 10 (trans pt 1 0))
                 (cons 40 th)
                 (cons 11 (list 1.0 0.0 0.0))
                 (cons 7 "样式 1")
                 (cons 71 a71)
                 (cons 72 a72)
                 (cons 73 a73)
           )
  )
)
(vl-load-com)
(setq *acad  (vlax-get-acad-object)
    *doc   (vla-get-ActiveDocument *acad)
)
(defun *error*(msg)
     (mapcar 'setvar '("cmdecho" "osmode" "peditaccept") odlst)
     (vlax-invoke-method *doc 'EndUndoMark)
     (princ msg)
     )        
(vlax-invoke-method *doc 'StartUndoMark)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode" "peditaccept")))
(mapcar 'setvar '("cmdecho" "osmode" "peditaccept") '(0 0 1))
)
(if (not *dw) (setq *dw "H"))
(initget 128 "H L M ")
  (setq *dw (cond((getkword (strcat "\n选择单位[H毫米/L厘米/M米] <" *dw ">: ")))(*dw)))
(princ "\n选择全部处理对象:")
(setq ss (ssget '((0 . "line,arc,LWPOLYLINE,ELLIPSE,spline"))))
(setq ee (entlast))
(vl-cmdf "_pedit" "_M" ss "" "_j" "0.001" "")
(setq sn (new_ss ee))
(vl-cmdf "select" ss sn "")
(setq sn (ssget "p"))
(setq lsn (ss2lst sn)
        lsn (vl-sort lsn '(lambda (x y) (> (Vlax-Get (Vlax-Ename->Vla-Object x) 'Area ) (Vlax-Get (Vlax-Ename->Vla-Object y) 'Area )) ) )
)
(setq th 50)
(setq ls1 lsn)
(setq len (apply '+ (mapcar '(lambda(x) (qxcd x)) ls1))
                len (cond ((= "H" *dw) (strcat (rtos len 2 2) "mm")) ((= "L" *dw) (strcat (rtos (/ len 10.) 2 2) "cm")) ((= "M" *dw) (strcat (rtos (/ len 1e3) 2 2) "m")))
        )
(mkmtext "0" len (getpoint "\n点取文字左下角点:") 50 7 5 1)
(mapcar 'setvar '("cmdecho" "osmode" "peditaccept") odlst)
(vlax-invoke-method *doc 'EndUndoMark)
)