三角网边界，复制仓老师及73哥等大神函数，只能将就用
仓老师有更完美的，用于南方CASS算土方时懒得画范围线用（自己觉得）;;;;;;;;;;;;;;;;;;;;;;;;
(defun zxd (pts / pts len pt )
;(setq pts (vxs ent))
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
(/ x len)
)
(apply
'mapcar
(cons '+ pts)
)
)
)
pt
)
(vl-load-com)
(defun lwp ( lst / )
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "SJWbj")'(100 . "AcDbPolyline") '(43 . 0.500)(cons 90 (length lst)))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
)
;@起点或者方向不同的两个多边形，CAD不会认为它们相同，但是用数学上集合的概念来对待它们的顶点表就好了
(defun remove(l e fun)(vl-remove'nil(mapcar'(lambda(x)(if(not(equal x e fun))x))l)))
(defun lst-(l1 l2 fun)(foreach x l2(setq l1(remove l1 x fun)))l1)
;用lst-求两个多边形顶点坐标表的差集，如果为nil那么这两个多边形它们是相同的，不管它们起点以及方向是否相同
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;货物分两组（样品 库存）
(defun lst->2lst(lst / lst1 lst2)
(setq lst1 '() lst2 '())
(foreach a lst
(if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))
(setq lst1 (cons a lst1))
(setq lst2 (cons a lst2))
)
)
(cons (reverse lst2) (reverse lst1))
)
;;;;;;;;;;;;;;;;;;;;;;;;==========================
(setvar "cmdecho" 0)
(setq dxfz(ssget '( (8 . "SJW") (0 . "POLYLINE"))))
(setq dxfc(sslength dxfz) i3 0 bb nil)
(repeat dxfc
(setq dxf (ssname dxfz i3))
(setq pt0 (vlax-curve-getPointAtParam dxf 0) pt0 (list (car pt0) (cadr pt0)))
(setq pt1 (vlax-curve-getPointAtParam dxf 1) pt1 (list (car pt1) (cadr pt1)))
(setq pt2 (vlax-curve-getPointAtParam dxf 2) pt2 (list (car pt2) (cadr pt2)))
(setq bb (cons (list pt0 pt1) bb) bb (cons (list pt1 pt2) bb) bb (cons (list pt2 pt0) bb))
(setq i3 (+ 1 i3))
)
;(setq bp0 bb bb1 nil bb2 nil);;(length bb)
;货物分两组（样品 库存）
(defun lst->2lst(lst / lst1 lst2)
(setq lst1 '() lst2 '())
(foreach a lst
(if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))
(setq lst1 (cons a lst1))
(setq lst2 (cons a lst2))
)
)
(cons (reverse lst2) (reverse lst1))
)
(setq pzx (lst->2lst bb) )
(setq bp nil)
;(mapcar '(lambda (x)(lwp x)) ) ;(car pzx)
(defun lst-a (l1 l2)
(vl-remove-if'(lambda(x)(member x l2))l1))
;(mapcar '(lambda (x)(lwp x)) (lst- (car pzx)(cdr pzx) 0.1))
(foreach n (car pzx)
(foreach m (cdr pzx)
(if (equal(zxd n)(zxd m) 0.1)(setq bp0 (list n)) )
)
;(setq bp (vl-remove-if'(lambda(x)(equal (zxd x) (zxd n)0.1 ))(car pzx)) )
(setq bp (append bp bp0))
)
(mapcar '(lambda (x)(lwp x)) (lst-a (car pzx) bp ))
tu图片来了
(setq ssaa (ssget "x"'( (8 . "SJWbj") (0 . "lwPOLYLINE"))))
(COMMAND "pedit" "m" ssaa "" "j" 0 "") 群里还有个gif贴上就直观了. 谢谢分享，学习学习 我找这个找了好久了 为啥我的生成的不是多段线呢求老哥发个完整生成多段线的小白不懂怎么改 这样选择的边界也不行老哥三角网如果有拐弯的话自动生成了三角网面积就变大了 不知道老哥能不能做过实测的坐标点生成最外围的多段线线呢跟这个相似围起来就可以 牛逼，我的大神，楼主出个工具箱呗
页:
[1]
2