转换为区域不成功
尊敬的各位：，我想把一些多段线转换成面域，但其中一条做不到。在检查is折线后，我发现折线与自身相交。由于角点很小，可以用lisp检查这种多段线吗？谢谢
(defun c:test ()
(setq cset (ssget "_A" (list '(0 . "lwpolyline") (cons 410 (getvar "CTAB")) )))
(setq ctr 0 sobj 0 oobj 0)
(repeat (sslength cset)
(setq item (ssname cset ctr))
(if (= (vlax-property-available-p (vlax-ename->vla-object item ) "closed" T) T)
(progn
(setq lastitem (entlast))
(command "region" item "")
(setq drawitem (entlast))
(if (not (equal lastitem drawitem))
(progn
(alert "object converted to region")
(setq sobj (1+ sobj))
)progn
(progn
(alert "This object unable convert to region")
(setq oobj (1+ oobj))
)prgon
)if
);progn
(alert "All object can't convert to region")
);if
(setq ctr (1+ ctr))
);repeat
)
试试这个。。。。
(defun c:test (/ spc selectionset)
;;; Tharwat 08. Dec. 2011 ;;;
(vl-load-com)
(cond ((not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
(vla-get-modelspace acdoc)
(vla-get-paperspace acdoc)
)
)
(if (setq ss (ssget "_:L"
(list '(0 . "LWPOLYLINE")
'(-4 . "&=")
'(70 . 1)
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(vlax-for obj
(setq selectionset (vla-get-ActiveSelectionSet acdoc))
(vlax-invoke spc 'addregion (list obj))
)
(vla-delete selectionset)
)
(princ)
)
(princ)
)
以下函数将返回LWPolyline的自交点，如果LWPolyline不与自身相交，则返回nil。
;; Get Self-Intersections-Lee Mac-2011-www.lee-mac.com
;; Returns a list of self-intersections points of an LWPolyline.
(defun _GetSelfIntersections ( obj / _LWVertices _Group3D )
(defun _LWVertices ( l z )
(if l (cons (list (car l) (cadr l) z) (_LWVertices (cddr l) z)))
)
(defun _Group3D ( l )
(if l (cons (list (car l) (cadr l) (caddr l)) (_Group3D (cdddr l))))
)
(
(lambda ( l )
(vl-remove-if
(function
(lambda ( a )
(vl-some (function (lambda ( b ) (equal a b 1e-)) l)
)
)
(_Group3D (vlax-invoke obj 'intersectwith obj acextendnone))
)
)
(_LWVertices (vlax-get obj 'coordinates) (vlax-get obj 'elevation))
)
)
对于直接位于多段线顶点上的自交点，上述操作将失败。 这一个也将检查旧的二维多段线和三维多段线，并附加重叠顶点到列表与相交点。。。基于李的代码和我对所有*多段线对象的顶点列表的贡献。。。代码已更新，以支持位于多段线上并按其位置相交的顶点，这些顶点具有实参数，而不是固定参数。
[编辑]：另请注意，使用此代码可以检查pline是否已正确生成。。。
如果没有自相交，并且此代码返回零，则正确生成pline（如果使用“C”-关闭选项关闭）。。。如果它报告点，pline是自交的或在同一位置上有重复的顶点。。。我的下一个代码-张贴在下面的帖子#7不会通知这些verexes，只是那些自相交或点的位置，即普林斯线段的交点自相交。。。
(defun _GetSelfIntersections ( obj / _Vertices _Group3D )
(vl-load-com)
(defun _Vertices ( pl / nvert pt ptlst n )
(if (eq 1 (logand 1 (cdr (assoc 70 (entget (vlax-vla-object->ename pl))))))
(setq nvert (fix (vlax-curve-getendparam pl)))
(setq nvert (+ (fix (vlax-curve-getendparam pl)) 1))
)
(setq n 0.0)
(repeat nvert
(setq pt (vlax-curve-getpointatparam pl n))
(setq ptlst (cons pt ptlst))
(setq n (+ n 1.0))
)
(setq ptlst (reverse ptlst))
ptlst
)
(defun _Group3D ( l )
(if l (cons (list (car l) (cadr l) (caddr l)) (_Group3D (cdddr l))))
)
(defun _Duplicates ( l / lst lstrem )
(setq lstrem (acet-list-remove-duplicates (setq lst l) 1e-6))
(foreach el lstrem
(if (not
(vl-member-if
'(lambda ( x )
(equal el x 1e-6)
)
(cdr
(vl-member-if
'(lambda ( x )
(equal el x 1e-6)
)
lst
)
)
)
)
(setq lst (vl-remove-if
'(lambda ( x )
(equal el x 1e-6)
)
lst
)
)
)
)
lst
)
(append
(
(lambda ( l )
(vl-remove-if
(function
(lambda ( a )
(vl-some (function (lambda ( b ) (equal a b 1e-)) l)
)
)
(_Group3D (vlax-invoke obj 'intersectwith obj acextendnone))
)
)
(_Vertices obj)
)
(if (_Duplicates (_Vertices obj)) (acet-list-remove-duplicates (_Duplicates (_Vertices obj)) 1e-6))
)
)
测试：
(_GetSelfIntersections (vlax-ename->vla-object (ssname (ssget "_+.:E:S:L" '((0 . "*POLYLINE"))) 0)))
M.R。 代码已更新，
您好，M.R。 感谢Tharwat、Lee Mac和Marko_ribar提供的程序代码，我将对其进行测试。 如果只想在多段线上进行检查以创建区域，则无需检查多段线创建阵列中的重叠顶点，只需检查与其他顶点相交的顶点。。。在这种情况下，这将返回相交点的列表，如果返回零，则可以创建区域。。。
[编辑]：更新代码以包括开放/闭合样条线图元
(defun _GetSelfIntersections ( obj / _Vertices _Group3D )
(vl-load-com)
(defun _Vertices ( pl / nvert pt ptlst n )
(if (eq 1 (logand 1 (cdr (assoc 70 (entget (vlax-vla-object->ename pl))))))
(setq nvert (fix (vlax-curve-getendparam pl)))
(setq nvert (+ (fix (vlax-curve-getendparam pl)) 1))
)
(setq n 0.0)
(repeat nvert
(setq pt (vlax-curve-getpointatparam pl n))
(setq ptlst (cons pt ptlst))
(setq n (+ n 1.0))
)
(setq ptlst (reverse ptlst))
(acet-list-remove-adjacent-dups ptlst)
)
(defun _Group3D ( l )
(if l (cons (list (car l) (cadr l) (caddr l)) (_Group3D (cdddr l))))
)
(defun _Duplicates ( l / lst lstrem )
(setq lstrem (acet-list-remove-duplicates (setq lst l) 1e-6))
(foreach el lstrem
(if (not
(vl-member-if
'(lambda ( x )
(equal el x 1e-6)
)
(cdr
(vl-member-if
'(lambda ( x )
(equal el x 1e-6)
)
lst
)
)
)
)
(setq lst (vl-remove-if
'(lambda ( x )
(equal el x 1e-6)
)
lst
)
)
)
)
lst
)
(append
(
(lambda ( l )
(vl-remove-if
(function
(lambda ( a )
(vl-some (function (lambda ( b ) (equal a b 1e-)) l)
)
)
(_Group3D (vlax-invoke obj 'intersectwith obj acextendnone))
)
)
(_Vertices obj)
)
(if (_Duplicates (_Vertices obj)) (acet-list-remove-duplicates (_Duplicates (_Vertices obj)) 1e-6))
)
)
测试：
(_GetSelfIntersections (vlax-ename->vla-object (car (entsel))))
M.R。
非常好的结果。
如果不麻烦的话，请用另一种方式重新编写代码，而不使用lambda（在这种情况下可能重复函数工作）？？
非常感谢。
页:
[1]