明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2233|回复: 9

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

[复制链接]
发表于 2014-2-3 19:41:49 | 显示全部楼层 |阅读模式
3明经币
(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)
  )


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

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

最佳答案

查看完整内容

(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" sslin ...
发表于 2014-2-3 19:41:50 | 显示全部楼层
本帖最后由 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 "完成!")
    )
)
回复

使用道具 举报

 楼主| 发表于 2014-2-3 22:08:07 | 显示全部楼层
我有一个思路:根据第一次框选择,得到最大包围框(盒)boundingBox,做为第二次框选范围,不可以吗?不知道具体怎么写、、
回复

使用道具 举报

发表于 2014-2-3 23:19:49 | 显示全部楼层
1. 選線後,依條件分二條路走就可以了
也可以
2. 程序中未被刪除的線形成一個選集
也可以
3. 變成二個副程序,在一個程序中分別調用
回复

使用道具 举报

发表于 2014-2-4 01:22:11 | 显示全部楼层


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2014-2-4 12:02:55 | 显示全部楼层
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 个
选择对象:
; 错误: 参数太多”
我开始也这个写的, 错在哪呢??
回复

使用道具 举报

 楼主| 发表于 2014-2-4 13:10:34 | 显示全部楼层
广义来说就是:如何在主程序执行前 过滤删除超短线
回复

使用道具 举报

 楼主| 发表于 2014-2-4 13:24:02 | 显示全部楼层
我帖一下俩个源程序

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

(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)
  )
回复

使用道具 举报

发表于 2014-2-4 13:28:22 | 显示全部楼层
  1. (defun c:cx ( / center circle en ent i index l lineobj point point_01 point_02 radius ss1 sscircle ssline syh x)
  2. (if (setq ssline (ssget '((0 . "line"))))
  3. (progn
  4. (setq ss1 nil
  5. i -1
  6. ss1 (ssadd)
  7. )
  8. (repeat (sslength ssline)
  9.    (setq ent (entget (setq en (ssname ssline (setq i (1+ i))))))
  10.    (if (< (distance (cdr(assoc 10 ent)) (cdr(assoc 11 ent))) 50)
  11.     (ssadd en ss1)
  12.    )
  13.   )
  14.   (command "select" ssline "r" ss1 "")
  15.   (setq ssline (ssget "p"))
  16.   (command "erase" ss1 "")
  17.   (progn (setq syh 0)
  18.       (vl-cmdf ".zoom" "e")
  19.       (repeat (sslength ssLine)
  20. (entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
  21.        point(entget LineObj)
  22.        LineObj(vlax-ename->vla-object LineObj)
  23.        Point_01(cdr(assoc 10 point))
  24.        Point_01(list(car Point_01)(cadr Point_01)0)
  25.        Point_02(cdr(assoc 11 point))
  26.        Point_02(list(car Point_02)(cadr Point_02)0)
  27.        point(subst(cons 10 Point_01)(assoc 10 point)point)
  28.        point(subst(cons 11 Point_02)(assoc 11 point)point)))
  29. (if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
  30.    (progn (setq index 0)
  31.      (repeat (sslength ssCircle)
  32.        (entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
  33.       radius(cdr(assoc 40 Circle))
  34.       Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
  35.       center(if(<(distance Point_01 Center)radius)Point_01
  36.        (if(<(distance Point_02 Center)radius)Point_02 Center))
  37.       circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))
  38.       )
  39.       (setq l nil)
  40.       (repeat (setq i (sslength ssCircle))
  41.             (setq l (cons (cdr (assoc 10 (entget (ssname ssCircle (setq i (1- i)))))) l))
  42.         )
  43.         (mapcar '(lambda(x) (vl-cmdf "break" (list (ssname (ssget "c" x x '((0 . "*line"))) 0) x) x)) l)
  44.       )))
  45.     (vl-cmdf ".zoom" "p")
  46.     (alert "完成!")
  47.     )
  48. )
  49. )
  50. )
回复

使用道具 举报

发表于 2014-2-28 20:16:08 | 显示全部楼层
xyp1964 发表于 2014-2-4 01:22

这个有意思!一箭双雕!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-23 21:37 , Processed in 0.216238 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表