各位高手请进！

王航

大家帮忙看看下面的程序，执行后，边界不能合并，返回的是：“错误: no function definition: VLAX-ENAME->VLA-OBJECT”，我是新手，请大家帮忙，谢谢！



;;;选择直线 园弧 园自动生成边界,程序作者：Gu_xl  时间：2010年2月
(defun c:bj (/ NewSel sel n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel)
;;;选择集合并，返回合并后选择集，参数 选择集 图元都可以
  (defun SS_SSjoin (ss1 ss2 / ename ss cnt)
    (if  ss1
      (progn
  (if (= (type ss1) 'ENAME)
    (progn
      (setq
        ename ss1
        ss1   (ssadd)
      )
      (ssadd ename ss1)
    )
  )
      )
    )
    (if  ss2
      (progn
  (if (= (type ss2) 'ENAME)
    (progn
      (setq
        ename ss2
        ss2   (ssadd)
      )
      (ssadd ename ss2)
    )
  )
      )
    )
    (setq ss (ssadd))
    (if  (and ss1 ss2)
      (progn
  (setq ss  ss2
        cnt 0
  )
  (repeat  (sslength ss1)
    (ssadd (ssname ss1 cnt) ss)
    (setq cnt (1+ cnt))
  )
      )
    )
    (if  (and ss1 (not ss2))
      (setq ss ss1)
    )
    (if  (and ss2 (not ss1))
      (setq ss ss2)
    )
    (if  (> (sslength ss) 0)
      (eval ss)
      nil
    )
  )
;;;========================================================================================
  ;;选择集求交点子程序
;;;========================================================================================
  (defun interss
   (ss / i ssl aobj1 aobj2 n2 ipts pts pts1 pt el objL objL1)
    (setq ssl  (sslength ss)
    i    -1
    objL '()
    )
;;;OBJL 对象表 '((obj1) (obj2)...)
    (repeat ssl
      (setq
  objL
   (cons (list (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
         objL
   )
      )
    )          ;repeat
    (setq i -1)
    (repeat ssl
      (setq obj1 (nth (setq i (1+ i)) objL))
      (setq objL1 (cdr (member obj1 objL))
      aobj1 (car obj1)
      )
      (setq mm  (- ssl i 1)
      m  -1
      pts  '()
      )
      (repeat mm
  (setq obj2 (nth (setq m (1+ m)) objL1))
  (setq aobj2 (car obj2)
        pts1  '()
  )
  (setq ipts (vla-intersectwith
         aobj1
         aobj2
         0
       )
        ipts (vlax-variant-value ipts)
  )
  (if (> (vlax-safearray-get-u-bound ipts 1) 0) ;是否有交点
    (progn
      (setq ipts
       (vlax-safearray->list ipts)
      )
      (while (> (length ipts) 0)
        (setq pt (list (car ipts)
           (cadr ipts)
           (caddr ipts)
           )
        )
        (cond
    ((or (= (vla-get-objectname aobj2) "AcDbLine")
         (= (vla-get-objectname aobj2) "AcDbArc")
     )
     (if (not (or (equal (vlax-curve-getstartpoint aobj2)
             pt
             0.0001
            )
            (equal (vlax-curve-getendpoint aobj2)
             pt
             0.0001
            )
        )
         )
       (setq pts1 (cons pt pts1))
          ;(setq objL (subst (append obj2 (list pt)) obj2 objL))
     )      ;if
    )
    ((= (vla-get-objectname aobj2) "AcDbCircle")
          ;(setq objL (subst (append obj2 (list pt)) obj2 objL))
     (setq pts1 (cons pt pts1))
    )
        )        ;cond
        (cond
    ((or (= (vla-get-objectname aobj1) "AcDbLine")
         (= (vla-get-objectname aobj1) "AcDbArc")
     )
     (if (not (or (equal (vlax-curve-getstartpoint aobj1)
             pt
             0.0001
            )
            (equal (vlax-curve-getendpoint aobj1)
             pt
             0.0001
            )
        )
         )
       (setq pts (cons pt pts))
     )      ;if
    )
    ((= (vla-get-objectname aobj1) "AcDbCircle")
     (setq pts (cons pt pts))
    )
        )        ;cond
        (setq ipts (cdddr ipts))
      )        ;while
    )        ;progn
  )        ;if
  (if pts1
    (setq objL (subst (append obj2 pts1) obj2 objL))
  )
      )          ;repeat
      (if pts
  (setq objL (subst (append obj1 pts) obj1 objL))
      )          ;if
    )          ;repeat
          ;在这里单独去除重合点和点沿曲线排序
    (mapcar '(lambda (a)
         (if (cdr a)
     (list (car a)
           (gxl-SortPointOnCurve
       (gxl-ListDumpPoint (cdr a) 0.00001)
       (car a)
           )
     )
     a
         )
       )
      objL
    )
  )          ;defun interss1
;;;========================================================================================
;;;Line/Arc/Circle实体打断程序 Break_ss
  (defun Break_ss (ss       /         ObjptL   obj     pts
       thisdrawing         modelspace     ssl
       pstart    pend      LayerName Linetype  Color
       objLine
      )
    (if  ss
      (progn
  (setq objptL    (interss ss)
        thisdrawing (vla-get-activedocument
          (vlax-get-acad-object)
        )
        modelspace  (vla-get-ModelSpace thisdrawing)
        ssL    (length objptL)
        i      -1
  )
      )          ;progn
    )          ;if
    (vla-startundomark thisdrawing)
    (setq LastEntity (entlast))
    (repeat ssl
      (setq objPts (nth (setq i (1+ i)) objptL)
      obj     (car objPts)
      pts     (cadr objPts)
      )
      (cond ((= (vla-get-objectname obj) "AcDbLine")
       (setq LayerName (vla-get-layer obj)
       Linetype  (vla-get-linetype obj)
       Color     (vla-get-color obj)
       )
       (setq pstart (vlax-curve-getstartpoint obj)
       pend    (vlax-curve-getendpoint obj)
       pts    (append (list pstart) pts)
       pts    (append pts (list pend))
       )
       (while
         (> (length pts) 1)
    (setq objLine (vla-addline
        modelspace
        (vlax-3d-point (car pts))
        (vlax-3d-point (cadr pts))
            )
    )
;;;加入选择集
    (ssadd (entlast) NewSel)
    (vla-put-layer objLine LayerName)
    (vla-put-linetype objLine Linetype)
    (vla-put-color objLine Color)
    (setq pts (cdr pts))
       )
       (ssdel (vlax-vla-object->ename obj) Sel)
       (vla-Delete obj)
      )
      ((= (vla-get-objectname obj) "AcDbArc")
       (BreakArcByPoint (vlax-vla-object->ename obj) pts)
      )
      ((= (vla-get-objectname obj) "AcDbCircle")
       (Cir2ArcByPoint (vlax-vla-object->ename obj) pts)
      )
      )          ;cond
    )          ;repeat
    (vla-endundomark thisdrawing)
  )          ;defun Break_ss1
;;;将圆、圆弧打断变为arc 实体表转换 (cir2arc cir strang endang)
;;;测试: (cir2arc (car(entsel "\n选择要转为半圆弧的圆实体:")) 0 Pi T)
  (defun cir2arc (cir strang endang / el x)
    (setq el (entget cir)
    el (vl-remove-if
         '(lambda (x) (or (= -1 (car x)) (= 0 (car x))))
         el
       )
    el (append
         (list '(0 . "ARC"))
         el
         (list '(100 . "AcDbArc") (cons 50 strang) (cons 51 endang))
       )
    )
    (entmake el)
;;;加入选择集
    (ssadd (entlast) NewSel)
  )
;;;沿园上分割点将园打断为圆弧 Cir2ArcByPoint cir ptLst
  (defun Cir2ArcByPoint  (cir ptLst / cpt r x k kk ang0 ang1 angL)
    (setq cpt (dxf cir 10)
    r   (dxf cir 40)
    )
    (setq angL (vl-sort (mapcar '(lambda (x) (angle cpt x)) ptLst) '<))
    (setq k    -1
    kk   (length angL)
    ang0 (last angL)
    )
    (repeat kk
      (setq ang1 (nth (setq k (1+ k)) angL)
      )
      (cir2arc cir ang0 ang1)
      (setq ang0 ang1)
    )          ;repeat
    (ssdel cir Sel)
    (entdel cir)
  )          ;defun
;;;沿园弧上分割点将园打断为圆弧 BreakArcByPoint cir ptLst
  (defun BreakArcByPoint
   (cir ptLst / cpt r x k kk angstart angEnd ang1 angL)
    (setq angstart (dxf cir 50)
    angEnd   (dxf cir 51)
    cpt     (dxf cir 10)
    )
    (setq angL (mapcar '(lambda (x) (angle cpt x)) ptLst))
    (setq k  -1
    kk (length angL)
    )
    (repeat kk
      (setq ang1 (nth (setq k (1+ k)) angL)
      )
      (cir2arc cir angstart ang1)
      (setq angstart ang1)
    )          ;repeat
    (cir2arc cir angstart angEnd)
    (ssdel cir Sel)
    (entdel cir)
  )          ;defun
;;;gxl-ListDumpPoint 从给定点列表中移去重复出现的点。
  ;;pts:表  fuzz:精度
  ;;By Aeo
  (defun gxl-ListDumpPoint (ptLst fuzz / pt1 x)
    (cond ((= (length ptLst) 1) ptLst)
    (t
     (setq pt1 (car ptLst))
     (cons pt1
     (vl-remove-if
       '(lambda (x) (equal pt1 x fuzz))
       (gxl-ListDumpPoint (cdr ptLst) fuzz)
     )
     )
    )
    )
  )
;;;=============================================================================================
;;;(gxl-SortPointOnCurve  points curve) 参数 点集 points 曲线图元 curve 点集沿曲线排序
  (defun gxl-SortPointOnCurve (points curve / pl1 xx nn)
    (if  (= (type curve) 'ENAME)
      (setq curve (vlax-ename->vla-object curve))
    )
    (setq pl1 (mapcar '(lambda (xx /)
       (vlax-curve-getparamatpoint
         curve
         (vlax-curve-getclosestpointto curve xx)
       )
           )
          points
        )
    )
    (mapcar '(lambda (nn) (nth nn points))
      (vl-sort-i pl1 '<)
    )
  )
;;;===============================
;;;表操作函数
;;;判断点 p1 是否在点集PL中，是返回T ，不是返回nil，a为精度
;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T
  (defun IsInPointList (p1 PL a)
    (if  (member t (mapcar '(lambda (b) (equal p1 b a)) PL))
      t
      nil
    )
  )
;;;取出图元索引i对应的值
  (defun dxf (ent i)
    (cdr (assoc i (entget ent)))
  )
;;;==================================================================
;;;MidPoint 表操作函数,计算两点的中点
;;;计算两点的中点
;;;==================================================================
  (defun MidPoint (p1 p2)
    (if  (> 2 (length p1))
      (list (* 0.5 (+ (car p1) (car p2)))
      (* 0.5 (+ (cadr p1) (cadr p2)))
      (* 0.5 (+ (caddr p1) (caddr p2)))
      )
      (list (* 0.5 (+ (car p1) (car p2)))
      (* 0.5 (+ (cadr p1) (cadr p2)))
      )
    )
  )
;;;取圆弧的起点、终点。中点
  (defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)
    (setq cenp (cdr (assoc 10 (entget a))))
    (setq radius (cdr (assoc 40 (entget a))))
    (setq
      STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A))
    )
    (setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))
    (setq arcmidpoint
     (polar (polar stp
       (angle stp enp)
       (/ (distance STP ENP) 2.0)
      )
      (angle cenp
       (polar  stp
        (angle stp enp)
        (/ (distance STP ENP) 2.0)
       )
      )
      (- radius
         (distance (polar stp
              (angle stp enp)
              (/ (distance STP ENP) 2.0)
             )
             cenp
         )
      )
     )
    )
    (list stp enp arcmidpoint)
  )
;;;==================================================================
;;;get_rec_pointlist 获得一组点列表中左下角坐标和右上角坐标范围,[<左下角点>   <右上角点> ]
;;;==================================================================
  (defun get_rec_pointlist (Pt_List / n plx ply pmin pmax e1 e2)
    (setq pt3 (LIST (apply 'max (mapcar '(lambda (x) (car X)) PT_LIST))
        (apply 'max (mapcar '(lambda (x) (caDr X)) PT_LIST))
        )
    PT1 (LIST (apply 'mIN (mapcar '(lambda (x) (car X)) PT_LIST))
        (apply 'mIN (mapcar '(lambda (x) (caDr X)) PT_LIST))
        )
    )
    (list PT1
    pt3
    )
  )          ;defun get_rec_pointlist
;;;返回直线、弧、园中点左右两侧一定距离的点，(LAC-LR-Point en d) 返回点对表 （左侧点 . 右侧点）
  (defun LAC-LR-Point (en d / a1 a2 a3 ang1 ang2)
    (cond ((= (dxf en 0) "LINE")
     (setq a1   (dxf en 10)
     a2   (dxf en 11)
     a3   (MidPoint a1 a2)
     ang  (angle a1 a2)
     ang1 (+ ang (* pi 0.5))
     ang2 (- ang (* pi 0.5))
     a1   (polar a3 ang1 d)
     a2   (polar a3 ang2 d)
     )
     (cons a1 a2)
    )
    ((= (dxf en 0) "ARC")
     (setq a3  (dxf en 10)  ;圆心
     r   (dxf en 40)  ;半径
     ang (* (+ (dxf en 50) (dxf en 51)) 0.5)
     a1  (polar a3 ang (- r d))
     a2  (polar a3 ang (+ r d))
     )
     (cons a1 a2)
    )
    ((= (dxf en 0) "CIRCLE")
     (setq a1 (dxf en 10)
     a2 (polar a1 0 (+ d (dxf en 40)))
     )
     (cons a1 a2)
    )
    )          ;cond
  )
;;;根据选择集中的line、arc、circle，生成点集
  (defun make_point_list (s / PL)
    (setq n  0
    PL '()
    mn (sslength s)
    )
    (repeat mn
      (setq en     (ssname s n)
      enType (dxf en 0)
      )
      (cond
  ((= enType "LINE")
   (setq pt1 (dxf en 10)
         pt2 (dxf en 11)
   )
   (if (not (IsInPointList pt1 pl 0.00001))
     (setq pl (cons pt1 pl))
   )        ;if
   (if (not (IsInPointList pt2 pl 0.00001))
     (setq pl (cons pt2 pl))
   )        ;if
  )
  ((= enType "ARC")
   (setq pt1 (car (arc_3point en))
         pt2 (cadr (arc_3point en))
   )
   (if (not (IsInPointList pt1 pl 0.00001))
     (setq pl (cons pt1 pl))
   )        ;if
   (if (not (IsInPointList pt2 pl 0.00001))
     (setq pl (cons pt2 pl))
   )        ;if
  )
      )          ;cond
      (setq n (1+ n))
    )          ;repeat
    (setq pl pl)
  )          ;make_point_list
;;;=======================================================
;;;主程序开始
  (princ "\n*******选择直线 园弧 园自动生成边界,程序作者：Gu_xl********")
  (setq oldos (getvar "osmode"))
  (setq oldfill (getvar "fillmode"))
  (setvar "osmode" 0)
  (setvar "fillmode" 1)
  (setvar "cmdecho" 0)
  (setq NewSel (ssadd))
  (princ "\n选择直线 、园弧、 园：")
  (setq sel (ssget (list '(0 . "line,arc,circle"))))
  (princ "\n正在整理 数据...........")
;;;打断代码
  (Break_ss Sel)
  (setq Sel (SS_SSjoin Sel NewSel))
  (if sel
    (progn
      (setq Plist (make_point_list sel))
      (zoom_window (setq recList (get_rec_pointlist Plist)))
;;;计算点范围Y值的五百分之一
      (setq VerticalLimit
       (* 0.002 (- (cadadr recList) (cadar recList)))
      )
      (if (< VerticalLimit 0.2)
  (setq VerticalLimit 0.2)
      )
      (setq enlast (entlast)
      ensel  (ssadd)
      )
;;;如果enlast为块定义，得到最后子图元
      (while (entnext enlast)
  (setq enlast (entnext enlast))
      )
      (setq enlast1 enlast)
      (command "_.boundary" "a" "i" "n" "+x" "b" "n" sel "" "")
      (setq ki -1
      k  (sslength Sel)
      )
      (princ "\n共有 ")
      (princ K)
      (princ " 边，正在生成边界.........")
      (princ K)
      (repeat k
  (setq en-line (ssname Sel (setq ki (1+ ki)))
        LpLst   (LAC-LR-Point en-line VerticalLimit) ;直线两边点
  )
  (command (car LpLst))
  (command (cdr LpLst))
      )          ;repeat
      (command "")
;;;======================================================
      (while (setq en (entnext enlast))
  (setq enlast en)
  (ssadd en ensel)
      )          ;while
      (command "erase" sel "")
      (setq ensel ensel)
    )          ;progn
    nil
  )          ;if
  (setvar "osmode" oldos)
  (setvar "fillmode" oldfill)
  (princ)
)