怎样才能增加线的中心线?

120120

(defun c:cl (/ s ss n ce na olderr obl oco ocm olt pl pr pt pb xr)
  (setq olderr *error* *error* ai_abort
  ocm (getvar "cmdecho")
  obl (getvar "blipmode")
  oco (getvar "cecolor")
         osnap(getvar "osmode")
  olt (getvar "celtype"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (command "_.UNDO" "_GROUP")
  (princ "\n请选择需加中心线的圆，弧.")
  (princ)
  (setq ss (ssget) n 0)
  (repeat (sslength ss)
     (setq s (entget (ssname ss n))
    n (1+ n)
          na (cdr (assoc 0 s)))
     (if (or (= na "CIRCLE") (= na "ARC"))
 (progn
   (setq ce (cdr (assoc 10 s))
           xr (* (cdr (assoc 40 s)) 1.3)
    pl (polar ce 3.1415926 xr)
    pr (polar ce 0 xr)
    pt (polar ce 1.5707963 xr)
    pb (polar ce 4.7123889 xr))
     (command "ucs" "w")
     (command "cecolor" "1" "celtype" "center" "line" pl pr "" "line" pt pb "")
     (command "ucs" "p")
     )  )
  )
  (setvar "cmdecho" ocm)
  (setvar "cecolor" oco)
  (setvar "celtype" olt)
  (setvar "osmode" osnap)
  (setq *error* olderr)
  (command "_.UNDO" "_E")
  (princ)
)

这个中心线的工功能很好用.可以实现框选,但只能画圆或弧的中心线.有那位朋友可以增加直线的中心线?

120120

(DEFUN C:CL ()
 (setq old_osm (getvar "osmode"))
 (setvar "osmode" 0)
 (setq sel_id "OK"
       cl_ent1 (entsel "\n请选取直线、圆弧、圆:"))
 (while (and sel_id cl_ent1)
  (setq cl_dat1 (entget (car cl_ent1))
        cl_nam1 (cdr (assoc 0 cl_dat1)))
  (if (and (/= "LINE"   cl_nam1)
           (/= "ARC"    cl_nam1)
           (/= "CIRCLE" cl_nam1))
   (setq cl_ent1 (entsel "\r:请选取直线、&圆弧、圆:"))
   (setq sel_id nil)
  )
 )
 (if (and cl_ent1 (null sel_id))
  (progn
   (setq cl_lay (cdr (assoc 8 cl_dat1)))
   (if (= "LINE" cl_nam1)
    (progn
     (setq cl_ent2 (entsel "\n请选取另一直线:"))
     (if cl_ent2
      (progn
       (setq cl_dat2 (entget (car cl_ent2))
             cl_nam2 (cdr (assoc 0 cl_dat2)))
       (if (/= "LINE" cl_nam2)
        (exit)
        (progn
         (setq cl_pt1 (trans (cdr (assoc 10 cl_dat1)) 0 1)
               cl_pt2 (trans (cdr (assoc 11 cl_dat1)) 0 1)
               cl_pt3 (trans (cdr (assoc 10 cl_dat2)) 0 1)
               cl_pt4 (trans (cdr (assoc 11 cl_dat2)) 0 1)
               cl_pt5 (trans (cadr cl_ent1) 0 1))
         (if (<= (distance cl_pt1 cl_pt5) (distance cl_pt2 cl_pt5))
          (setq cl1_pt cl_pt1 cl2_pt cl_pt2)
          (setq cl1_pt cl_pt2 cl2_pt cl_pt1) 
         )       
         (if (<= (distance cl_pt3 cl_pt5) (distance cl_pt4 cl_pt5))
          (setq cl3_pt cl_pt3 cl4_pt cl_pt4)
          (setq cl3_pt cl_pt4 cl4_pt cl_pt3) 
         )
         (setq cl_pnt1 (polar cl1_pt (angle cl1_pt cl3_pt) (* 0.5 (distance cl1_pt cl3_pt)))
               cl_pnt2 (polar cl2_pt (angle cl2_pt cl4_pt) (* 0.5 (distance cl2_pt cl4_pt))))
         (command "line" (polar cl_pnt1 (angle cl_pnt2 cl_pnt1) (* 0.1 (distance cl_pnt1 cl_pnt2)))
                         (polar cl_pnt2 (angle cl_pnt1 cl_pnt2) (* 0.1 (distance cl_pnt1 cl_pnt2))) "")
         (command "chprop" (entlast) "" "c" "1" "lt" "center" "la" cl_lay "")
        )     
       )
      )
     )
    )
    (progn
     (setq cl_pt (trans (cdr (assoc 10 cl_dat1)) 0 1)
           cl_rad (cdr (assoc 40 cl_dat1)))
     (command "line" (list (+ (* 1.2 cl_rad) (car cl_pt)) (cadr cl_pt))
                     (list (- (car cl_pt) (* 1.2 cl_rad)) (cadr cl_pt)) "")
     (command "chprop" (entlast) "" "c" "1" "lt" "center" "la" cl_lay "")
     (command "line" (list (car cl_pt) (+ (* 1.2 cl_rad) (cadr cl_pt)))
                     (list (car cl_pt) (- (cadr cl_pt) (* 1.2 cl_rad))) "")
     (command "chprop" (entlast) "" "c" "1" "lt" "center" "la" cl_lay "")
    )
   )
  )
 )
 (setvar "osmode" old_osm)
 (princ)
)

这个是可以画直线、圆弧、的，但不用框选。有朋友可以改成框选吗？