- 积分
- 1821
- 明经币
- 个
- 注册时间
- 2008-11-20
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2023-3-22 07:33:08
|
显示全部楼层
弄了个,只是咋删除 红色 选框没搞得定
(defun c:breakall_ (/ cmd ss newents allents tmp)(vl-cmdf "_.undo" "_begin")(setq cmd (getvar "cmdecho"))(setvar "cmdecho" 0)(or bgap (setq bgap 0.85))(initget 4)
(if(setq tmp (getdist (strcat "\n 断开间隙.<"(rtos bgap)"> ")))(setq bgap tmp))(prompt "\n 选择要彼此断开的图线, 按enter键: ")
(setq ss (ssget "p"))
(if ss (setq newents (break_with ss ss nil bgap)))(setvar "cmdecho" cmd)(vl-cmdf "_.undo" "_end")
(princ))
(defun break_with (ss2brk ss2brkwith self gap / cmd intpts lst masterlist ss ssobjs oc lastentindatabase ss2brkwithlist)(vl-load-com)
(princ "\n 正在计算断点,请稍候")
(defun onlockedlayer (ename / entlst)(setq entlst (tblsearch "layer" (cdr (assoc 8 (entget ename)))))(= 4 (logand 4 (cdr (assoc 70 entlst)))))
(defun ssget->vla-list (ss / i ename allobj)(setq i -1)(while (setq ename (ssname ss (setq i (1+ i))))(setq allobj (cons (vlax-ename->vla-object ename) allobj))) allobj)
(defun list->3pair (old / new)(while (setq new (cons (list (car old)(cadr old)(caddr old)) new) old (cdddr old)))(reverse new))
(defun get_interpts (obj1 obj2 / iplist)(if(not (vl-catch-all-error-p(setq iplist (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value(vla-intersectwith obj1 obj2 acextendnone))))))) iplist))
(defun break_obj_s (ent brkptlst brkgap / brkobjlst en enttype maxparam closedobj minparam obj obj2break p1param p2param brkpt2 dlst idx brkpts brkpte brkpt result gapflg result ignore dist tmppt #ofpts 2gap enddist lastent obj2break stdist)(or brkgap (setq brkgap 0.0))(setq brkgap (/ brkgap 2.0))(setq obj2break ent brkobjlst (list ent) enttype (cdr (assoc 0 (entget ent))) gapflg (not (zerop brkgap)) closedobj (vlax-curve-isclosed obj2break))(if(zerop brkgap)(setq spt (vlax-curve-getstartpoint ent) ept (vlax-curve-getendpoint ent) brkptlst (vl-remove-if '(lambda(x)(or (< (distance x spt) 0.0001)(< (distance x ept) 0.0001))) brkptlst)))(if brkptlst (progn(setq brkptlst (mapcar '(lambda(x)(list x (vlax-curve-getdistatparam obj2break (cond ((vlax-curve-getparamatpoint obj2break x))((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break x))))))) brkptlst))(setq brkptlst (vl-sort brkptlst '(lambda (a1 a2)(< (cadr a1)(cadr a2)))))(if gapflg (progn(setq idx 0)(foreach brkpt brkptlst(setq dist (cadr brkpt))(cond((and(minusp (setq stdist (- dist brkgap))) closedobj)(setq stdist (+ (vlax-curve-getdistatparam obj2break (vlax-curve-getendparam obj2break)) stdist))(setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stdist)) stdist) dlst)))((minusp stdist)(setq dlst (cons (list idx (vlax-curve-getstartpoint obj2break) 0.0) dlst)))(t (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stdist)) stdist) dlst))))(cond((and(> (setq stdist (+ dist brkgap))(setq enddist (vlax-curve-getdistatparam obj2break (vlax-curve-getendparam obj2break)))) closedobj)(setq stdist (- stdist enddist))(setq dlst (cons (list idx(vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stdist)) stdist) dlst)))((> stdist enddist)(setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getendparam obj2break)) enddist) dlst)))(t (setq dlst (cons (list idx(vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stdist)) stdist) dlst))))(setq idx (1+ idx)))(setq dlst (reverse dlst))(setq idx -1 2gap (* brkgap 2) #ofpts (length brkptlst))(while (<= (setq idx (1+ idx)) #ofpts)(cond((null result)(setq result (list (car dlst)) result (cons (nth (1+(* idx 2)) dlst) result)))((= idx #ofpts)(if(and closedobj (> #ofpts 1)(<= (+(- (vlax-curve-getdistatparam obj2break(vlax-curve-getendparam obj2break))(cadr (last brkptlst)))(cadar brkptlst)) 2gap))(progn(if(zerop (rem (length result) 2))(setq result (cdr result)))(setq result (cons (cadr (reverse result)) result) result (cdr (reverse result)) result (reverse (cdr result))))))((< (cadr (nth idx brkptlst))(+ (cadr (nth (1- idx) brkptlst)) 2gap))(if(zerop (rem (length result) 2))(setq result (cdr result)))(setq result (cons (nth (1+(* idx 2)) dlst) result)))(t (setq result (cons (nth (* idx 2) dlst) result))(setq result (cons (nth (1+(* idx 2)) dlst) result)))))(setq dlst (reverse result) brkptlst nil)(while dlst (setq brkptlst (cons (list (cadar dlst)(cadadr dlst)) brkptlst) dlst (cddr dlst)))))
(foreach brkpt (reverse brkptlst)(if gapflg(setq brkpts (car brkpt) brkpte (cadr brkpt))(setq brkpts (car brkpt) brkpte brkpts))(if brkobjlst (progn(setq tmppt brkpts)(if(not (numberp (vl-catch-all-apply'vlax-curve-getdistatpoint (list obj2break tmppt))))(progn(setq idx (length brkobjlst))(while (and(not (minusp (setq idx (1- idx))))(setq obj (nth idx brkobjlst))(if(numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj tmppt)))(null (setq obj2break obj)) t)))))))(if(and brkobjlst idx (minusp idx)(null (alert (strcat "错误-点不在图线上"))))(exit))(setq closedobj (vlax-curve-isclosed obj2break))(if gapflg (if closedobj (progn(setq brkpt2 (vlax-curve-getpointatdist obj2break (- (vlax-curve-getdistatpoint obj2break brkpte) 0.00001)))(vl-cmdf "._break" obj2break "_non" (trans brkpt2 0 1)"_non" (trans brkpte 0 1))(and(= "circle" enttype)(setq enttype "arc"))(setq brkpte brkpt2)))
(if(and closedobj (not (setq brkpte (vlax-curve-getpointatdist obj2break (+ (vlax-curve-getdistatparam obj2break (cond ((vlax-curve-getparamatpoint obj2break brkpts))((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))))(setq brkpte (vlax-curve-getpointatdist obj2break (- (vlax-curve-getdistatparam obj2break (cond ((vlax-curve-getparamatpoint obj2break brkpts))((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))))
(setq lastent (getlastent))(vl-cmdf "._break" obj2break "_non" (trans brkpts 0 1) "_non" (trans brkpte 0 1))(and *brkverbose* (princ (setq *brkcnt* (1+ *brkcnt*)))(princ "\r"))(and(= "circle" enttype)(setq enttype "arc"))(if(and(not closedobj)(not (equal lastent (entlast))))(setq brkobjlst (cons (entlast) brkobjlst)))))))
(defun getlastent (/ ename result)(if(setq result (entlast))(while (setq ename (entnext result))(setq result ename)))result)
(defun getnewentities (ename / new)(cond((null ename)(alert "ename nil"))((eq 'ename (type ename))(while (setq ename (entnext ename))(if(entget ename)(setq new (cons ename new)))))
((alert "错误的类型.")))new)
(setq lastentindatabase (getlastent))(if(and ss2brk ss2brkwith)(progn(setq oc 0 ss2brkwithlist (ssget->vla-list ss2brkwith))(if(> (* (sslength ss2brk)(length ss2brkwithlist)) 5000)(setq *brkverbose* t))
(and *brkverbose* (princ (strcat "要检查的图线: " (itoa (* (sslength ss2brk)(length ss2brkwithlist))) "\n ")))(foreach obj (ssget->vla-list ss2brk)(if(not (onlockedlayer (vlax-vla-object->ename obj)))(progn(setq lst nil)(foreach intobj ss2brkwithlist (if(and(or self (not (equal obj intobj)))(setq intpts (get_interpts obj intobj)))(setq lst (append (list->3pair intpts) lst)))
(and *brkverbose* (princ (strcat "检查的图线: " (itoa (setq oc (1+ oc))) "\r"))))(if lst(setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))))))
(and *brkverbose* (princ "\n 断开图线 "))(setq *brkcnt* 0)(if masterlist (foreach obj2brk masterlist(break_obj_s (car obj2brk)(cdr obj2brk) gap)))))
(and(zerop *brkcnt*)(princ "\n 没有断开的图线."))(setq *brkverbose* nil)(getnewentities lastentindatabase))
(defun c:dd (/ p1 p2 plst ss)(vl-load-com)(setq p1 (getpoint "\n 起点:") p2 (getcorner p1 "\n 终点:"))
(vl-cmdf "rectang" "non" p1 "non" p2 "")(setq ss (entlast))(vl-cmdf "chprop" ss """c" "1""")(setq ss2 (entlast))(setq ss1 (ssget "c" p1 p2))
(vl-cmdf (c:breakall_) "" ss1 "")
(setq ss (ssget "x" (list(cons 0 "*LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE")(cons 62 1))))
(vl-cmdf "erase"ss "")
(princ)) |
|