批量给圆孔、圆弧画中心线的程序

badgirl

(defun C:mc (/ circle-ssget arc-ssget temp-int
temp-entname var-osmode var-layer var-cmdecho
p1 p2 p3 p4
dia-value center-point
)
(setq var-osmode (getvar "osmode"))
(setq var-layer (getvar "clayer"))
(setq var-cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (= (tblsearch "layer" "center") nil)
(command "layer" "new" "center" "color" 1
"center" "ltype" "center" "center" "set"
"center" ""
)
(command "layer" "set" "center" "")
)
(setq circle-ssget
(ssget
"c"
(setq p1
(getpoint
"\n您选择框内的所有圆和圆弧都画上中心线。\n 请给出选择框的第一个点:"
)
)
(progn
(print "请给出选择框的对角点:")
(while (/= 3 (car (setq p2 (grread 1 1 0))))
(redraw)
(grdraw p1 (list (car p1) (nth 1 (cadr p2))) -1 1)
(grdraw p1 (list (nth 0 (cadr p2)) (nth 1 p1)) -1 1)
(grdraw (cadr p2)
(list (nth 0 (cadr p2)) (nth 1 p1))
-1
1
)
(grdraw (cadr p2)
(list (nth 0 p1) (nth 1 (cadr p2)))
-1
1
) (setq p2 (cadr p2)) )
)
'((0 . "circle")) )
)
(redraw)
(setvar "osmode" 0)
(setq arc-ssget (ssget "c" p1 (cadr p2) '((0 . "arc"))))
(setq temp-int 0)
(if (/= circle-ssget nil)
(repeat (sslength circle-ssget)
(setq temp-entname (ssname circle-ssget temp-int))
(setq center-point (cdr (assoc 10 (entget temp-entname))))
(setq dia-value (cdr (assoc 40 (entget temp-entname))))
(setq dia-value (* 1.3 dia-value))
(setq
p1
(list (car center-point) (- (nth 1 center-point) dia-value))
)
(setq
p2
(list (car center-point) (+ (nth 1 center-point) dia-value))
)
(setq p3 (list (- (nth 0 center-point) dia-value)
(nth 1 center-point)
)
)
(setq p4 (list (+ (nth 0 center-point) dia-value)
(nth 1 center-point)
)
)
(command "line" p1 p2 "")
(command "line" p3 p4 "")
(setq temp-int (+ temp-int 1))
)
)
(princ)
(princ) (setq temp-int 0)
(if (/= arc-ssget nil)
(repeat (sslength arc-ssget)
(setq temp-entname (ssname arc-ssget temp-int))
(setq center-point (cdr (assoc 10 (entget temp-entname))))
(setq dia-value (cdr (assoc 40 (entget temp-entname))))
(setq dia-value (* 1.3 dia-value))
(setq
p1
(list (car center-point) (- (nth 1 center-point) dia-value))
)
(setq
p2
(list (car center-point) (+ (nth 1 center-point) dia-value))
)
(setq p3 (list (- (nth 0 center-point) dia-value)
(nth 1 center-point)
)
)
(setq p4 (list (+ (nth 0 center-point) dia-value)
(nth 1 center-point)
)
)
(command "line" p1 p2 "")
(command "line" p3 p4 "") (setq temp-int (+ temp-int 1))
)
)
(setvar "osmode" var-osmode)
(command "layer" "set" var-layer "")
(setvar "cmdecho" var-cmdecho)
(princ)
(princ)
) 1 该程序可以在你框选内自动识别圆孔、圆弧；
2 该程序将画好的中心线放在CENTER图层里（如果你没有建这个层，命令会自动建立该层），该图层设为中心线层。
刚刚学习用LISP，写得不好，请不要丢西红柿。

BDYCAD

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=8251

meflying

我丢一个: 选择圆为何不直接用ssget '((0 . "circle")))?前面加个提示: (prompt "请选择圆...")
(ssget '((0 . "circle"))) 这样不一定采用C的方式,选择方式由用户去决定,还可以多种方式并存,不是更好?

无痕

;;重来不用画这个，纯玩玩:),现编一个

2. (defun c:cenline ( / ss i ocen e pt out2) ;; out 全局.
3.    (princ "\n画圆心标志，选择标注实体:")
4.    (vl-cmdf ".undo" "be")
5.    (setq ss (ssget '((0 . "CIRCLE,ARC")))
6.   out2 (getdist (strcat "\n线出头长度" (if out (rtos out 2 2) "") ":"))
7.   i -1
8.   ocen (getvar "dimcen"))
9.    (if out2 (setq out out2))
10.    (while (setq e (ssname ss (setq i (1+ i))))
11.        (setvar "dimcen" (+ out (cdr (assoc 40 (entget e)))))
12.        (setq pt (vlax-curve-getstartpoint e))
13.        (vl-cmdf "dimcenter" (princ (list e pt)))
14.    )
15.    (setvar "dimcen" ocen)
16.    (vl-cmdf ".undo" "e")
17.    (princ)
18. )

(defun c:cenline ( / ss i ocen e pt out2) ;; out 全局.    (princ "\n画圆心标志，选择标注实体:")    (vl-cmdf ".undo" "be")    (setq ss (ssget '((0 . "CIRCLE,ARC")))   out2 (getdist (strcat "\n线出头长度" (if out (rtos out 2 2) "") ":"))   i -1   ocen (getvar "dimcen"))    (if out2 (setq out out2))    (while (setq e (ssname ss (setq i (1+ i))))        (setvar "dimcen" (+ out (cdr (assoc 40 (entget e)))))        (setq pt (vlax-curve-getstartpoint e))        (vl-cmdf "dimcenter" (princ (list e pt)))    )    (setvar "dimcen" ocen)    (vl-cmdf ".undo" "e")    (princ) )

小妹丁

无痕发表于2004-9-17 4:38:00;;重来不用画这个，纯玩玩:),现编一个 getdist (strcat \"\n线出头长度\"

岂不麻烦？应该改，（按直径的15%比较好）

无痕

怎么适合怎么改啦，我不用这个的，也不知道出头长度的通常要求