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

只看该作者 · 发表于 2006-11-2 22:55:08

马上注册，结交更多同行朋友，交流，分享，学习。

您需要登录才可以下载或查看，没有帐号？注册

x

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

只看该作者 · 发表于 2006-11-3 07:38:28

只看该作者 · 发表于 2006-11-3 20:11:21

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

只看该作者 · 发表于 2006-11-3 22:51:46

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

只看该作者 · 发表于 2006-11-4 11:07:04

;; 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)
)

只看该作者 · 发表于 2006-11-4 18:32:48

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

只看该作者 · 发表于 2006-11-6 22:33:20

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

只看该作者 · 发表于 2006-11-6 22:35:48

(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)
)
;;

只看该作者 · 发表于 2007-1-16 13:21:25

找不到呀，哪位朋友有呀

只看该作者 · 发表于 2007-4-25 22:36:29

怎么使用这个LISP 啊?

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

马上注册，结交更多同行朋友，交流，分享，学习。

本帖子中包含更多资源