求两个程序的合并（关于圆心处打断直线）
我的思路是分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)
)
掉线了。。
CAD2006测试通过批量打断
(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh center_lst)
(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 center_lst '())
(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)))
(setq center_lst (cons Center center_lst))
)
(if (/= center_lst '())(mapcar '(lambda(x)(vl-cmdf "_.break" xx )) center_lst))
)))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
(princ)
)
本帖最后由 llsheng_73 于 2014-1-23 11:07 编辑
(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))))
(entmod(subst(cons 10 Center)(assoc 10 point)point))
(entmake(list'(0 . "LINE")(assoc 67 point)(assoc 8 point)(assoc 6 point)(assoc 10 point)(cons 11 Center)))
)))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
(princ)
)
如果一条线上有多个圆它好象会出问题，不清楚你具体的情况是怎么样 本帖最后由 cable2004 于 2014-1-23 09:59 编辑
[*];; 圆心点打段线
(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 (cons10 Center) (assoc 10 ed) ed))
(command "break" (list LineObj Center) Center)
)
)
)
)
)
(princ)
)
cable2004 发表于 2014-1-23 09:49 static/image/common/back.gif
[*];; 圆心点打段线
(defun c:dd ( / box box1 box2 center ed i j lineobj pc s1 ss ss1)(vl-load-com) ...
新程序啊，能实现，谢谢！！。
不过我想要原程序合并。。 不好合并吗？
不知道什么是合并！总之是合并2个功能！ cable2004 发表于 2014-1-23 11:52 static/image/common/back.gif
不知道什么是合并！总之是合并2个功能！
速度没有原版快 (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 "break" (list (vlax-vla-object->ename LineObj) Center) Center)
))))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
(princ)
) entmake打断版本
比break命令要要些。
(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))))
(entmod(subst(cons 10 Center)(assoc 10 point)point))
(entmake (subst(cons 11 Center)(assoc 11 point)point))
(entmake (subst(cons 10 Center)(assoc 10 point)point))
)))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
(princ)
)