求合并，2次框选变1次框选

xskfq · 发表于 2014-2-3 19:41

(defun c:nydd( / center circle i index l lineobj point point_01 point_02 radius sscircle ssline syh x)
 (vl-load-com)
(SETQ SS1 NIL)
(if (setq ssLine (ssget '((0 . "LINE")))) (progn
 (setq i -1 ss1 (ssadd))
 (repeat (sslength ssLine)
(setq ent (entget (setq en (ssname ssLine (setq i (1+ i))))))
(if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 5000)
(ssadd en ss1)
)
 )
)
)
(command "erase" ss1 "")
;)
 (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)))
 )
 (setq l nil)
 (repeat (setq i (sslength ssCircle))
 (setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l))
 )
 (mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l)
 )))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
 (princ)
 )

--------------------------------------
先祝大家新年愉快！

第一次框选命令效果是删除短线，第二次框选命令效果是调整圆心位置等，如何只框选一次实现，求高手指点，谢谢！！

q3_2006 · 发表于 2014-2-3 19:41

本帖最后由 q3_2006 于 2014-2-4 13:24 编辑

(defun c:cx ( / center circle en ent i index l lineobj point point_01 point_02 radius ss1 sscircle ssline syh x)
(setq ss1 nil
ssline (ssget '((0 . "line")))
i -1
ss1 (ssadd)
)
(repeat (sslength ssline)
(setq ent (entget (setq en (ssname ssline (setq i (1+ i))))))
(if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 50)
(ssadd en ss1)
)
 )
 (command "select" ssline "r" ss1 "")
 (setq ssline (ssget "p"))
 (command "erase" ss1 "")
 (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)))
 )
 (setq l nil)
 (repeat (setq i (sslength ssCircle))
 (setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l))
 )
 (mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l)
 )))
(vl-cmdf ".zoom" "p")
(alert "完成！")
)
)

xskfq · 发表于 2014-2-3 22:08

我有一个思路：根据第一次框选择，得到最大包围框（盒）boundingBox，做为第二次框选范围，不可以吗？不知道具体怎么写、、

lsjj · 发表于 2014-2-3 23:19

1. 選線後,依條件分二條路走就可以了
也可以
2. 程序中未被刪除的線形成一個選集
也可以
3. 變成二個副程序,在一個程序中分別調用

xyp1964 · 发表于 2014-2-4 01:22

xskfq · 发表于 2014-2-4 12:02

q3_2006 发表于 2014-2-4 06:21
(defun c:nydd( / center circle i index l lineobj point point_01 point_02 radius sscircle ssline syh ...

好像不行，错误提示“命令: NYDD
选择对象: 指定对角点: 找到 5 个
选择对象:
; 错误: 参数太多”
我开始也这个写的，错在哪呢？？

xskfq · 发表于 2014-2-4 13:10

广义来说就是：如何在主程序执行前过滤删除超短线

xskfq · 发表于 2014-2-4 13:24

我帖一下俩个源程序

-------------------------------

(defun c:cx ()
(SETQ SS1 NIL)
(if (setq ss (ssget '((0 . "LINE")))) (progn
 (setq i -1 ss1 (ssadd))
 (repeat (sslength ss)
(setq ent (entget (setq en (ssname ss (setq i (1+ i))))))
(if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 50)
(ssadd en ss1)
)
 )
))
(command "erase" ss1 "")
)

----------------------------------------------------------------------------------------------

(defun c:nydd( / center circle i index l lineobj point point_01 point_02 radius sscircle ssline syh x)
 (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)))
 )
 (setq l nil)
 (repeat (setq i (sslength ssCircle))
 (setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l))
 )
 (mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l)
 )))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
 (princ)
 )

q3_2006 · 发表于 2014-2-4 13:28

(defun c:cx ( / center circle en ent i index l lineobj point point_01 point_02 radius ss1 sscircle ssline syh x)
(if (setq ssline (ssget '((0 . "line"))))
(progn
(setq ss1 nil
i -1
ss1 (ssadd)
)
(repeat (sslength ssline)
(setq ent (entget (setq en (ssname ssline (setq i (1+ i))))))
(if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 50)
(ssadd en ss1)
)
)
(command "select" ssline "r" ss1 "")
(setq ssline (ssget "p"))
(command "erase" ss1 "")
(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)))
)
(setq l nil)
(repeat (setq i (sslength ssCircle))
(setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l))
)
(mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l)
)))
(vl-cmdf ".zoom" "p")
(alert "完成！")
)
)
)
)

(defun c:cx ( / center circle en ent i index l lineobj point point_01 point_02 radius ss1 sscircle ssline syh x) 
(if (setq ssline (ssget '((0 . "line")))) 
(progn 
(setq ss1 nil 
i -1 
ss1 (ssadd) 
) 
(repeat (sslength ssline) 
   (setq ent (entget (setq en (ssname ssline (setq i (1+ i)))))) 
   (if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 50) 
    (ssadd en ss1) 
   ) 
  ) 
  (command "select" ssline "r" ss1 "") 
  (setq ssline (ssget "p")) 
  (command "erase" ss1 "") 
  (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))) 
      ) 
      (setq l nil) 
      (repeat (setq i (sslength ssCircle)) 
            (setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l)) 
        ) 
        (mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l) 
      ))) 
    (vl-cmdf ".zoom" "p") 
    (alert "完成！") 
    ) 
) 
) 
)

434939575 · 发表于 2014-2-28 20:16

xyp1964 发表于 2014-2-4 01:22

这个有意思！一箭双雕！

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

[提问] 求合并，2次框选变1次框选

最佳答案

相关帖子

本帖子中包含更多资源