关于断开多段线（请教龙龙仔）

尘缘一生 · 发表于 2019-5-29 17:41

本帖最后由尘缘一生于 2019-5-29 22:32 编辑

龙龙仔有段程序，是断开多段线，且不改变宽度的，如下：

;;--断开多段线于顶点处，宽度不变--------------------------------------------------
(defun SL-COORDS (PLINE / ENDPARAM PARAM LST)
(setq ENDPARAM (vlax-curve-getendparam PLINE) PARAM -1)
(while (<= (setq PARAM (1+ PARAM)) ENDPARAM)
(setq LST (cons (vlax-curve-getpointatparam PLINE PARAM) LST))
) ;;
(if (= 1 (logand (cdr (assoc 70 (entget PLINE))) 1)) ;;
(setq LST (reverse (cdr LST)))
(setq LST (reverse LST)) ;;
)
)
(defun C:EXPLINE (/ ENT LST N SS)
(if (setq SS (ssget '((0 . "LWpolyline"))))
(progn
(setq N 0)
(repeat (sslength SS)
(setq ENT (ssname SS N))
(setq LST (cdr (SL-COORDS ENT)))
(if (> (length LST) 1)
(repeat (1- (length LST))
(command "_.break" ENT "end" (car LST) "end" "@")
(setq ENT (entlast))
(setq LST (cdr LST))
)
)
(setq N (1+ N))
)
)
)
(princ)
)

经测试：这段程序对开口多段线完美，闭合的，将最后有一点断不开，希望找到毛病出来！

1291500406 · 发表于 2019-5-29 20:52

本帖最后由 1291500406 于 2019-5-29 21:40 编辑

(defun C:bb ()
(if (setq ss (ssget '((0 . "Lwpolyline")))n -1)(progn(repeat (sslength ss)(setq n (1+ n) ent (ssname ss n) lst (cdr (car (ACET-PLINE-SEGMENT-LIST ent ))))
(if (> (length lst) 1)(repeat (length lst)(command "_.break" ent "end" (car lst) "end" "@")(setq ent (entlast) lst (cdr lst)))))))(princ))

Andyhon · 发表于 2019-5-29 20:54

(defun SL-COORDS (PLINE / ENDPARAM PARAM LST)
(car (ACET-PLINE-SEGMENT-LIST pline))
)

尘缘一生 · 发表于 2019-5-29 22:27

经过改写，我已经测试成功了。

;;--断开多段线于顶点处，宽度不变-----（开始）---------------------------------------------
(vl-load-com)
(defun vertexs (ename / plist pp n)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj))))
(setq n 0)
(repeat (/ (length plist) 2)
(setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
(setq n (+ n 2))
)
pp
)
(defun C:EXPLINE (/ ent lst n ss p n1 p1)
(setq ss (ssget '((0 . "LWpolyline"))))
(setq p (sslength ss))
(setq n 0)
(setq p (- p 1))
(while (<= n p)
(setq ent (ssname ss n))
(setq lst (vertexs ent))
(if (> (length lst) 1)
(progn
(setq p1 (length lst))
(setq n1 0)
(setq p1 (- p1 1))
(while (<= n1 p1)
(command "_.break" ent "end" (car lst) "end" "@")
(setq ent (entlast)) ;;;;;取得炸开后剩下的线段
(setq lst (cdr lst)) ;;;;;取得下一个顶点
(setq n1 (1+ n1 ))
)
)
)
(setq n (1+ n ))
)
(princ)
)
;;--断开多段线于顶点处，宽度不变---(结束)-----------------------------------------------

1291500406 · 发表于 2019-5-29 22:38

本帖最后由 1291500406 于 2019-5-29 22:44 编辑

尘缘一生发表于 2019-5-29 22:27
经过改写，我已经测试成功了。

ACET-PLINE-SEGMENT-LIST是高版本cad才有的函数，我在2017中能用这个程序

(defun C:bb ()(if (setq ss (ssget '((0 . "Lwpolyline")))n -1)(progn(repeat (sslength ss)(setq n (1+ n) ent (ssname ss n) lst (cdr (bb-asssoc 10 (entget ent))))
(if (> (length lst) 1)(repeat (length lst)(command "_.break" ent "end" (car lst) "end" "@")(setq ent (entlast) lst (cdr lst)))))))(princ))
(defun bb-asssoc (a lst / b lst2)(while (setq b (assoc a lst))(setq lst (cdr (member b lst)) lst2 (cons (cdr b) lst2)))(reverse lst2))

e2002 · 发表于 2019-5-31 20:43

偷懒的办法：既然对闭合的有问题，那就在处理语句之前再加一句修改为open，这样就可以了吧？

rocking2008 · 发表于 2019-6-1 11:34

尘缘一生发表于 2019-5-29 22:27
经过改写，我已经测试成功了。

这个代码试用了一下，直接用PL画的多段线断开是没有问题。但是用F倒直角的多段线，却无法断开，不知有没有发现这个问题。

Andyhon · 发表于 2019-6-1 12:26

简单测试能断开

...用F倒直角的多段线...
得依您的Dwg调试...

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

[提问] 关于断开多段线（请教龙龙仔）

点评

点评

点评

点评

点评