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

rose1 · 发表于 2013-11-24 20:41:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

批量打断圆内直线，打断点为园内直线的中点，如图
听说这里高手比较多，谁能帮解决下，衷心感谢！

st788796 · 发表于 2013-11-24 21:55:28

给你个思路，用API没有几句话

(defun c:tt (/ lss box)
(if (and (setq lss (ssget '((0 . "line")))) ;_直线选择集
(setq box (xdrx_entity_box lss))
(progn
(if (apply 'xdrx_document_isptoutscreen box) ;_不能在屏幕外
(xdrx_document_zoomw (car box) (nth 2 box))
)
t
)
)
(mapcar
'(lambda (x / sp ep ss pts)
(setq sp (xdrx_curve_getstartpoint x)
ep (xdrx_curve_getendpoint x)
)
(if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集
(progn
(setq
pts (vl-remove-if
'(lambda (l) (= (length l) 1))
(mapcar '(lambda (a) (mapcar 'cadr (cdddr a)))
(ssnamex ss)
)
)
pts (mapcar '(lambda (a) (apply 'xdrx_line_midp a))
pts
)
)
(apply 'xdrx_curve_getsplitcurves
(cons x pts)
)
)
)
)
(xdrx_pickset->ents lss)
)
)
(princ)
)

(defun c:tt (/ lss box) 
  (if (and (setq lss (ssget '((0 . "line")))) ;_直线选择集 
           (setq box (xdrx_entity_box lss)) 
           (progn 
             (if (apply 'xdrx_document_isptoutscreen box) ;_不能在屏幕外 
               (xdrx_document_zoomw (car box) (nth 2 box)) 
             ) 
             t 
           ) 
      ) 
    (mapcar 
      '(lambda (x / sp ep ss pts) 
         (setq sp (xdrx_curve_getstartpoint x) 
               ep (xdrx_curve_getendpoint x) 
         ) 
         (if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集 
           (progn 
             (setq 
               pts (vl-remove-if 
                     '(lambda (l) (= (length l) 1)) 
                     (mapcar '(lambda (a) (mapcar 'cadr (cdddr a))) 
                             (ssnamex ss) 
                     ) 
                   ) 
               pts (mapcar '(lambda (a) (apply 'xdrx_line_midp a)) 
                           pts 
                   ) 
             ) 
             (apply 'xdrx_curve_getsplitcurves 
                    (cons x pts) 
             ) 
           ) 
         ) 
       ) 
      (xdrx_pickset->ents lss) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2013-11-24 22:47:10

其实Lisp也很简单

(defun c:tt (/ lss sl i e sp ep ss)
(if (setq lss (ssget '((0 . "line")))) ;_直线选择集
(progn
(setq sl (sslength lss)
i -1
)
(repeat sl
(setq e (ssname lss (setq i (1+ i)))
sp (vlax-curve-getstartpoint e)
ep (vlax-curve-getendpoint e)
)
(if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集
(progn
(setq
pts (vl-remove-if
'(lambda (l) (= (length l) 1))
(mapcar '(lambda (a) (mapcar 'cadr (cdddr a)))
(ssnamex ss)
)
)
pts (mapcar '(lambda (a)
(mapcar '*
'(0.5 0.5 0.5)
(apply 'mapcar (cons '+ a))
)
)
pts
)
)
(mapcar '(lambda (a /)
(vl-cmdf ".break" (list e a) "f" "_none" a "@")
;;(command-s ".break" e "F" "Non" a "@");_2012+
)
(reverse pts)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ lss sl i e sp ep ss) 
  (if (setq lss (ssget '((0 . "line")))) ;_直线选择集 
    (progn 
      (setq sl (sslength lss) 
            i  -1 
      ) 
      (repeat sl 
        (setq e         (ssname lss (setq i (1+ i))) 
              sp (vlax-curve-getstartpoint e) 
              ep (vlax-curve-getendpoint e) 
        ) 
        (if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集 
          (progn 
            (setq 
              pts (vl-remove-if 
                    '(lambda (l) (= (length l) 1)) 
                    (mapcar '(lambda (a) (mapcar 'cadr (cdddr a))) 
                            (ssnamex ss) 
                    ) 
                  ) 
              pts (mapcar '(lambda (a) 
                             (mapcar '* 
                                     '(0.5 0.5 0.5) 
                                     (apply 'mapcar (cons '+ a)) 
                             ) 
                           ) 
                          pts 
                  ) 
            ) 
            (mapcar '(lambda (a /) 
                       (vl-cmdf ".break" (list e a) "f" "_none" a "@") 
                       ;;(command-s ".break" e "F" "Non" a "@");_2012+ 
                     ) 
                    (reverse pts) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2013-11-24 23:12:35

st788796 发表于 2013-11-24 22:47
其实Lisp也很简单

API有思路了，对应的VL函数能换的一换就行了。

牢固 · 发表于 2013-11-25 11:28:32

st788796 发表于 2013-11-24 22:47
其实Lisp也很简单

程序中需注意先将SP和EP转换到UCS坐标系，否则在UCS坐标系下程序则不能正确运行！

rose1 · 发表于 2013-11-25 11:30:25

本帖最后由 rose1 于 2013-11-25 11:32 编辑

谢谢st788796，！！谢谢E大
{:soso_e100:}

rose1 · 发表于 2013-11-25 11:53:11

牢固发表于 2013-11-25 11:28
程序中需注意先将SP和EP转换到UCS坐标系，否则在UCS坐标系下程序则不能正确运行！

说的很对！{:soso_e142:}

rose1 · 发表于 2013-11-25 11:57:36

水平正好通过圆心时候没法断开
怎么解决一下？

st788796 · 发表于 2013-11-25 12:54:07

rose1 发表于 2013-11-25 11:57
水平正好通过圆心时候没法断开
怎么解决一下？

你用的是上面代码？

rose1 · 发表于 2013-11-25 13:05:01

st788796 发表于 2013-11-25 12:54
你用的是上面代码？

用的是第二个

st788796 · 发表于 2013-11-25 14:19:52

rose1 发表于 2013-11-25 13:05
用的是第二个

换一种方法

(defun c:tt (/ lss sl i e sp ep ss el)
(if (setq lss (ssget '((0 . "line")))) ;_直线选择集
(progn
(setq sl (sslength lss)
i -1
)
(repeat sl
(setq e (ssname lss (setq i (1+ i)))
sp (trans (vlax-curve-getstartpoint e) 0 1)
ep (trans (vlax-curve-getendpoint e) 0 1)
)
(if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集
(progn
(setq
pts (vl-remove-if
'(lambda (l) (= (length l) 1))
(mapcar '(lambda (a) (mapcar 'cadr (cdddr a)))
(ssnamex ss)
)
)
pts (mapcar '(lambda (a)
(mapcar '*
'(0.5 0.5 0.5)
(apply 'mapcar (cons '+ a))
)
)
pts
)
el (entget e)
el (subst (cons 11 (car pts))
(assoc 11 el)
el
)
)
(entmod el)
(mapcar '(lambda (a b /)
(setq el (subst (cons 10 a)
(assoc 10 el)
el
)
el (subst (cons 11 b)
(assoc 11 el)
el
)
)
(entmake el)
)
(cdr pts)
(cddr pts)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ lss sl i e sp ep ss el) 
  (if (setq lss (ssget '((0 . "line")))) ;_直线选择集 
    (progn 
      (setq sl (sslength lss) 
            i  -1 
      ) 
      (repeat sl 
        (setq e         (ssname lss (setq i (1+ i))) 
              sp (trans (vlax-curve-getstartpoint e) 0 1) 
              ep (trans (vlax-curve-getendpoint e) 0 1) 
        ) 
        (if (setq ss (ssget "F" (list sp ep) '((0 . "circle")))) ;_构造每个通过直线的圆选集 
          (progn 
            (setq 
              pts (vl-remove-if 
                    '(lambda (l) (= (length l) 1)) 
                    (mapcar '(lambda (a) (mapcar 'cadr (cdddr a))) 
                            (ssnamex ss) 
                    ) 
                  ) 
              pts (mapcar '(lambda (a) 
                             (mapcar '* 
                                     '(0.5 0.5 0.5) 
                                     (apply 'mapcar (cons '+ a)) 
                             ) 
                           ) 
                          pts 
                  ) 
              el  (entget e) 
              el  (subst (cons 11 (car pts)) 
                         (assoc 11 el) 
                         el 
                  ) 
            ) 
            (entmod el) 
            (mapcar '(lambda (a b /) 
                       (setq el        (subst (cons 10 a) 
                                       (assoc 10 el) 
                                       el 
                                ) 
                             el        (subst (cons 11 b) 
                                       (assoc 11 el) 
                                       el 
                                ) 
                       ) 
                       (entmake el) 
                     ) 
                    (cdr pts) 
                    (cddr pts) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

sicky111 · 发表于 2014-1-23 22:54:46

st788796 发表于 2013-11-25 14:19
换一种方法

有问题。

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

[求助] 如何让圆内直线从中点断开

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

评分

点评

点评

点评

点评

点评