请高手帮我该一下这源代码

kaffeo

这个是画穿线空的代码，但是我做的产品都比较小。这个程序就不是很完善。该善的方向是抓物体的中心画圆，大的画2的圆，向现在这样。小的画1的圆或0.6的圆，宽小以一的外偏3MM画2的圆。现在的程序都是向内片一个距离。如果物体小以这个具离加2它就失效。  望那位高手能该好源代码传上来，谢谢！



;;;;穿线孔程序
(defun c:cxk
    (/ i nent ssent ssentset varclayer varcmdecho varosmode)
;;;;保存系统变量,并设置新值
(setq varosmode (getvar "OSMODE"))
;;;;捕捉模式
(setq varcmdecho (getvar "CMDECHO"))
;;;;命令行开关
(setq varclayer (getvar "CLAYER"))
;;;;图层
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
;;;;选择要画出穿线孔的实体
(princ "\n选择要画穿线孔的实体:\n")
(setq ssentset (ssget))
;;;; ssEntSet 实体集
(if (/= ssentset nil)
  (progn
   (setq nent (sslength ssentset))
;;;; nEnt 实体的个数
   (setq i 0)
;;;; i 计数器
   (repeat nent
    (setq ssent (entget (ssname ssentset i)))
;;;; ssEnt 实体数据表
    (if (= "LWPOLYLINE" (cdr (assoc 0 ssent)))
;;;;处理异形孔
     (if (= 1 (cdr (assoc 70 ssent)))
      (l01022p ssent)
     )
;;;;end if
;;;;处理圆孔
     (if (= "CIRCLE" (cdr (assoc 0 ssent)))
      (l01022c ssent)
     )
    )
    (setq i (1+ i))
;;;;计数器加1
   )
  )
)
;;;;恢复系统变量
(setvar "OSMODE" varosmode)
(setvar "CMDECHO" varcmdecho)
(setvar "CLAYER" varclayer)
;;;;结束
(princ "\n----OK----")
(princ)
)
(defun l01022p (ssent   /    tempssent     strlayer j1
        j2    listpt  numpt   xmax   xmin   ymax
        ymin
        )
(setq strlayer (cdr (assoc 8 ssent)))

;;;; numPt 顶点个数
(setq numpt (cdr (assoc 90 ssent)))
(setq tempssent (member (assoc 10 ssent) ssent))
;;;;取得顶点表
(setq j1 0)
;;;; j1 计数器
(setq listpt '())
(while (< j1 numpt)
;;;;第12个表是多义线的第一个顶点
  (setq
   listpt (append listpt
           (list (trans (cdr (nth (* j1 4) tempssent)) 0 1))
       )
  )
  (setq j1 (1+ j1))
)
;;;;求最大和最小x,y坐标
(setq xmin (car (nth 0 listpt)))
(setq xmax (car (nth 0 listpt)))
(setq ymin (cadr (nth 0 listpt)))
(setq ymax (cadr (nth 0 listpt)))
(setq j2 0)
(while (< j2 numpt)
  (if (> xmin (car (nth j2 listpt)))
   (setq xmin (car (nth j2 listpt)))
  )
  (if (< xmax (car (nth j2 listpt)))
   (setq xmax (car (nth j2 listpt)))
  )
  (if (> ymin (cadr (nth j2 listpt)))
   (setq ymin (cadr (nth j2 listpt)))
  )
  (if (< ymax (cadr (nth j2 listpt)))
   (setq ymax (cadr (nth j2 listpt)))
  )
  (setq j2 (1+ j2))
)
;;;;根据大小画穿线孔
(if (or (>= (- ymax ymin) 8) (>= (- xmax xmin) 8))
  (l01022p01 tempssent listpt 1)
)
)
(defun l01022c (ssent / strlayer pt pt1 radius)
(setq strlayer (cdr (assoc 8 ssent)))

(setvar "CLAYER" strlayer)
;;;;取得半径
(setq radius (cdr (assoc 40 ssent)))
(if (>= radius 1)
  (progn
   (setq pt (cdr (assoc 10 ssent)))
   (setq pt (trans pt 0 1))
;;;; pt 圆孔的圆心
   (setq pt1 (polar pt (* 0.25 pi) (- radius 0.5)))
;;;; pt1 穿线孔的圆心
   (if (>= radius 8)
                        (progn
                              (setq blkname "lspw20")
                              (command "insert" blkname  pt1 1 1 0))
                        
;;;;直径为1
   )   
;;;;end if
  )
;;;;end progn
)
;;;;end if
)
(defun l01022p01 (ssent  listpt flag  /    cxkpt  dist
         endpt  ispt  j3   j4   k1   len
         m    numlen numpt  startpt tmplist1
         tmplist2
         )
(setq numpt (length listpt))
;;;;取得多义线直线边的序号与长度
(setq j3 0)
(setq numlen '())
(while (< j3 numpt)
  (if (= 0 (cdr (nth (+ 3 (* 1 j3)) ssent)))
   (progn
    (setq startpt (nth j3 listpt))
    (setq endpt (nth (rem (1+ j3) numpt) listpt))
    (setq dist (distance startpt endpt))
    (setq numlen (append numlen (list (list j3 dist))))
   )
  )
  (setq j3 (1+ j3))
)
;;;;按长度排序
(if (/= (setq len (length numlen)) 0)
  (progn
   (setq j4 0)
   (while (< j4 len)
    (setq tmplist1 (nth j4 numlen))
    (setq k1 0)
    (while (< k1 len)
     (setq tmplist2 (nth k1 numlen))
     (if (> (cadr tmplist1) (cadr tmplist2))
      (progn
       (setq
        numlen (subst '() tmplist1 numlen)
       )
       (setq numlen
           (subst tmplist1 tmplist2 numlen)
       )
       (setq
        numlen (subst tmplist2 '() numlen)
       )
       (setq tmplist1 (nth j4 numlen))
      )
     )
     (setq k1 (1+ k1))
    )
    (setq j4 (1+ j4))
   )
  )
)
(if (/= numlen nil)
  (progn
   (setq m 0)
   (setq ispt 0)
   (while (and (< m (length numlen)) (= ispt 0))
    (setq ispt (l01022i m numlen))
    (setq m (1+ m))
   )
   (if (= ispt 1)
    (command "CIRCLE" cxkpt 1)
   )
  )
)
)


(defun l01022i (m    numlen /    ang1  ang2  crad  d1   d2
        endpt  entarea    ept  j5   j6   j7   k2
        k3   lrad  midpt  mpt  nflag  pt1  pt2   pt3
        ptarea ptno  spt   startpt    tmppt x23max x23min
        y23max y23min
        )
(setq ptno (car (nth m numlen)))
;;;;求边中点
(setq startpt (nth ptno listpt))
(setq endpt (nth (rem (1+ ptno) numpt) listpt))
(setq midpt (list (/ (+ (car startpt) (car endpt)) 0.5)
          (/ (+ (cadr startpt) (cadr endpt)) 0.5)
       )
)
;;;;求边的角度
(setq lrad (angle startpt endpt))
;;;;求表中顶点围成的面积
;;;(setvar "CMDECHO" 1)
(setq j5 0)
(command "AREA")
(while (< j5 numpt)
  (command (nth j5 listpt))
  (setq j5 (1+ j5))
)
(command "")
(setq entarea (getvar "AREA"))
;;;;参考点
(setq crad (+ lrad (* pi 0.5)))
(setq tmppt (polar midpt crad 0.1))
;;;;求加入tmpPt后的面积
(setq j6 0)
(command "AREA")
(while (<= j6 ptno)
  (command (nth j6 listpt))
  (setq j6 (1+ j6))
)
(command tmppt)
(while (< j6 numpt)
  (command (nth j6 listpt))
  (setq j6 (1+ j6))
)
(command "")
(setq ptarea (getvar "AREA"))
;;;;cRad 长边中点与穿线孔的角度
(if (> ptarea entarea)
  (setq crad (+ crad pi))
)
;;;;确定坐标并画出穿线孔
(if (= flag 0)
  (progn
   (setq crad (+ crad pi))
   (setq cxkpt (polar midpt crad 4))
   (setq nflag 1)
   nflag
  )
  (progn
   (setq cxkpt (polar midpt crad 4))
   (setq j7 0)
   (setq k2 0)
   (while (< j7 (length listpt))
    (if (/= (inters
         cxkpt
         (list (car cxkpt) (- ymin 0.5))
         (nth j7 listpt)
         (nth (rem (1+ j7) (length listpt))
            listpt
         )
        )
        nil
      )
     (setq k2 (1+ k2))
    )
    (setq j7 (1+ j7))
   )
   (if (= (rem k2 2) 1)
    (progn
     (setq nflag 1)
     (setq k3 0)
     (while (< k3 numpt)
      (setq spt (nth k3 listpt))
      (setq ept (nth (rem (1+ k3) numpt) listpt))
      (setq ang1 (angle spt ept))
      (setq ang2 (+ (* 0.5 pi) ang1))
      (setq pt1 (polar cxkpt ang2 0.1))
      (setq mpt (inters spt ept cxkpt pt1 nil))
      (setq d2 (distance cxkpt mpt))
      (if (< d2 3.999)
;;;;由于有误差,故用3.999代替4
       (progn
        (setq d1 (sqrt (- (* 4 4) (* d2 d2)))
        )
        (setq pt2 (polar mpt ang1 d1))
        (setq
         pt3 (polar mpt (+ ang1 pi) d1)
        )
        (setq
         y23min (min (cadr pt2)
               (cadr pt3)
             )
        )
        (setq x23min
            (min (car pt2) (car pt3))
        )
        (setq
         y23max (max (cadr pt2)
               (cadr pt3)
             )
        )
        (setq x23max
            (max (car pt2) (car pt3))
        )
        (if
         (not
          (or
           (and (> (car ept) x23max)
              (> (cadr ept)
               y23max
              )
              (> (car spt) x23max)
              (> (cadr spt)
               y23max
              )
           )
           (and (< (car ept) x23min)
              (< (cadr ept)
               y23min
              )
              (< (car spt) x23min)
              (< (cadr spt)
               y23min
              )
           )
           (and (< (car ept) x23min)
              (> (cadr ept)
               y23max
              )
              (< (car spt) x23min)
              (> (cadr spt)
               y23max
              )
           )
           (and (> (car ept) x23max)
              (< (cadr ept)
               y23min
              )
              (> (car spt) x23max)
              (< (cadr spt)
               y23min
              )
           )
          )
         )
          (setq nflag 0)
        )
       )
      )
      (setq k3 (1+ k3))
     )
    )
    (setq nflag 0)
   )
   nflag
  )
)
)