谁有批量打断程序，能否分享下，谢谢

hyqfa · 发表于 2017-9-22 11:47:02

类似下链接图2
http://bbs.mjtd.com/forum.php?mo ... hlight=%B4%F2%B6%CF 类似图2

LIULISHENG · 发表于 2017-9-23 09:54:55

顶上去

菜卷鱼 · 发表于 2017-9-23 15:58:29

有倒是有，只是没那么先进。

xyp1964 · 发表于 2017-9-23 18:14:47

hyqfa · 发表于 2017-9-23 19:35:47

谢大伙了......

hyqfa · 发表于 2017-9-23 19:39:59

xyp1964 发表于 2017-9-23 18:14

对对对.................

F海市蜃楼 · 发表于 2021-12-11 11:14:40

菜卷鱼发表于 2017-9-23 15:58
有倒是有，只是没那么先进。

怎么没用呢？

菜卷鱼 · 发表于 2021-12-11 14:10:36

本帖最后由菜卷鱼于 2021-12-14 08:58 编辑

F海市蜃楼发表于 2021-12-11 11:14
怎么没用呢？

;;[功能] 两对象交点列表
;;acextendnone 0 不延伸
;;acextendthisentity 1 延伸基准对象
;;acextendotherentity 2
;;acextendboth 3
;;示例(HH:TwoEntsInters (car(entsel)) (car(entsel)) 0)
(defun HH:TwoEntsInters (e1 e2 Flag / OBJ1 OBJ2 PTL PTS)
(setq obj1 (vlax-ename->vla-object e1))
(setq obj2 (vlax-ename->vla-object e2))
(setq pts (vlax-invoke obj1 'Intersectwith obj2 Flag))
(while pts
(setq ptl (cons (list (car pts) (cadr pts)) ptl))
(setq pts (cdddr pts))
)
ptl
)
;;;返回自实体E之后生成的实体选择集
;;;Desgined by byghbcx
(defun mark2ss (e / ss sn)
(if (/= (type e) 'ENAME)
(alert "Parameter ERROR in ENT_FROM")
)
(setq ss (ssadd))
(while e
(setq e (entnext e))
(if e
(progn
(setq sn (cdr (assoc 0 (entget e))))
(if (not (member sn
(quote
("ATTRIB" "VERTEX" "SEQEND")
)
)
)
(setq ss (ssadd e ss))
)
)
)
)
ss
)
(defun c:ba (/ ss cuter sscir ssnot)
(princ "按切割线打断")
(setq *error* undoerr)
(setq ss (ssget '((-4 . "<not") (0 . "INSERT") (-4 . "not>"))))
(setq cuter (car (nentsel "\n选择切割线:")))
(undobe)
(setq sscir (ssnotget ss 0 "CIRCLE" nil))
(setq ssnot (ssnotget ss 0 "CIRCLE" t))
(if (> (sslength ssnot) 0)
(cutbyline ssnot cuter)
)
(if (> (sslength sscir) 0)
(cutcircle sscir cuter)
)
(undoe)
(prin1)
)
(defun cutcircle (ss cuter / ss_cir i obj ptlst
info elist pt ang1 ang2 elist1 elist2
)
(setq i 0)
(repeat (sslength ss)
(setq obj (ssname ss i))
(setq ptlst (HH:TwoEntsInters obj cuter 0))
(setq info (entget obj))
(if (and(= (cdr(assoc 0 info)) "CIRCLE") (= 2 (length ptlst)))
(progn
(setq elist info)
(mapcar '(lambda (x)
(setq elist (vl-remove (assoc x elist) elist))
)
'(-1 0 330 5 100 100 100)
)
(setq pt (cdr (assoc 10 info)))
(setq ang1 (angle pt (car ptlst) ))
(setq ang2 (angle pt (cadr ptlst) ))
(setq elist1 (append (list '(0 . "ARC")
'(100 . "AcDbArc")
'(100 . "AcDbCircle")
(cons 50 ang1)
(cons 51 ang2)
)
elist
)
)
(setq elist2 (append (list '(0 . "ARC")
'(100 . "AcDbArc")
'(100 . "AcDbCircle")
(cons 50 ang2)
(cons 51 ang1)
)
elist
)
)
(entmake elist1)
(entmake elist2)
(entdel obj)
)
)
(setq i (1+ i))
)
(princ "完成圆打断。")
(prin1)
)
(defun cutbyline (s1 cuter / i mark brked ssl pl pt brklst)
(setq i 0)
(cmd0)
(setq mark (entlast))
(setq brked (ssadd))
(setq ssl (sslist s1))
(setq ssl (vl-remove-if-not
'(lambda (x) (HH:TwoEntsInters x cuter 0))
ssl
)
)
(while ssl
(foreach x ssl
(setq pl (HH:TwoEntsInters x cuter 0))
(setq i 0)
(repeat (length pl)
(setq pt (nth i pl))
(command "_.break" x pt pt)
(setq brked (ssadd x brked))
(setq i (1+ i))
)
)
(setq s1 (mark2ss mark))
(setq ssl (sslist s1))
(setq ssl (vl-remove-if-not
'(lambda (x) (HH:TwoEntsInters x cuter 0))
ssl
)
)
(setq brklst (sslist brked))
(foreach x brklst
(setq ssl (vl-remove x ssl))
)
)
(cmd1)
(princ "完成线打断。")
(prin1)
)
(defun split (str mark / txt lth eps)
(setq lth (strlen mark))
(if (zerop lth)
(setq mark " ")
)
(setq eps (vl-string-search mark str))
(while (/= eps nil)
(setq txt (append txt (list (substr str 1 eps))))
(setq str (substr str (+ 1 eps lth)))
(setq eps (vl-string-search mark str))
)
(append txt (list str))
)
(defun ssnotget (ss index value bool / ssnot i elst obj ename booif)
(setq ssnot (ssadd))
(setq i 0)
(if (member BOOL '(T nil))
(progn
(cond
((= (type value) 'LIST)
(setq elst value)
)
((= (type value) 'STR)
(setq elst (split value ","))
(setq elst (mapcar '(lambda (x) (strcase x)) elst))
)
(T (setq elst (list value)))
)
(repeat (sslength ss)
(setq obj (ssname ss i))
(setq ename (cdr (assoc index (entget obj))))
(setq booif (= nil (member ename elst)))
(if (= bool booif)
(setq ssnot (ssadd obj ssnot))
)
(setq i (1+ i))
)
)
(princ "\n判断关键字非布尔值")
)
ssnot
)
(defun c:bt ( / ent pt)
(princ "Break the object on the point")
(setq ent (entsel "\nChoose the object:"))
(setq pt (getpoint "breaking point:"))
(setvar "cmdecho" 0)
(command "_.break" ent "f" pt pt)
(setvar "cmdecho" 1)
(prin1))

;;[功能] 两对象交点列表 
;;acextendnone 0 不延伸 
;;acextendthisentity 1 延伸基准对象 
;;acextendotherentity 2 
;;acextendboth 3 
;;示例(HH:TwoEntsInters (car(entsel)) (car(entsel)) 0) 
(defun HH:TwoEntsInters        (e1 e2 Flag / OBJ1 OBJ2 PTL PTS) 
  (setq obj1 (vlax-ename->vla-object e1)) 
  (setq obj2 (vlax-ename->vla-object e2)) 
  (setq pts (vlax-invoke obj1 'Intersectwith obj2 Flag)) 
  (while pts 
    (setq ptl (cons (list (car pts) (cadr pts)) ptl)) 
    (setq pts (cdddr pts)) 
  ) 
  ptl 
) 
;;;返回自实体E之后生成的实体选择集 
;;;Desgined by byghbcx 
(defun mark2ss (e / ss sn) 
  (if (/= (type e) 'ENAME) 
    (alert "Parameter ERROR in ENT_FROM") 
  ) 
  (setq ss (ssadd)) 
  (while e 
    (setq e (entnext e)) 
    (if        e 
      (progn 
        (setq sn (cdr (assoc 0 (entget e)))) 
        (if (not (member sn 
                         (quote 
                           ("ATTRIB" "VERTEX" "SEQEND") 
                         ) 
                 ) 
            ) 
          (setq ss (ssadd e ss)) 
        ) 
      ) 
    ) 
  ) 
  ss 
) 
 
(defun c:ba (/ ss cuter sscir ssnot) 
  (princ "按切割线打断") 
  (setq *error* undoerr) 
  (setq ss (ssget '((-4 . "<not") (0 . "INSERT") (-4 . "not>")))) 
  (setq cuter (car (nentsel "\n选择切割线:"))) 
  (undobe) 
  (setq sscir (ssnotget ss 0 "CIRCLE" nil)) 
  (setq ssnot (ssnotget ss 0 "CIRCLE" t)) 
  (if (> (sslength ssnot) 0) 
    (cutbyline ssnot cuter) 
  ) 
  (if (> (sslength sscir) 0) 
    (cutcircle sscir cuter) 
  ) 
  (undoe) 
  (prin1) 
) 
 
 
 
(defun cutcircle (ss         cuter        /      ss_cir i             obj    ptlst 
                  info         elist        pt     ang1   ang2   elist1 elist2 
                 ) 
  (setq i 0) 
  (repeat (sslength ss) 
    (setq obj (ssname ss i)) 
    (setq ptlst (HH:TwoEntsInters obj cuter 0)) 
    (setq info (entget obj)) 
    (if (and(= (cdr(assoc 0 info)) "CIRCLE") (= 2 (length ptlst))) 
      (progn 
        (setq elist info) 
        (mapcar        '(lambda (x) 
                   (setq elist (vl-remove (assoc x elist) elist)) 
                 ) 
                '(-1 0 330 5 100 100 100) 
        ) 
        (setq pt (cdr (assoc 10 info))) 
        (setq ang1 (angle pt (car ptlst) )) 
        (setq ang2 (angle pt (cadr ptlst) )) 
        (setq elist1 (append (list '(0 . "ARC") 
                                   '(100 . "AcDbArc") 
                                   '(100 . "AcDbCircle") 
                                   (cons 50 ang1) 
                                   (cons 51 ang2) 
                             ) 
                             elist 
                     ) 
        ) 
        (setq elist2 (append (list '(0 . "ARC") 
                                   '(100 . "AcDbArc") 
                                   '(100 . "AcDbCircle") 
                                   (cons 50 ang2) 
                                   (cons 51 ang1) 
                             ) 
                             elist 
                     ) 
        ) 
        (entmake elist1) 
        (entmake elist2) 
        (entdel obj) 
      ) 
    ) 
    (setq i (1+ i)) 
  ) 
  (princ "完成圆打断。") 
  (prin1) 
) 
 
(defun cutbyline (s1 cuter / i mark brked ssl pl pt brklst) 
  (setq i 0) 
  (cmd0) 
  (setq mark (entlast)) 
  (setq brked (ssadd)) 
  (setq ssl (sslist s1)) 
  (setq        ssl (vl-remove-if-not 
              '(lambda (x) (HH:TwoEntsInters x cuter 0)) 
              ssl 
            ) 
  ) 
  (while ssl 
    (foreach x ssl 
      (setq pl (HH:TwoEntsInters x cuter 0)) 
      (setq i 0) 
      (repeat (length pl) 
        (setq pt (nth i pl)) 
        (command "_.break" x pt pt) 
        (setq brked (ssadd x brked)) 
        (setq i (1+ i)) 
      ) 
    ) 
    (setq s1 (mark2ss mark)) 
    (setq ssl (sslist s1)) 
    (setq ssl (vl-remove-if-not 
                '(lambda (x) (HH:TwoEntsInters x cuter 0)) 
                ssl 
              ) 
    ) 
    (setq brklst (sslist brked)) 
    (foreach x brklst 
      (setq ssl (vl-remove x ssl)) 
    ) 
  ) 
  (cmd1) 
  (princ "完成线打断。") 
  (prin1) 
) 
 
(defun split (str mark / txt lth eps) 
  (setq lth (strlen mark)) 
  (if (zerop lth) 
    (setq mark " ") 
  ) 
  (setq eps (vl-string-search mark str)) 
  (while (/= eps nil) 
    (setq txt (append txt (list (substr str 1 eps)))) 
    (setq str (substr str (+ 1 eps lth))) 
    (setq eps (vl-string-search mark str)) 
  ) 
  (append txt (list str)) 
) 
 
(defun ssnotget        (ss index value bool / ssnot i elst obj ename booif) 
  (setq ssnot (ssadd)) 
  (setq i 0) 
  (if (member BOOL '(T nil)) 
    (progn 
      (cond 
        ((= (type value) 'LIST) 
         (setq elst value) 
        ) 
        ((= (type value) 'STR) 
         (setq elst (split value ",")) 
         (setq elst (mapcar '(lambda (x) (strcase x)) elst)) 
        ) 
        (T (setq elst (list value))) 
      ) 
      (repeat (sslength ss) 
        (setq obj (ssname ss i)) 
        (setq ename (cdr (assoc index (entget obj)))) 
        (setq booif (= nil (member ename elst))) 
        (if (= bool booif) 
          (setq ssnot (ssadd obj ssnot)) 
        ) 
        (setq i (1+ i)) 
      ) 
    ) 
    (princ "\n判断关键字非布尔值") 
  ) 
  ssnot 
) 
(defun c:bt ( / ent pt) 
  (princ "Break the object on the point") 
  (setq ent (entsel "\nChoose the object:")) 
  (setq pt  (getpoint "breaking point:")) 
  (setvar "cmdecho" 0) 
  (command "_.break" ent "f" pt pt) 
  (setvar "cmdecho" 1) 
(prin1))

F海市蜃楼 · 发表于 2021-12-13 21:06:58

菜卷鱼发表于 2021-12-11 14:10

非常感谢回复，谢谢！！！！！！！！！！！

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

[提问] 谁有批量打断程序，能否分享下，谢谢

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源