将直线分解为线段
你好我的最终目的是生成一个例程，将直线分解为由交点定义的线段。（见jpg附件）
我的需求：
[列表=1]
[*]填充不相交的垂直线之间的间隙（我发现只有pedit可以这样做）
[*]运行扫描以验证仍然不相交的垂直线（我再次分解多段线，因为（inters）仅适用于线）
[*]在每个交点上运行（中断）（特征）
[*]运行一个函数，收集长度小于x的所有行，并删除它们（特征）
[*]（仍需考虑保护某些线路免受上述功能影响的方法）（功能）
[/列表]
现在，我得到了选择集，我把线连接成一条多段线，现在为了使用9inters）函数，我需要将无间隙的多段线转换回线
但使用时：
(command "_.explode" entlast "")
我出错了
我做错了什么？
(defun C:TEST (/ st cen my mx z i)
(setq ope (getvar "PEDITACCEPT"))
(if (setq st (ssget '((0 . "LINE"))));_ get a selectio set
(progn
(setvar "PEDITACCEPT" 1)
(command "_.pedit" "_M" st "" "_J" "20" "" );_join and fill the gaps
(setvar "PEDITACCEPT" ope)
)
)
;_
(setq q (getvar 'qaflags))
(setvar 'qaflags 1)
(command "_.explode" entlast "");_explode the converted polyline
(setvar 'qaflags q)
(setq i 0
z 0
)
;_find intesection and mark them
(while (< i (- (sslength st) 1))
(while (< z (- (sslength st) 1))
(setq mx (ssname st i))
(setq my (ssname st (+ z 1)))
(if (setq cen (findInters mx my))
(progn
(command "Circle" cen 8 "")
)
)
(setq z (1+ z))
) ;_while
(setq i (1+ i))
(setq z 0)
)
)
(defun findInters (entA entB)
(setq 1a (cdr (assoc 10 (entget entA))))
(setq 1b (cdr (assoc 11 (entget entA))))
(setq 2a (cdr (assoc 10 (entget entB))))
(setq 2b (cdr (assoc 11 (entget entB))))
(setq in (inters 1a 1b 2a 2b))
)
(defun c:jp (/ ope ss)
(setq ope (getvar "PEDITACCEPT"))
(if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
(progn
(setvar "PEDITACCEPT" 1)
(command "_.pedit" "_M" ss "" "_J" "" "")
)
)
(setvar "PEDITACCEPT" ope)
(princ)
)
谢谢
谢伊
至少你应该感谢在这篇文章中试图在同一问题上帮助你的先生们 Samifox，请注意您如何调用ENTLAST（是一个函数）：
(command "_.explode" (entlast) "") 是我的眼睛欺骗了我，还是“爆炸”的线条没有在你贴的pix上对齐？这真的是你的意图吗？ 谢，如果我理解正确的话，这就是你需要的。。。
(defun plintav ( / intersobj1obj2 LM:Unique AT:GetVertices _reml member-fuzz add_vtx
ss sslpl sshpl i ent n ent1 ss-ent1 k ent2 intpts intptsall pl plpts restintpts par )
(vl-load-com)
(defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
(if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
(if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
(setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
(if (vl-catch-all-error-p coords)
(setq ptlst nil)
(repeat (/ (length coords) 3)
(setq pt (list (car coords) (cadr coords) (caddr coords)))
(setq ptlst (cons pt ptlst))
(setq coords (cdddr coords))
)
)
ptlst
)
(defun LM:Unique ( lst )
(if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
)
(defun AT:GetVertices ( e / p l )
(LM:Unique
(if e
(if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
(repeat (setq p (1+ (fix p)))
(setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
)
(list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
)
)
)
)
(defun _reml ( l1 l2 / a n ls )
(while
(setq n nil
a (car l2)
)
(while (and l1 (null n))
(if (equal a (car l1) 1e-
(setq l1 (cdr l1)
n t
)
(setq ls (append ls (list (car l1)))
l1 (cdr l1)
)
)
)
(setq l2 (cdr l2))
)
(append ls l1)
)
(defun member-fuzz ( expr lst fuzz )
(while (and lst (not (equal (car lst) expr fuzz)))
(setq lst (cdr lst))
)
lst
)
(defun add_vtx ( obj add_pt ent_name / bulg )
(vla-addVertex
obj
(1+ (fix add_pt))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 1))
(list
(car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
(cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
)
)
)
)
(setq bulg (vla-GetBulge obj (fix add_pt)))
(vla-SetBulge obj
(fix add_pt)
(/
(sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
(cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
)
)
(vla-SetBulge obj
(1+ (fix add_pt))
(/
(sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
(cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
)
)
(vla-update obj)
)
(setq ss (ssget "_I" '((0 . "*POLYLINE") (-4 . "<and") (-4 . "<not") (-4 . "&=") (70 .(-4 . "not>") (-4 . "<") (70 . 130) (-4 . "and>"))))
(setq sslpl (ssadd) sshpl (ssadd))
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(progn
(entupd ent)
(vla-update (vlax-ename->vla-object ent))
(ssadd ent sslpl)
)
)
(if (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
(ssadd ent sshpl)
)
)
(setq i -1)
(while (setq ent (ssname sshpl (setq i (1+ i))))
(command "_.convertpoly" "l" ent "")
(entupd ent)
(vla-update (vlax-ename->vla-object ent))
(ssadd ent sslpl)
)
(repeat (setq n (sslength ss))
(setq ent1 (ssname ss (setq n (1- n))))
(setq ss-ent1 (ssdel ent1 ss))
(repeat (setq k (sslength ss-ent1))
(setq ent2 (ssname ss-ent1 (setq k (1- k))))
(setq intpts (intersobj1obj2 ent1 ent2))
(setq intptsall (append intpts intptsall))
)
)
(setq i -1)
(while (setq pl (ssname sslpl (setq i (1+ i))))
(setq plpts (AT:GetVertices pl))
(setq restintpts (_reml intptsall plpts))
(foreach pt restintpts
(if
(and
(not (member-fuzz pt plpts 1e-6))
(setq par (vlax-curve-getparamatpoint pl pt))
)
(add_vtx (vlax-ename->vla-object pl) par pl)
)
)
)
(setq i -1)
(while (setq ent (ssname sshpl (setq i (1+ i))))
(command "_.convertpoly" "h" ent "")
)
(princ)
)
(defun c:test (/ pea qaf ss sspl ssli i ent)
(setq pea (getvar "PEDITACCEPT"))
(setq qaf (getvar "QAFLAGS"))
(if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
(progn
(setq sspl (ssadd))
(setq ssli (ssadd))
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
(ssadd ent sspl)
(progn
(setvar "PEDITACCEPT" 1)
(command "_.pedit" ent "")
(ssadd (entlast) ssli)
)
)
)
)
)
(sssetfirst nil (acet-ss-union (list ssli sspl)))
(plintav)
(setvar "QAFLAGS" 1)
(command "_.explode")
(setvar "QAFLAGS" qaf)
(setvar "PEDITACCEPT" pea)
(princ)
)
它是什么？
谢谢
谢伊 "PEDITACCEPT" for the code to work on lines as well, i'm just saying.
BTW: Suppresses display of the Object Selected Is Not a Polyline prompt in PEDIT
@samifox
What is the intent of the program again?
yes...i totaly forgot
and its not the same issue , its look like the same images
Yes, pBe you're correct... I've used setting of 1 and didn't saw it won't work... Code updated...
Thanks, pBe...
im using 2010
yes..on the left is before, and on the right is the desired result (the offset is only to clear the point, they should share the same points)
页:
[1]
2