明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3993|回复: 11

一次框选把内部四个交点连线剪掉

[复制链接]
发表于 2014-5-28 09:48:11 | 显示全部楼层 |阅读模式
大家好,如何实现一次框选把内部四个交点连线剪掉


本帖子中包含更多资源

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

x
发表于 2014-5-28 10:41:08 | 显示全部楼层
(defun C:T4( / index index1 ss p0 ss1 entn ent ty l_p1 l_p2 p1 p2 p3 p4 ang1 ang2
                  ang3 dist1 dist2 )

(defun inivar(); 四条直线快速修剪
    (setq osm (getvar "osmode"))
    (setq cly (getvar "clayer"))
  )
  (defun resvar()
    (setvar "osmode" osm)
    (setvar "clayer" cly)
  )

(inivar) ;初始化系统变量
(setvar "blipmode" 1)
(setq index 1
       ss (ssadd) ;构件一个空选择集
) ;setq end
(setvar "osmode" 512) ;设定捕捉模式为Nearest
(setq ss (ssget '((0 . "LINE"))))
(while (/= (sslength ss) 4)
  (progn
    (print "未选到四条直线,请重新选择")
    (setq ss (ssget '((0 . "LINE"))))
  )
)

(setvar "osmode" 0)
(setvar "blipmode" 0)
(setq index 0
       l_p1 '()
       l_p2 '()
  ) ;setq end
(repeat 4 ;获取每一根线的起点、终点
  (setq ent (entget (ssname ss index))
        index (+ 1 index)
        p1 (cdr (assoc 10 ent))
        p2 (cdr (assoc 11 ent))
        l_p1 (cons p1 l_p1)
        l_p2 (cons p2 l_p2)
        ) ;setq end
) ;repeat end
(setq index 0 n 4
       l_int '()
)
(repeat (1- n) ;计算交点
        (setq p1  (nth index l_p1)
              p2  (nth index l_p2)
              index1 (1+ index)
              index (1+ index)
        ) ;setq end
        (repeat (- n index)
         (setq p3 (nth index1 l_p1)
               p4 (nth index1 l_p2)
               index1 (1+ index1)
               pt (inters p1 p2 p3 p4) ;求交点
               l_int (if pt (cons pt l_int) l_int)
         ) ;setq end
        )  ;repeat end
) ;repeat end
(setq index 0
       la (cdr (assoc 8 ent))
) ;setq end
(repeat n ;删除原直线
  (setq entn (ssname ss index)
        index (1+ index)
  ) ;setq end
  (entdel entn)
) ;repeat end
(setq index 0)
(command "layer" "s" la "")
(repeat (1- n) ;重新画线
    (setq p3 (nth index l_int)
          index2 (1+ index)
          index (1+ index)
    ) ;setq end
    (repeat (- n index)
        (setq index1 0
              p4 (nth index2 l_int)
              index2 (1+ index2)
        ) ;setq end
        (repeat n
         (setq p1  (nth index1 l_p1)
               p2  (nth index1 l_p2)
               index1 (1+ index1)
         ) ;setq end
         (setq ang1 (angtos (angle p1 p2) 0 1)
               ang2 (angtos (angle p1 p3) 0 1)
               ang3 (angtos (angle p1 p4) 0 1)
         ) ;setq end
         (if (= ang1 ang2 ang3)
             (progn
                 (setq dist1 (distance p1 p3)
                       dist2 (distance p1 p4)
                ) ;set end
                (if (< dist1 dist2)
                  (progn
                   (command "line" p1 p3 "")
                   (command "line" p4 p2 "")
                  ) ;progn end
                  (progn
                   (command "line" p1 p4 "")
                   (command "line" p3 p2 "")
                  ) ;progn end
                ) ;if end
             ) ;progn end
         )  ;if end
        ) ;repeat end
    ) ;repeat end
) ;repeat end
(redraw)
(resvar) ;还原系统变量
(princ)
) ;defun end

点评

大神,这个很好用,请问可否优化一下,可以支持多段线呢,谢谢啦  发表于 2021-5-20 22:41
回复 支持 1 反对 0

使用道具 举报

发表于 2014-5-28 14:35:15 | 显示全部楼层
框内一点式
  1. (defun c:tt(/ ELAST1 ENT LST MP1 MP2 MP3 MP4 P0 P1 P2 P3 P4 P5 X Y)
  2.   (vl-load-com)
  3.   (defun sk_dxf(ent code)(cdr(assoc code (entget ent))))
  4.   (defun sk_m2p (p1 p2)(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2))
  5.   (if(setq p0(getpoint "\n在框内指定一点:"))
  6.     (progn
  7.       (setq elast1(entlast))
  8.       (command "-BOUNDARY" p0 "")
  9.       (setq ent(entlast))
  10.       (if(and (= (sk_dxf ent 0) "LWPOLYLINE")(/= (sk_dxf ent 5)(sk_dxf elast1 5)))
  11.         (progn          
  12.           (setq lst(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
  13.           (setq p1(car lst)
  14.                 p2(cadr lst)
  15.                 p3(caddr lst)
  16.                 p4(cadddr lst)
  17.                 mp1(sk_m2p p1 p2)
  18.                 mp2(sk_m2p p2 p3)
  19.                 mp3(sk_m2p p3 p4)
  20.                 mp4(sk_m2p p4 p1)
  21.                 )
  22.           (princ (list mp1 mp2 mp3 mp4))
  23.           (entdel ent)
  24.           (command "trim" "" "c" mp1  mp3 "" )
  25.           (command "trim" "" "c" mp2  mp4 "" )
  26.           )
  27.         )
  28.       )
  29.     )
  30.   (princ)
  31.   )

点评

大师的这个很简洁。good.。  发表于 2014-5-28 19:19
 楼主| 发表于 2014-5-29 15:26:54 | 显示全部楼层
434939575 发表于 2014-5-28 10:41
(defun C:T4( / index index1 ss p0 ss1 entn ent ty l_p1 l_p2 p1 p2 p3 p4 ang1 ang2
                 ...

很厉害,框选能剪出效果,请问能实现多处框选吗,比如第一个位置剪完了,再继续去剪其他位置吗
 楼主| 发表于 2014-5-29 15:33:37 | 显示全部楼层
edata 发表于 2014-5-28 14:35
框内一点式

不用选。直接点击框内就可以达到理想效果,可否连续进行多次呢,这样不用弄一次敲一下回车了假如数量很大的话
发表于 2014-5-29 15:49:45 | 显示全部楼层
尽量修剪直线,多段线有时候不是很正确。
  1. (defun c:tt(/ ELAST1 ENT LST MP1 MP2 MP3 MP4 P0 P1 P2 P3 P4 P5 X Y)
  2.   (vl-load-com)
  3.   (setq cmd_e(getvar 'cmdecho))
  4.   (setvar 'cmdecho 0)
  5.   (defun sk_dxf(ent code)(cdr(assoc code (entget ent))))
  6.   (defun sk_m2p (p1 p2)(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2))
  7.   (while(setq p0(getpoint "\n在框内指定一点:"))
  8.     (progn
  9.       (setq elast1(entlast))
  10.       (command "-BOUNDARY" p0 "")
  11.       (setq ent(entlast))
  12.       (if(and (= (sk_dxf ent 0) "LWPOLYLINE")(/= (sk_dxf ent 5)(sk_dxf elast1 5)))
  13.         (progn         
  14.           (setq lst(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
  15.           (setq p1(car lst)
  16.                 p2(cadr lst)
  17.                 p3(caddr lst)
  18.                 p4(cadddr lst)
  19.                 mp1(sk_m2p p1 p2)
  20.                 mp2(sk_m2p p2 p3)
  21.                 mp3(sk_m2p p3 p4)
  22.                 mp4(sk_m2p p4 p1)
  23.                 )         
  24.           (entdel ent)
  25.           (command "trim" "" "c" mp1  mp3 "" )
  26.           (command "trim" "" "c" mp2  mp4 "" )
  27.           )
  28.         )
  29.       )
  30.     )
  31.   (and cmd_e(setq cmd_e(getvar 'cmdecho)))
  32.   (princ)
  33.   )
发表于 2014-11-7 14:14:46 | 显示全部楼层
向楼主学习!初研CAD开发!
发表于 2014-12-16 09:12:44 | 显示全部楼层
高手如云啊.请收下我的膝盖
发表于 2020-3-7 11:07:50 | 显示全部楼层
学习了学习了
发表于 2022-11-11 19:42:56 | 显示全部楼层
学习了,基础知识
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-23 02:13 , Processed in 0.230138 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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