两直线端点闭合成多段线
有没有将两条直线端点连接成闭合的多段线插件 http://bbs.mjtd.com/thread-94033-2-1.html 不好意思,我没表达清楚,是将两条平行的直线的两瑞相连并闭合成四边形或矩形矩形 http://bbs.mjtd.com/thread-179863-1-1.html 本帖最后由 taoyi0727 于 2019-7-14 12:16 编辑点表要怎么排序搞不定 下面这个面出来的矩形有可能要交叉
(defun c:tt (/ dxf lst name ss)
(if (and
(setq ss (ssget '((0 . "line"))))
(= (sslength ss) 2)
)
(progn
(while (setq name (ssname ss 0))
(setq dxf (entget name))
(setq lst (append lst (list
(cdr (assoc 10 dxf))
(cdr (assoc 11 dxf))
)
)
)
(ssdel name ss)
(entdel name)
)
(entmake (append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
(cons 70 1)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
(list (cons 210 (trans '(0.0 0.0 1.0) 1 0)))
)
)
)
)
)
(defun c:tt (/ dxf lst lst2 name name-lst ss)
(if (and
(setq ss (ssget '((0 . "line"))))
(= (sslength ss) 2)
)
(progn
(setq lst nil)
(setq lst2 nil)
(setq name-lst nil)
(while (setq name (ssname ss 0))
(setq dxf (entget name))
(setq lst (append lst (list
(cdr (assoc 10 dxf))
(cdr (assoc 11 dxf))
)
)
)
(ssdel name ss)
(entdel name)
)
(setq lst2 (list (nth 0 lst) (nth 2 lst) (nth 1 lst) (nth 3 lst)))
(setq lst3 (list (nth 1 lst) (nth 0 lst) (nth 2 lst) (nth 3 lst)))
(foreach x (list lst lst2 lst3)
(setq name-lst (append
name-lst
(list (progn
(entmake (append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length x))
(cons 70 1)
)
(mapcar '(lambda (pt) (cons 10 pt)) x)
(list (cons 210 (trans '(0.0 0.0 1.0) 1 0)))
)
)
(entlast)
)
)
)
)
)
(if (>
(Vlax-Get (vlax-ename->vla-object (car name-lst)) 'Area);1
(Vlax-Get (vlax-ename->vla-object (cadr name-lst)) 'Area);2
)
(if (>
(Vlax-Get (vlax-ename->vla-object (car name-lst)) 'Area);1
(Vlax-Get (vlax-ename->vla-object (caddr name-lst)) 'Area);3
)
(progn
(entdel (cadr name-lst))
(entdel (caddr name-lst))
)
(progn
(entdel (car name-lst))
(entdel (cadr name-lst))
)
)
(if (>
(Vlax-Get (vlax-ename->vla-object (cadr name-lst)) 'Area);2
(Vlax-Get (vlax-ename->vla-object (cadr name-lst)) 'Area);3
)
(progn
(entdel (car name-lst))
(entdel (caddr name-lst))
)
(progn
(entdel (car name-lst))
(entdel (cadr name-lst))
)
)
)
)
)
) 楼上的改的非常好! taoyi0727 发表于 2019-7-14 13:16
(defun c:tt (/ dxf lst lst2 name name-lst ss)
(if (and
(setq ss (ssget '((0 . "line"))))
楼上的改的非常好! taoyi0727 发表于 2019-7-14 13:16
(defun c:tt (/ dxf lst lst2 name name-lst ss)
(if (and
(setq ss (ssget '((0 . "line"))))
楼上的改的非常好! 谢谢,很有用:handshake
页:
[1]