求两个程序的合并（关于圆心处打断直线）

xskfq

我的思路是分2步：（参见图片）
第一步：把圆心挪到直线上，程序“挪圆.lisp”
第二步：在圆心处打断直线，程序“圆心打断.lisp”
如何把这2个程序合并为一个程序？
-------------------------------------------------
挪圆.lisp;

(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)
  (vl-load-com)
  (setvar "cmdecho" 0)
  (princ "\n请选取要处理的直线对象")
  (if(setq ssLine (ssget '((0 . "LINE"))))
    (progn (setq syh 0)
      (vl-cmdf ".zoom" "e")
      (repeat (sslength ssLine)
(entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
       point(entget LineObj)
       LineObj(vlax-ename->vla-object LineObj)
       Point_01(cdr(assoc 10 point))
       Point_01(list(car Point_01)(cadr Point_01)0)
       Point_02(cdr(assoc 11 point))
       Point_02(list(car Point_02)(cadr Point_02)0)
       point(subst(cons 10 Point_01)(assoc 10 point)point)
       point(subst(cons 11 Point_02)(assoc 11 point)point)))
(if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
   (progn (setq index 0)
     (repeat (sslength ssCircle)
       (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
      radius(cdr(assoc 40 Circle))
      Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
      center(if(<(distance Point_01 Center)radius)Point_01
       (if(<(distance Point_02 Center)radius)Point_02 Center))
      circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))))))
    (vl-cmdf ".zoom" "p")
    (alert "完成！")
    ))
  (princ)
  )

-----------------------------------------------------------------------
圆心打断.lisp

;; 圆心点打段线
(defun c:dd ()
  (if (and (princ "\n选择圆: ")
           (setq ss (ssget '((0 . "circle")))
                 i  -1
           )
      )
    (while (setq s1 (ssname ss (setq i (1+ i))))
      (setq pc (cdr (assoc 10 (entget s1)))
            j  -1
      )
      (if (setq ss1 (ssget "c" pc pc '((0 . "*line"))))
        (while (setq s2 (ssname ss1 (setq j (1+ j))))
          (command "break" (list s2 pc) pc)
        )
      )
    )
  )
  (princ)
)

edata

掉线了。。
CAD2006测试通过批量打断

1. (defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh center_lst)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n请选取要处理的直线对象")
   
5.   (if(setq ssLine (ssget '((0 . "LINE"))))
   
6.     (progn (setq syh 0)
   
7.       (vl-cmdf ".zoom" "e")
   
8.       (repeat (sslength ssLine)
   
9. (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
   
10.        point(entget LineObj)
    
11.        LineObj(vlax-ename->vla-object LineObj)
    
12.        Point_01(cdr(assoc 10 point))
    
13.        Point_01(list(car Point_01)(cadr Point_01)0)
    
14.        Point_02(cdr(assoc 11 point))
    
15.        Point_02(list(car Point_02)(cadr Point_02)0)
    
16.        point(subst(cons 10 Point_01)(assoc 10 point)point)
    
17.        point(subst(cons 11 Point_02)(assoc 11 point)point)))
    
18. (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
    
19.    (progn (setq index 0 center_lst '())
    
20.      (repeat (sslength ssCircle)
    
21.        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
    
22.       radius(cdr(assoc 40 Circle))
    
23.       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
    
24.       center(if(<(distance Point_01 Center)radius)Point_01
    
25.        (if(<(distance Point_02 Center)radius)Point_02 Center))
    
26.       circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))
    
27.        (setq center_lst (cons Center center_lst))      
    
28.        )     
    
29.      (if (/= center_lst '())(mapcar '(lambda(x)(vl-cmdf "_.break" x  x )) center_lst))     
    
30.      )))
    
31.     (vl-cmdf ".zoom" "p")
    
32.     (alert "完成！")
    
33.     ))
    
34.   (princ)
    
35.   )

(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh center_lst)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请选取要处理的直线对象")<br />   (if(setq ssLine (ssget '((0 . "LINE"))))<br />     (progn (setq syh 0)<br />       (vl-cmdf ".zoom" "e")<br />       (repeat (sslength ssLine)<br /> (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)<br />        point(entget LineObj)<br />        LineObj(vlax-ename->vla-object LineObj)<br />        Point_01(cdr(assoc 10 point))<br />        Point_01(list(car Point_01)(cadr Point_01)0)<br />        Point_02(cdr(assoc 11 point))<br />        Point_02(list(car Point_02)(cadr Point_02)0)<br />        point(subst(cons 10 Point_01)(assoc 10 point)point)<br />        point(subst(cons 11 Point_02)(assoc 11 point)point)))<br /> (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))<br />    (progn (setq index 0 center_lst '())<br />      (repeat (sslength ssCircle)<br />        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)<br />       radius(cdr(assoc 40 Circle))<br />       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)<br />       center(if(<(distance Point_01 Center)radius)Point_01<br />        (if(<(distance Point_02 Center)radius)Point_02 Center))<br />       circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))<br />        (setq center_lst (cons Center center_lst))       <br />        )     <br />      (if (/= center_lst '())(mapcar '(lambda(x)(vl-cmdf "_.break" x  x )) center_lst))     <br />      )))<br />     (vl-cmdf ".zoom" "p")<br />     (alert "完成！")<br />     ))<br />   (princ)<br />   )

llsheng_73

1.   (defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n请选取要处理的直线对象")
   
5.   (if(setq ssLine (ssget '((0 . "LINE"))))
   
6.     (progn (setq syh 0)
   
7.       (vl-cmdf ".zoom" "e")
   
8.       (repeat (sslength ssLine)
   
9. (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
   
10.        point(entget LineObj)
    
11.        LineObj(vlax-ename->vla-object LineObj)
    
12.        Point_01(cdr(assoc 10 point))
    
13.        Point_01(list(car Point_01)(cadr Point_01)0)
    
14.        Point_02(cdr(assoc 11 point))
    
15.        Point_02(list(car Point_02)(cadr Point_02)0)
    
16.        point(subst(cons 10 Point_01)(assoc 10 point)point)
    
17.        point(subst(cons 11 Point_02)(assoc 11 point)point)))
    
18. (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
    
19.    (progn (setq index 0)
    
20.      (repeat (sslength ssCircle)
    
21.        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
    
22.       radius(cdr(assoc 40 Circle))
    
23.       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
    
24.       center(if(<(distance Point_01 Center)radius)Point_01
    
25.        (if(<(distance Point_02 Center)radius)Point_02 Center))
    
26.       circle(subst(cons 10 Center)(assoc 10 Circle)Circle))))
    
27.      (entmod(subst(cons 10 Center)(assoc 10 point)point))
    
28.      (entmake(list'(0 . "LINE")(assoc 67 point)(assoc 8 point)(assoc 6 point)(assoc 10 point)(cons 11 Center)))
    
29.      )))
    
30.     (vl-cmdf ".zoom" "p")
    
31.     (alert "完成！")
    
32.     ))
    
33.   (princ)
    
34.   )  

  (defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请选取要处理的直线对象")<br />   (if(setq ssLine (ssget '((0 . "LINE"))))<br />     (progn (setq syh 0)<br />       (vl-cmdf ".zoom" "e")<br />       (repeat (sslength ssLine)<br /> (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)<br />        point(entget LineObj)<br />        LineObj(vlax-ename->vla-object LineObj)<br />        Point_01(cdr(assoc 10 point))<br />        Point_01(list(car Point_01)(cadr Point_01)0)<br />        Point_02(cdr(assoc 11 point))<br />        Point_02(list(car Point_02)(cadr Point_02)0)<br />        point(subst(cons 10 Point_01)(assoc 10 point)point)<br />        point(subst(cons 11 Point_02)(assoc 11 point)point)))<br /> (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))<br />    (progn (setq index 0)<br />      (repeat (sslength ssCircle)<br />        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)<br />       radius(cdr(assoc 40 Circle))<br />       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)<br />       center(if(<(distance Point_01 Center)radius)Point_01<br />        (if(<(distance Point_02 Center)radius)Point_02 Center))<br />       circle(subst(cons 10 Center)(assoc 10 Circle)Circle))))<br />      (entmod(subst(cons 10 Center)(assoc 10 point)point))<br />      (entmake(list'(0 . "LINE")(assoc 67 point)(assoc 8 point)(assoc 6 point)(assoc 10 point)(cons 11 Center)))<br />      )))<br />     (vl-cmdf ".zoom" "p")<br />     (alert "完成！")<br />     ))<br />   (princ)<br />   )  

如果一条线上有多个圆它好象会出问题，不清楚你具体的情况是怎么样

cable2004

• ;; 圆心点打段线
  (defun c:dd ( / box box1 box2 center ed i j lineobj pc s1 ss ss1)(vl-load-com)
    (defun MTL-objBox (obj / Minp Maxp)
           (vla-GetBoundingBox obj 'Minp 'Maxp)
           (mapcar 'vlax-safearray->list (list Minp Maxp))
  )
    (if (and (princ "\n选择圆: ")
             (setq ss (ssget '((0 . "circle")))
                   i  -1
             )
        )
      (while (setq s1 (ssname ss (setq i (1+ i))))
             (setq box (MTL-objBox (vlax-ename->vla-object s1))
                   box1 (car box)
                   box2 (cadr box)
                   ed (entget s1)
                   pc (cdr (assoc 10 ed))
                    j  -1
                )
        (if (setq ss1 (ssget "c" box1 box2 '((0 . "*line"))))
          (progn (while (setq LineObj (ssname ss1 (setq j (1+ j))))
                        (setq Center (vlax-curve-getClosestPointTo LineObj pc t))
                        (entmod (subst (cons  10 Center) (assoc 10 ed) ed))
                        (command "break" (list LineObj Center) Center)
            )
          )
        )
      )
    )
    (princ)
  )
  

xskfq

cable2004 发表于 2014-1-23 09:49

;; 圆心点打段线
(defun c:dd ( / box box1 box2 center ed i j lineobj pc s1 ss ss1)(vl-load-com) ...

新程序啊，能实现，谢谢！！。
不过我想要原程序合并。。

xskfq

不好合并吗？

cable2004

不知道什么是合并！总之是合并2个功能！

xskfq

cable2004 发表于 2014-1-23 11:52
不知道什么是合并！总之是合并2个功能！

速度没有原版快

edata

1. (defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n请选取要处理的直线对象")
   
5.   (if(setq ssLine (ssget '((0 . "LINE"))))
   
6.     (progn (setq syh 0)
   
7.       (vl-cmdf ".zoom" "e")
   
8.       (repeat (sslength ssLine)
   
9. (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
   
10.        point(entget LineObj)
    
11.        LineObj(vlax-ename->vla-object LineObj)
    
12.        Point_01(cdr(assoc 10 point))
    
13.        Point_01(list(car Point_01)(cadr Point_01)0)
    
14.        Point_02(cdr(assoc 11 point))
    
15.        Point_02(list(car Point_02)(cadr Point_02)0)
    
16.        point(subst(cons 10 Point_01)(assoc 10 point)point)
    
17.        point(subst(cons 11 Point_02)(assoc 11 point)point)))
    
18. (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
    
19.    (progn (setq index 0)
    
20.      (repeat (sslength ssCircle)
    
21.        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
    
22.       radius(cdr(assoc 40 Circle))
    
23.       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
    
24.       center(if(<(distance Point_01 Center)radius)Point_01
    
25.        (if(<(distance Point_02 Center)radius)Point_02 Center))
    
26.       circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))
    
27.        (vl-cmdf "break" (list (vlax-vla-object->ename LineObj) Center) Center)
    
28.        ))))
    
29.     (vl-cmdf ".zoom" "p")
    
30.     (alert "完成！")
    
31.     ))
    
32.   (princ)
    
33.   )

(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请选取要处理的直线对象")<br />   (if(setq ssLine (ssget '((0 . "LINE"))))<br />     (progn (setq syh 0)<br />       (vl-cmdf ".zoom" "e")<br />       (repeat (sslength ssLine)<br /> (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)<br />        point(entget LineObj)<br />        LineObj(vlax-ename->vla-object LineObj)<br />        Point_01(cdr(assoc 10 point))<br />        Point_01(list(car Point_01)(cadr Point_01)0)<br />        Point_02(cdr(assoc 11 point))<br />        Point_02(list(car Point_02)(cadr Point_02)0)<br />        point(subst(cons 10 Point_01)(assoc 10 point)point)<br />        point(subst(cons 11 Point_02)(assoc 11 point)point)))<br /> (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))<br />    (progn (setq index 0)<br />      (repeat (sslength ssCircle)<br />        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)<br />       radius(cdr(assoc 40 Circle))<br />       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)<br />       center(if(<(distance Point_01 Center)radius)Point_01<br />        (if(<(distance Point_02 Center)radius)Point_02 Center))<br />       circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))<br />        (vl-cmdf "break" (list (vlax-vla-object->ename LineObj) Center) Center)<br />        ))))<br />     (vl-cmdf ".zoom" "p")<br />     (alert "完成！")<br />     ))<br />   (princ)<br />   )

edata

entmake打断版本
比break命令要要些。

1. (defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)
   
2.   (vl-load-com)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n请选取要处理的直线对象")
   
5.   (if(setq ssLine (ssget '((0 . "LINE"))))
   
6.     (progn (setq syh 0)
   
7.       (vl-cmdf ".zoom" "e")
   
8.       (repeat (sslength ssLine)
   
9. (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
   
10.        point(entget LineObj)
    
11.        LineObj(vlax-ename->vla-object LineObj)
    
12.        Point_01(cdr(assoc 10 point))
    
13.        Point_01(list(car Point_01)(cadr Point_01)0)
    
14.        Point_02(cdr(assoc 11 point))
    
15.        Point_02(list(car Point_02)(cadr Point_02)0)
    
16.        point(subst(cons 10 Point_01)(assoc 10 point)point)
    
17.        point(subst(cons 11 Point_02)(assoc 11 point)point)))
    
18. (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
    
19.    (progn (setq index 0)
    
20.      (repeat (sslength ssCircle)
    
21.        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
    
22.       radius(cdr(assoc 40 Circle))
    
23.       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
    
24.       center(if(<(distance Point_01 Center)radius)Point_01
    
25.        (if(<(distance Point_02 Center)radius)Point_02 Center))
    
26.       circle(subst(cons 10 Center)(assoc 10 Circle)Circle))))
    
27.      (entmod(subst(cons 10 Center)(assoc 10 point)point))
    
28.      (entmake (subst(cons 11 Center)(assoc 11 point)point))
    
29.      (entmake (subst(cons 10 Center)(assoc 10 point)point))
    
30.      )))
    
31.     (vl-cmdf ".zoom" "p")
    
32.     (alert "完成！")
    
33.     ))
    
34.   (princ)
    
35.   )  

(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请选取要处理的直线对象")<br />   (if(setq ssLine (ssget '((0 . "LINE"))))<br />     (progn (setq syh 0)<br />       (vl-cmdf ".zoom" "e")<br />       (repeat (sslength ssLine)<br /> (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)<br />        point(entget LineObj)<br />        LineObj(vlax-ename->vla-object LineObj)<br />        Point_01(cdr(assoc 10 point))<br />        Point_01(list(car Point_01)(cadr Point_01)0)<br />        Point_02(cdr(assoc 11 point))<br />        Point_02(list(car Point_02)(cadr Point_02)0)<br />        point(subst(cons 10 Point_01)(assoc 10 point)point)<br />        point(subst(cons 11 Point_02)(assoc 11 point)point)))<br /> (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))<br />    (progn (setq index 0)<br />      (repeat (sslength ssCircle)<br />        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)<br />       radius(cdr(assoc 40 Circle))<br />       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)<br />       center(if(<(distance Point_01 Center)radius)Point_01<br />        (if(<(distance Point_02 Center)radius)Point_02 Center))<br />       circle(subst(cons 10 Center)(assoc 10 Circle)Circle))))<br />      (entmod(subst(cons 10 Center)(assoc 10 point)point))<br />      (entmake (subst(cons 11 Center)(assoc 11 point)point))<br />      (entmake (subst(cons 10 Center)(assoc 10 point)point))<br />      )))<br />     (vl-cmdf ".zoom" "p")<br />     (alert "完成！")<br />     ))<br />   (princ)<br />   )