如何让圆内直线从中点断开

xskfq · 发表于 2013-11-24 20:34:36

本帖最后由 xskfq 于 2013-11-24 20:37 编辑

批量打断圆内直线，打断点为园内直线的中点，如图
本来想悬赏的，没找到怎么发悬赏帖，谁能帮解决下，衷心感谢！

xyp1964 · 发表于 2013-11-24 22:33:03

Gu_xl · 发表于 2013-11-24 22:55:53

;;直线打断与圆内中点 By Gu_xl 2013.11.24
(defun c:tt (/ *error* mid e el pl p0 p1)
(defun *error* (s)
(setvar 'cmdecho cmdecho)
(princ s)
)
(defun mid (p1 p2)
(mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2))
)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(while (and (setq e (car (entsel "\n选择直线:")))
(= "LINE" (cdr (assoc 0 (setq el (entget e)))))
)
(progn
(command "_zoom" "o" e "")
(setq p0 (trans (cdr (assoc 10 el)) 0 1)
p1 (trans (cdr (assoc 11 el)) 0 1)
)
(setq ss (ssget "F" (list p0 p1) '((0 . "circle"))))
(if ss
(progn
(setq pl
(vl-remove-if
'(lambda (a)
(/= 2 (length a))
)
(reverse
(mapcar '(lambda (x) (mapcar 'cadr (cdddr x)))
(ssnamex ss)
)
)
)
)
(FOREACH pts pl
(command "_break" e (apply 'mid pts) "@")
)
)
)
(command "_zoom" "_p")
)
)
(setvar 'cmdecho cmdecho)
(princ)
)

;;直线打断与圆内中点 By Gu_xl 2013.11.24 
(defun c:tt (/ *error* mid e el pl p0 p1) 
  (defun *error* (s) 
    (setvar 'cmdecho cmdecho) 
    (princ s) 
    ) 
  (defun mid (p1 p2) 
    (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)) 
    ) 
  (setq cmdecho (getvar 'cmdecho)) 
  (setvar 'cmdecho 0) 
   
  (while (and (setq e (car (entsel "\n选择直线:"))) 
           (= "LINE" (cdr (assoc 0 (setq el (entget e))))) 
           ) 
    (progn 
      (command "_zoom" "o" e "") 
      (setq p0 (trans (cdr (assoc 10 el)) 0 1) 
            p1 (trans (cdr (assoc 11 el)) 0 1) 
            ) 
      (setq ss (ssget "F" (list p0 p1) '((0 . "circle")))) 
      (if ss 
        (progn 
          (setq        pl 
                 (vl-remove-if 
                   '(lambda (a) 
                      (/= 2 (length a)) 
                    ) 
                   (reverse 
                     (mapcar '(lambda (x) (mapcar 'cadr (cdddr x))) 
                             (ssnamex ss) 
                     ) 
                   ) 
                 ) 
          ) 
          (FOREACH pts pl 
            (command "_break" e  (apply 'mid pts) "@") 
            ) 
        ) 
      ) 
      (command "_zoom" "_p") 
      ) 
    ) 
  (setvar 'cmdecho cmdecho) 
  (princ) 
  )

xskfq · 发表于 2013-11-25 11:26:45

谢谢版主，

，十分感谢！！

xskfq · 发表于 2013-11-25 12:48:33

版主能再帮忙给看看不：
这个能改成框选吗
还有，直线是水平时，圆心落在直线上，就断不开了，为什么，，，
速度好像有点慢，entmake能快点不

Gu_xl · 发表于 2013-11-25 14:08:01

xskfq 发表于 2013-11-25 12:48
版主能再帮忙给看看不：
这个能改成框选吗
还有，直线是水平时，圆心落在直线上，就断不开了，为什么，， ...

;;直线打断与圆内中点 By Gu_xl 2013.11.24
(defun c:tt (/ *error* mid e el pl p0 p1 dup n s0)
(defun *error* (s) (setvar 'cmdecho cmdecho) (princ s))
(defun mid (p1 p2)
(mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2))
)
(defun dup (pts)
(if pts
(if (equal (car pts) (cadr pts) 1e-3)
(dup (cdr pts))
(cons (car pts) (dup (cdr pts)))
)
)
)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(princ "\n选择直线:")
(while (setq s0 (ssget '((0 . "line"))))
(repeat (setq n (sslength s0))
(setq e (ssname s0 (setq n (1- n)))
el (entget e)
)
(command "_zoom" "o" e "")
(setq p0 (trans (cdr (assoc 10 el)) 0 1)
p1 (trans (cdr (assoc 11 el)) 0 1)
)
(setq ss (ssget "F" (list p0 p1) '((0 . "circle"))))
(if ss
(progn (setq pl
(vl-remove-if
'(lambda (a) (/= 2 (length a)))
(reverse
(mapcar '(lambda (x) (dup (mapcar 'cadr (cdddr x))))
(ssnamex ss)
)
)
)
)
(FOREACH pts pl
(vl-cmdf "_break"
(list e (setq p (apply 'mid pts)))
"f"
"_non"
p
"_non"
p
)
)
)
)
(command "_zoom" "_p")
)
)
(setvar 'cmdecho cmdecho)
(princ)
)

;;直线打断与圆内中点 By Gu_xl 2013.11.24 
(defun c:tt (/ *error* mid e el pl p0 p1 dup n s0) 
  (defun *error* (s) (setvar 'cmdecho cmdecho) (princ s)) 
  (defun mid (p1 p2) 
    (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)) 
  ) 
  (defun dup (pts) 
    (if        pts 
      (if (equal (car pts) (cadr pts) 1e-3) 
        (dup (cdr pts)) 
        (cons (car pts) (dup (cdr pts))) 
      ) 
    ) 
  ) 
  (setq cmdecho (getvar 'cmdecho)) 
  (setvar 'cmdecho 0) 
  (princ "\n选择直线:") 
  (while (setq s0 (ssget '((0 . "line")))) 
    (repeat (setq n (sslength s0)) 
      (setq e  (ssname s0 (setq n (1- n))) 
            el (entget e) 
      ) 
      (command "_zoom" "o" e "") 
      (setq p0 (trans (cdr (assoc 10 el)) 0 1) 
            p1 (trans (cdr (assoc 11 el)) 0 1) 
      ) 
      (setq ss (ssget "F" (list p0 p1) '((0 . "circle")))) 
      (if ss 
        (progn (setq pl 
                      (vl-remove-if 
                        '(lambda (a) (/= 2 (length a))) 
                        (reverse 
                          (mapcar '(lambda (x) (dup (mapcar 'cadr (cdddr x)))) 
                                  (ssnamex ss) 
                          ) 
                        ) 
                      ) 
               ) 
               (FOREACH        pts pl 
                 (vl-cmdf "_break" 
                          (list e (setq p (apply 'mid pts))) 
                          "f" 
                          "_non" 
                          p 
                          "_non" 
                          p 
                 ) 
               ) 
        ) 
      ) 
      (command "_zoom" "_p") 
    ) 
  ) 
  (setvar 'cmdecho cmdecho) 
  (princ) 
)

flyfox1047 · 发表于 2013-11-25 22:18:00

Gu_xl 发表于 2013-11-25 14:08

G版，好像不行了，CAD2007测试

账号		自动登录	找回密码
密码			注册

[已解答] 如何让圆内直线从中点断开

本帖子中包含更多资源

本帖子中包含更多资源