求个CAD 画中心线的LISP？象LTOOLS里CL一样的，谢了先

求个CAD 画中心线的LISP？象LTOOLS里CL一样的，谢了先

cl

在很多年之前就编过，可以同时给不同的对象进行中心线标注，包括圆、圆弧、矩形等，

谢了先，这个不好用，有没有象LTOOLS里CL一样的,可以对圆、圆弧、矩形画中心线，中心线长度可以自动调整
楼上的兄弟，可不可以分享一下，谢谢先

;; draw center lines according to selected object type
(defun c:cen()
        (command "_undo" "be")
        (setq sel-set (ssget))
        (command "_layer" "m" "CENTER" "c" 2 "CENTER" "l" "ACAD_ISO04W100" "CENTER" "lw" 0 "CENTER" "")
        (setvar "osmode" 0)
        (setq i 0)
        (while (< i (sslength sel-set))
                (setq ent (ssname sel-set i))
                (setq ent-list (entget ent))
                (setq ent-type-str (cdr (assoc 0 ent-list)))
                (if (= ent-type-str "CIRCLE")
                        (progn
                                (setq p-cir-cen (cdr (assoc 10 ent-list)))
                                (setq radius (cdr (assoc 40 ent-list)))
                                (setq p-right-mid (polar p-cir-cen 0 (+ radius (* 2.0 (getvar "dimscale")))))
                                (setq p-upper (polar p-cir-cen (* 0.5 pi) (+ radius (* 2.0 (getvar "dimscale")))))
                                (setq p-left-mid (polar p-cir-cen pi (+ radius (* 2.0 (getvar "dimscale")))))
                                (setq p-down (polar p-cir-cen (* -0.5 pi) (+ radius (* 2.0 (getvar "dimscale")))))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (= ent-type-str "ARC")
                        (progn
                                (setq p-arc-cen (cdr (assoc 10 ent-list)))
                                (setq radius (cdr (assoc 40 ent-list)))
                                (setq p-right-mid (polar p-arc-cen 0 (* 3.0 (getvar "dimscale"))))
                                (setq p-upper (polar p-arc-cen (* 0.5 pi) (* 3.0 (getvar "dimscale"))))
                                (setq p-left-mid (polar p-arc-cen pi (* 3.0 (getvar "dimscale"))))
                                (setq p-down (polar p-arc-cen (* -0.5 pi) (* 3.0 (getvar "dimscale"))))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (= ent-type-str "ELLIPSE")
                        (progn
                                (setq p-el-cen (cdr (assoc 10 ent-list)))
                                (setq half-long-axis-len (distance (list 0 0) (cdr (assoc 11 ent-list))))
                                (setq half-short-axis-len (* (cdr (assoc 40 ent-list)) half-long-axis-len))
                                (setq rot-angle (angle (list 0 0) (cdr (assoc 11 ent-list))))
                                (setq p-right-mid (polar p-el-cen rot-angle (+ half-long-axis-len (* 2.0 (getvar "dimscale")))))
                                (setq p-upper (polar p-el-cen (+ (* 0.5 pi) rot-angle) (+ half-short-axis-len (* 2.0 (getvar "dimscale")))))
                                (setq p-left-mid (polar p-el-cen (+ pi rot-angle) (+ half-long-axis-len (* 2.0 (getvar "dimscale")))))
                                (setq p-down (polar p-el-cen (+ (* 1.5 pi) rot-angle) (+ half-short-axis-len (* 2.0 (getvar "dimscale")))))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (and (= ent-type-str "LWPOLYLINE") (= (cdr (assoc 90 ent-list)) 4) (= (cdr (assoc 70 ent-list)) 1))
                        (progn
                                (setq p-down-left (cdr (nth 14 ent-list)))
                                (setq p-down-right (cdr (nth 18 ent-list)))
                                (setq p-upper-right (cdr (nth 22 ent-list)))
                                (setq p-upper-left (cdr (nth 26 ent-list)))
                                (setq rot-ang (angle p-down-left p-down-right))
                                (setq p-mid (polar p-down-left (angle p-down-left p-upper-right) (* 0.5 (distance p-down-left p-upper-right))))
                                (setq p-right-mid (polar p-mid rot-ang (+ (* 0.5 (distance p-down-left p-down-right)) (* 2.0 (getvar "dimscale")))))
                                (setq p-upper (polar p-mid (+ (* 0.5 pi) rot-ang) (+ (* 0.5 (distance p-down-right p-upper-right)) (* 2.0 (getvar "dimscale")))))
                                (setq p-left-mid (polar p-mid (+ pi rot-ang) (+ (* 0.5 (distance p-down-left p-down-right)) (* 2.0 (getvar "dimscale")))))
                                (setq p-down (polar p-mid (+ (* 1.5 pi) rot-ang) (+ (* 0.5 (distance p-down-right p-upper-right)) (* 2.0 (getvar "dimscale")))))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (setq i (1+ i))
                )
        (setvar "osmode" *curr-osmode*)
        (setvar "clayer" *curr-layer*)
        (command "_undo" "e")
        (princ)
        )

谢了先，但功能不好，对2条直线不能画中心线，中心线长度都是固定多出2MM，不能按比例调整
LTOOLS里的CL就可以，不知道哪位有这个LISP，谢谢先

终于找到个好的，中心线自动比原来多10％，自动放在CEN层

(DEFUN C:CE ()
(warn)
(setvar "cmdecho" 0)
(setq old_osm (getvar "osmode"))
(setq cl_old (getvar "clayer"))
(setvar "osmode" 0)
;-----------------------------------------------------------------------------------------
   (if (not (tblsearch "layer" "cen"))
       (command "_.layer" "_new" "cen" "_color" "6" "cen" "_ltype" "center" "cen" "")
       (command "_.layer" "thaw" "cen" "on" "cen" "unlock" "cen" "")
   )
;------------------------------------------------------------------------------------------
(setq sel_id "OK"
       cl_ent1 (entsel "\:请选取直线LINE&圆弧ARC&圆CIRCLE:"))
(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:请选取直线LINE&圆弧ARC&圆CIRCLE:"))
   (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 "\:请选取另一直线:"))
     (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))))
         (setvar "clayer" "cen")
         (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))) "")
         (setvar "clayer" cl_old)
        )      
       )
      )
     )
    )
    (progn
     (setq cl_pt (trans (cdr (assoc 10 cl_dat1)) 0 1)
           cl_rad (cdr (assoc 40 cl_dat1)))
     (setvar "clayer" "cen")
     (command "line" (list (+ (* 1.05 cl_rad) (car cl_pt)) (cadr cl_pt))
                     (list (- (car cl_pt) (* 1.1 cl_rad)) (cadr cl_pt)) "")
     
     (command "line" (list (car cl_pt) (+ (* 1.1 cl_rad) (cadr cl_pt)))
                     (list (car cl_pt) (- (cadr cl_pt) (* 1.05 cl_rad))) "")
     (setvar "clayer" cl_old)
    )
   )
  )
)
(setvar "osmode" old_osm)
  (princ)
)
;;

找不到呀，哪位朋友有呀

怎么使用这个LISP 啊?