转换为区域不成功

ahyin · 发表于 2022-7-6 08:35:24

尊敬的各位：，

我想把一些多段线转换成面域，但其中一条做不到。在检查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
)

Tharwat · 发表于 2022-7-6 08:47:26

试试这个。。。。

copy


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

Lee Mac · 发表于 2022-7-6 09:00:59

以下函数将返回LWPolyline的自交点，如果LWPolyline不与自身相交，则返回nil。

copy


[color=GREEN];; Get Self-Intersections  -  Lee Mac  -  2011  -  www.lee-mac.com[/color]
[color=GREEN];; Returns a list of self-intersections points of an LWPolyline.[/color]
([color=BLUE]defun[/color] _GetSelfIntersections ( obj [color=BLUE]/[/color] _LWVertices _Group3D )
   ([color=BLUE]defun[/color] _LWVertices ( l z )
       ([color=BLUE]if[/color] l ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] l) ([color=BLUE]cadr[/color] l) z) (_LWVertices ([color=BLUE]cddr[/color] l) z)))
   )
   ([color=BLUE]defun[/color] _Group3D ( l )
       ([color=BLUE]if[/color] l ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] l) ([color=BLUE]cadr[/color] l) ([color=BLUE]caddr[/color] l)) (_Group3D ([color=BLUE]cdddr[/color] l))))
   )
   (
       ([color=BLUE]lambda[/color] ( l )
           ([color=BLUE]vl-remove-if[/color]
               ([color=BLUE]function[/color]
                   ([color=BLUE]lambda[/color] ( a )
                       ([color=BLUE]vl-some[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( b ) ([color=BLUE]equal[/color] a b 1e-)) l)
                   )
               )
               (_Group3D ([color=BLUE]vlax-invoke[/color] obj 'intersectwith obj [color=BLUE]acextendnone[/color]))
           )
       )
       (_LWVertices ([color=BLUE]vlax-get[/color] obj 'coordinates) ([color=BLUE]vlax-get[/color] obj 'elevation))
   )
)

对于直接位于多段线顶点上的自交点，上述操作将失败。

marko_ribar · 发表于 2022-7-6 09:03:58

这一个也将检查旧的二维多段线和三维多段线，并附加重叠顶点到列表与相交点。。。基于李的代码和我对所有*多段线对象的顶点列表的贡献。。。代码已更新，以支持位于多段线上并按其位置相交的顶点，这些顶点具有实参数，而不是固定参数。

[编辑]：另请注意，使用此代码可以检查pline是否已正确生成。。。
如果没有自相交，并且此代码返回零，则正确生成pline（如果使用“C”-关闭选项关闭）。。。如果它报告点，pline是自交的或在同一位置上有重复的顶点。。。我的下一个代码-张贴在下面的帖子#7不会通知这些verexes，只是那些自相交或点的位置，即普林斯线段的交点自相交。。。

copy

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

测试：

copy


(_GetSelfIntersections (vlax-ename->vla-object (ssname (ssget "_+.:E:S:L" '((0 . "*POLYLINE"))) 0)))

M.R。

marko_ribar · 发表于 2022-7-6 09:15:20

代码已更新，

您好，M.R。

ahyin · 发表于 2022-7-6 09:26:38

感谢Tharwat、Lee Mac和Marko_ribar提供的程序代码，我将对其进行测试。

marko_ribar · 发表于 2022-7-6 09:29:41

如果只想在多段线上进行检查以创建区域，则无需检查多段线创建阵列中的重叠顶点，只需检查与其他顶点相交的顶点。。。在这种情况下，这将返回相交点的列表，如果返回零，则可以创建区域。。。

[编辑]：更新代码以包括开放/闭合样条线图元

copy

(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))
       ([highlight]acet-list-remove-adjacent-dups[/highlight] 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))
   )
)

测试：

copy


(_GetSelfIntersections (vlax-ename->vla-object (car (entsel))))

M.R。

Tharwat · 发表于 2022-7-6 09:41:21

非常好的结果。

如果不麻烦的话，请用另一种方式重新编写代码，而不使用lambda（在这种情况下可能重复函数工作）？？

非常感谢。

[编程交流] 转换为区域不成功

发表回复

精选推荐