(defun c:tt ()
"单点打断"
(while (setq ent (entsel "\n选择打断对象: "))
大佬的代码总是这么的简洁好用，感谢~ 试了一下，写了个逻辑比较混乱的，好多bug:lol欢迎扔砖
;;;打断LWPLINE逻辑混乱版
(defun c:tt(/ xty-L-cdrn xty-L-carn
xty-L-retainget-vtxl xty-tanmake-plbu
bue busen en1 en2 enl
enn entfuzz ince incs mode
ne nsocs pme pms pt
pta ptbptl tmp vtx1 vtx2
vtxe vtxlvtxs vtxt we wee
wes wswse wss x)
(defun xty-L-cdrn(n lst /)
(if (= 0 n)
lst
(repeat n (setq lst (cdr lst)))
)
)
(defun xty-L-carn(n lst / lsta)
(if (= 0 n)
(setq lsta lst)
(progn (setq lsta nil)
(repeat n
(setq lsta (append lsta (list (car lst)))
lst(cdr lst)
)
)
)
)
lsta
)
(defun xty-L-retain (m n lst /)
(setq lst (xty-L-carn n lst))
(setq lst (if (= 1 m)
lst
(xty-L-cdrn (1- m) lst)
)
)
)
(defun xty-tan(ang)
((lambda (x)
(if (equal 0. x 1e-14)
nil
(/ (sin ang) x)
)
)
(cos ang)
)
)
(defun xty-L-delsames(lst fuzz / start new)
(while (setq start (car lst))
(if(vl-some '(lambda (x) (equal start x fuzz)) new)
nil
(setq new (cons start new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(defun get-vtxl(ent / vtxl)
(while (setq ent (member (assoc 10 ent) ent))
(setq vtxl (cons (list (assoc 10 ent)
(assoc 40 ent)
(assoc 41 ent)
(assoc 42 ent))
vtxl)
ent(cdr ent)))
(reverse vtxl))
(defun make-pl(tmp ent ocs)
(entmakex
(append (subst (cons 90 (length tmp)) (assoc 90 ent) ent)
(apply 'append tmp)
(list (cons 210 ocs)))))
(setq fuzz 1e-6
en (car (entsel))
ent(entget en)
ocs(cdr (assoc 210 ent))
vtxl (get-vtxl ent)
mode (if (= 1 (cdr (assoc 70 ent)))
t
nil)
vtxl (if (equal (caar vtxl) (car (last vtxl)) fuzz)
(reverse (cdr (reverse vtxl)))
vtxl)
ptlnil)
(while (setq pt (getpoint)) (setq ptl (cons pt ptl)))
(setq ptl (mapcar '(lambda (x) (trans x 1 0)) ptl)
pta (vlax-curve-getstartpoint en)
ptb (vlax-curve-getendpoint en)
ptl (cons pta ptl)
ptl (cons ptb ptl)
ptl (xty-l-delsames ptl fuzz)
ptl (vl-sort
ptl
(function (lambda (x y)
(< (vlax-curve-getparamatpoint en x)
(vlax-curve-getparamatpoint en y)))))
ptl (if (equal pta ptb fuzz)
(append ptl (list ptb))
ptl)
)
(setq ent (reverse (member (assoc 39 ent) (reverse ent))))
(setq ent
(vl-remove-if
'(lambda (x)
(member (car x) '(-1 5 6 8 39 43 48 62 102 330 370)))
ent))
(setq ent (subst (cons 70 0) (assoc 70 ent) ent))
(setq enl (mapcar
(function
(lambda (pts pte)
(setqpms(vlax-curve-getparamatpoint
en
pts)
ns (fix pms)
incs (- pms ns)
vtxs (nth ns vtxl)
pme(vlax-curve-getparamatpoint
en
pte)
pme(if (< pme pms)
(vlax-curve-getendparam en)
pme)
pme(if (> pme (length vtxl))
(- pme 1)
pme)
pme(if (= pme (length vtxl))
(1- pme)
pme)
ne (fix pme)
ince (- pme ne)
vtxe (nth ne vtxl)
wss(cdr (assoc 40 vtxs))
wse(cdr (assoc 41 vtxs))
bus(atan (cdr (assoc 42 vtxs)))
wes(cdr (assoc 40 vtxe))
wee(cdr (assoc 41 vtxe))
bue(atan (cdr (assoc 42 vtxe))))
(if (= ns ne)
(setq ws (+ wss (* incs (- wse wss)))
we (+ wss (* ince (- wse wss)))
bu (xty-tan (* (- pme pms) bus))
vtxs (list
(cons 10
(trans pts 0 ocs))
(cons 40 ws)
(cons 41 we)
(cons 42 bu))
vtxe (list
(cons 10
(trans pte 0 ocs))
(cons 40 we)
(cons 41 we)
(cons 42 bu))
enn (make-pl (list vtxs vtxe)
ent
ocs))
(setq ws (+ wss (* incs (- wse wss)))
bu (- (xty-tan (* (1- incs) bus)))
vtxs (list
(cons 10
(trans pts 0 ocs))
(cons 40 ws)
(cons 41 wse)
(cons 42 bu))
ws (+ wes (* ince (- wee wes)))
bu (xty-tan (* (- pme ne) bue))
tmp (xty-L-retain (+ ns 2)
(1+ ne)
vtxl)
vtxt (last tmp)
tmp (reverse (cdr (reverse tmp)))
vtxt (subst(cons 41 ws)
(assoc 41 vtxt)
vtxt)
vtxt (subst(cons 42 bu)
(assoc 42 vtxt)
vtxt)
vtxe (list
(cons 10
(trans pte 0 ocs))
(cons 40 wee)
(cons 41 wee)
(cons 42 bu))
tmp (cons vtxs tmp)
enn (make-pl
(append tmp
(list vtxt vtxe))
ent
ocs)))))
ptl
(cdr ptl)))
(ifmode
(progn (setq en1(car enl)
vtx1 (get-vtxl (entget en1))
en2(last enl)
vtx2 (get-vtxl (entget en2))
enl(vl-remove en1 enl)
enl(vl-remove en2 enl)
enl(cons(make-pl (append vtx2 (cdr vtx1)) ent ocs)
enl))
(entdel en1)
(entdel en2)))) xyp1964 发表于 2023-6-14 12:17
(defun c:tt ()
"单点打断"
(while (setq ent (entsel "\n选择打断对象: "))
这个是方便，但是如果是闭合的多段线，使用这个程序打断的话会变成2条多段线。 ashan 发表于 2023-11-6 17:20
这个是方便，但是如果是闭合的多段线，使用这个程序打断的话会变成2条多段线。
闭合的非要打断本身就不正常……
页:
1
[2]