明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
123
返回列表 发新帖
楼主: yeahyeah

[源码] 【悬赏!!!】画多段线打断于交点处

[复制链接]
发表于 2017-10-7 09:53 | 显示全部楼层
回帖是一种美德!感谢楼主的无私分享 谢谢
回复

使用道具 举报

发表于 2023-3-22 07:33 | 显示全部楼层
弄了个,只是咋删除 红色 选框没搞得定

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

使用道具 举报

发表于 2023-3-22 09:39 | 显示全部楼层
老帖子,怎么还没解决?
回复

使用道具 举报

发表于 2023-3-22 11:18 | 显示全部楼层
这个大佬“ucuc2003”分享的就可以打断了
不过,楼主是不是希望可以设置“打断后”之间距值
回复

使用道具 举报

发表于 2023-3-23 06:54 | 显示全部楼层
这些代码都是出至 明经
自己稍加按需求运动就  可以啦
回复

使用道具 举报

发表于 2023-3-27 07:19 | 显示全部楼层
要是哪高手给 弄个批量画框选就好
回复

使用道具 举报

发表于 2023-12-17 18:28 | 显示全部楼层
回帖是一种美德!感谢楼主的无私分享
回复

使用道具 举报

发表于 2024-2-18 18:28 | 显示全部楼层
这么久了还没解决吗
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-9 18:19 , Processed in 0.144469 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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