批量交点打断支持多段线 <转帖> - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第3页

qyming 发表于 2014-9-1 13:08:11

好家伙，这么多

布朗运动 发表于 2015-10-30 10:53:57

lilq_78 发表于 2014-2-19 15:46 static/image/common/back.gif
顶，但是矩形与矩形相交打断不行

对原程序243-266行代码进行了改进：
;;==========================================
;;Break many objects with a single object
;;==========================================
(defun c:breakwobjects (/ cmd ss1 ss2)
(defun ssredraw (ss mode / i num)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
   (redraw (ssname ss i) mode)
)
)
(command ".undo" "begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

;;get objects to break
(prompt "\nSelect object(s) to break & press enter: ")
(if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
      (not (ssredraw ss1 3))
      (not (prompt "\n***Select single object to break with:***"))
      (setq ss2 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
      (not (ssredraw ss1 4))
   )
(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
)

(setvar "CMDECHO" cmd)
(command ".undo" "end")
(princ)
)

;;==========================================
;;Break many objects with many object
;;==========================================
(defun c:BreakWith (/ cmd ss1 ss2)
(defun ssredraw (ss mode / i num)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
   (redraw (ssname ss i) mode)
)
)
(command ".undo" "begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq xuanz nil)
;;get objects to break
(prompt "\n选择要打断的直线或多线段，按回车确定: ")
(if (and(setq ss1
      (ssget
'((0
   .
   "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
   )
)
      )
   xuanz (ssget "P" '((0 . "LWPOLYLINE") (70 . 1)));取出选中的闭合多段线，一般为矩形或多边形命令创建
   flag1 (if (/= ss1 nil) T);判断选择集ss1是否非空
      )


(not (ssredraw ss1 3))
   (not
      (prompt
      "\n***选择作为打断线的直线或多线段，按回车确定:***"
      )
   )
   (setq
      ss2 (ssget
   '((0
      .
      "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
      )
   )
)
      ssd(ssredraw ss1 4);新增
      flag2 (if (/= ss2 nil) T);判断选择集ss2是否非空
   )
   ;(not (ssredraw ss1 4))把该语句放在上面的setq语句群里，避免ss2为nil时本句不被执行的意外情况
   )
(progn
   (if(/= xuanz nil)
(progn
   (setq snum -1)
   (repeat (SSLENGTH xuanz)
(setq a (entget (ssname xuanz (setq snum (+ 1 snum)))));取出xuanz中的每个闭合多线段
(setq num (cdr (assoc 90 a))) ;多线段顶点数量
(setq pnum (- (length a) (length (member (assoc 10 a) a))))
;pnum为多线段第一个顶点坐标子列表所在项数（组码10）

(setq qdlst (PARTLIST1 pnum (+ pnum 4) a))
;第一个端点列表
(setq tou (PartList1 0 (- (length a) 2) a))
;原列表去掉最后一个元素后的新列表
(setq zhong (append tou qdlst))
;新列表插入第一个端点坐标
(setq wei (nth (- (length a) 1) a))
;保存原列表最后一个元素
(setq a (append zhong (list wei)))
;加入原列表最后一个元素
(setq a (subst (cons 70 0) (assoc 70 a) a))
;将闭合多线段改为非闭合多线段
(setq a (subst (cons 90 (+ num 1)) (assoc 90 a) a))
;修改多线段顶点个数
(entmod a)
   )
   )
)
(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
   )
)

(setvar "CMDECHO" cmd)
(command ".undo" "end")
(princ)
)

其中用到了黄老师提供的函数：
;截取部分列表子函数
(defun PartList1 (from to lst / I L)
(setq i -1)
(foreach x lst
(setq i (1+ i))
(cond ((and (>= i from) (<= i to)) (setq l (cons x l))))
)
(REVERSE l)
)

布朗运动 发表于 2015-10-30 10:54:36

本帖最后由布朗运动于 2015-10-30 10:55 编辑

lilq_78 发表于 2014-2-19 15:46 static/image/common/back.gif
顶，但是矩形与矩形相交打断不行
对原程序243-266行代码进行了改进：
;;==========================================
;;Break many objects with many object
;;==========================================
(defun c:BreakWith (/ cmd ss1 ss2)
(defun ssredraw (ss mode / i num)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
   (redraw (ssname ss i) mode)
)
)
(command ".undo" "begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq xuanz nil)
;;get objects to break
(prompt "\n选择要打断的直线或多线段，按回车确定: ")
(if (and(setq ss1
                  (ssget
                     '((0
                        .
                        "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
                     )
                     )
                  )
               xuanz (ssget "P" '((0 . "LWPOLYLINE") (70 . 1)));取出选中的闭合多段线，一般为矩形或多边形命令创建
               flag1 (if (/= ss1 nil) T);判断选择集ss1是否非空
            )


      (not (ssredraw ss1 3))
      (not
         (prompt
            "\n***选择作为打断线的直线或多线段，按回车确定:***"
         )
      )
      (setq
         ss2 (ssget
               '((0
                  .
                  "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
                  )
               )
            )
         ssd(ssredraw ss1 4);新增
         flag2 (if (/= ss2 nil) T);判断选择集ss2是否非空
      )
      ;(not (ssredraw ss1 4))把该语句放在上面的setq语句群里，避免ss2为nil时本句不被执行的意外情况
   )
(progn
   (if(/= xuanz nil)
   (progn
   (setq snum -1)
   (repeat (SSLENGTH xuanz)
   (setq a (entget (ssname xuanz (setq snum (+ 1 snum)))));取出xuanz中的每个闭合多线段
   (setq num (cdr (assoc 90 a)))    ;多线段顶点数量
   (setq pnum (- (length a) (length (member (assoc 10 a) a))))
                                    ;pnum为多线段第一个顶点坐标子列表所在项数（组码10）

   (setq qdlst (PARTLIST1 pnum (+ pnum 4) a))
   ;第一个端点列表
   (setq tou (PartList1 0 (- (length a) 2) a))
   ;原列表去掉最后一个元素后的新列表
   (setq zhong (append tou qdlst))
   ;新列表插入第一个端点坐标
   (setq wei (nth (- (length a) 1) a))
   ;保存原列表最后一个元素
   (setq a (append zhong (list wei)))
   ;加入原列表最后一个元素
   (setq a (subst (cons 70 0) (assoc 70 a) a))
   ;将闭合多线段改为非闭合多线段
   (setq a (subst (cons 90 (+ num 1)) (assoc 90 a) a))
   ;修改多线段顶点个数
   (entmod a)
   )
   )
)
(break_with ss1 ss2 nil)             ; ss2break ss2breakwith (flag nil = not to break with self)
   )
)

(setvar "CMDECHO" cmd)
(command ".undo" "end")
(princ)
)

其中用到了自贡黄明儒老师发表的函数：
;截取部分列表子函数
(defun PartList1 (from to lst / I L)
(setq i -1)
(foreach x lst
(setq i (1+ i))
(cond ((and (>= i from) (<= i to)) (setq l (cons x l))))
)
(REVERSE l)
)

laorenhao999 发表于 2016-3-12 02:17:26

很强大，很好，支持下！

SYTDD 发表于 2018-2-14 21:39:52

谢谢分享！

墨者发表于 2018-3-28 01:18:56

谢谢楼主分享

lgzh0008 发表于 2018-8-21 11:11:53

学习一下啊！！！！！！！！！！！！

wchsunshine 发表于 2020-2-20 11:04:23

不错的

magicheno 发表于 2020-2-29 18:56:02

非常好的功能，谢谢

LIULISHENG 发表于 2020-3-7 11:00:02

页: 1 2 [3] 4

明经CAD社区's Archiver