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

badgirl 发表于 2004-9-16 15:29:00

(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 发表于 2004-9-16 16:39:00

<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=8251" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=8251</A>

meflying 发表于 2004-9-16 16:42:00

我丢一个:

选择圆为何不直接用:(ssget '((0 . "circle")))?前面加个提示:

(prompt "请选择圆...") (ssget '((0 . "circle")))

这样不一定采用C的方式,选择方式由用户去决定,还可以多种方式并存,不是更好?

无痕发表于 2004-9-17 04:38:00

;;重来不用画这个，纯玩玩:),现编一个(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 15:42:00

本帖最后由作者于 2004-9-17 23:08:02 编辑 无痕发表于2004-9-17 4:38:00static/image/common/back.gif;;重来不用画这个，纯玩玩:),现编一个

getdist (strcat \"\n线出头长度\"

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

无痕发表于 2004-9-17 19:28:00

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

至今没学会 发表于 2025-2-12 17:51:14

有批量删除圆孔中心线的插件吗？

GEGEYANG88 发表于 2025-2-12 22:26:07

;;有！
(defun c:11 (/ ss i circle center radius ssLines line)
(vl-load-com)
;; 提示用户选择多个圆
(setq ss (ssget '((0 . "CIRCLE")))); 选择所有圆对象

;; 检查是否选择了圆
(if ss
(progn
   (setq i 0); 初始化索引
   (setvar "cmdecho" 0);_关闭命令提示
   ;; 遍历选择集中的每个圆
   (repeat (sslength ss)
   (setq circle (ssname ss i)); 获取当前圆
   (setq center (cdr (assoc 10 (entget circle)))); 获取圆心
   (setq radius (cdr (assoc 40 (entget circle)))); 获取半径

   ;; 在圆心 0.1 范围内查找中心线
   (setq ssLines (ssget "_C"
                        (list (- (car center) 0.1) (- (cadr center) 0.1)); 左下角点
                        (list (+ (car center) 0.1) (+ (cadr center) 0.1)); 右上角点
                        '((0 . "LINE") (6 . "CENTER")))); 只选择中心线

   ;; 检查是否有中心线
   (if ssLines
      (progn
         ;; 遍历找到的中心线并删除
         (repeat (sslength ssLines)
         (setq line (ssname ssLines 0)); 获取当前中心线
         (entdel line); 删除中心线
         (setq ssLines (ssdel line ssLines)); 从选择集中删除已删除的线
         )
      )
   )

   (setq i (1+ i)); 递增索引
   )
   (setvar "cmdecho" 1);_打开命令提示
   (princ "\n处理完成。"); 提示用户处理完成
)
(princ "\n未选择任何圆。"); 如果没有选择圆，输出提示
)

(princ); 静默退出
)

页: [1]

明经CAD社区's Archiver

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