三角网边界，复制仓老师及73哥等大神函数，只能将就用

树櫴希德

仓老师有更完美的，用于南方CASS算土方时懒得画范围线用（自己觉得）

1. ;;;;;;;;;;;;;;;;;;;;;;;;
   
2. (defun zxd (pts / pts len pt )
   
3. ;(setq pts (vxs ent))
   
4.   (setq len (length pts))
   
5. (setq pt (mapcar
   
6.   '(lambda(x)
   
7.     (/ x len)
   
8.   )
   
9.   (apply
   
10.     'mapcar
    
11.     (cons '+ pts)
    
12.   )
    
13.   )
    
14.       )
    
15.   pt
    
16.   )
    
17. 
    
18. 
    
19. 
    
20. 
    
21. (vl-load-com)
    
22. 
    
23. (defun lwp ( lst / )
    
24. (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "SJWbj")'(100 . "AcDbPolyline") '(43 . 0.500)(cons 90 (length lst)))
    
25.       (mapcar '(lambda (pt)(cons 10 pt)) lst ))
    
26.   )
    
27. 
    
28. )
    
29. 
    
30. ;@[stoyer]起点或者方向不同的两个多边形，CAD不会认为它们相同，但是用数学上集合的概念来对待它们的顶点表就好了
    
31. (defun remove(l e fun)(vl-remove'nil(mapcar'(lambda(x)(if(not(equal x e fun))x))l)))
    
32. (defun lst-(l1 l2 fun)(foreach x l2(setq l1(remove l1 x fun)))l1)
    
33. ;用lst-求两个多边形顶点坐标表的差集，如果为nil那么这两个多边形它们是相同的，不管它们起点以及方向是否相同
    
34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
35. ;货物分两组（样品 库存）
    
36. (defun lst->2lst(lst / lst1 lst2)
    
37.   (setq lst1 '() lst2 '())
    
38. (foreach a lst
    
39.     (if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))
    
40.       (setq lst1 (cons a lst1))
    
41.       (setq lst2 (cons a lst2))
    
42.     )
    
43.   )
    
44. (cons (reverse lst2) (reverse lst1))
    
45. )
    
46. ;;;;;;;;;;;;;;;;;;;;;;;;==========================
    
47. (setvar "cmdecho" 0)
    
48.       (setq dxfz  (ssget '( (8 . "SJW") (0 . "POLYLINE"))))
    
49.       (setq dxfc  (sslength dxfz) i3 0 bb nil)
    
50.       (repeat dxfc
    
51.        (setq dxf (ssname dxfz i3))
    
52.        (setq pt0 (vlax-curve-getPointAtParam dxf 0) pt0 (list (car pt0) (cadr pt0)))
    
53.              (setq pt1 (vlax-curve-getPointAtParam dxf 1) pt1 (list (car pt1) (cadr pt1)))
    
54.        (setq pt2 (vlax-curve-getPointAtParam dxf 2) pt2 (list (car pt2) (cadr pt2)))
    
55.              (setq bb (cons (list pt0 pt1) bb) bb (cons (list pt1 pt2) bb) bb (cons (list pt2 pt0) bb))
    
56.        (setq i3 (+ 1 i3))
    
57.       )
    
58.   ;(setq bp0 bb bb1 nil bb2 nil);;(length bb)
    
59. 
    
60. ;货物分两组（样品 库存）
    
61. (defun lst->2lst(lst / lst1 lst2)
    
62.   (setq lst1 '() lst2 '())
    
63. (foreach a lst
    
64.     (if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))
    
65.       (setq lst1 (cons a lst1))
    
66.       (setq lst2 (cons a lst2))
    
67.     )
    
68.   )
    
69. (cons (reverse lst2) (reverse lst1))
    
70. )
    
71. 
    
72. 
    
73. (setq pzx (lst->2lst bb) )
    
74. (setq bp nil)
    
75. 
    
76. ;(mapcar '(lambda (x)(lwp x))   ) ;(car pzx)
    
77. 
    
78. 
    
79.    (defun lst-a (l1 l2)
    
80.   (vl-remove-if'(lambda(x)(member x l2))l1))
    
81. 
    
82. ;(mapcar '(lambda (x)(lwp x))   (lst- (car pzx)  (cdr pzx) 0.1))
    
83. 
    
84. (foreach n (car pzx)
    
85. 
    
86. (foreach m (cdr pzx)
    
87. 
    
88. (if (equal  (zxd n)  (zxd m) 0.1)  (setq bp0 (list n)) )
    
89.   )
    
90. ;(setq bp (vl-remove-if'(lambda(x)(equal (zxd x) (zxd n)  0.1 ))(car pzx)  )   )
    
91. 
    
92. (setq bp (append bp bp0))
    
93.   )
    
94. 
    
95. 
    
96. 
    
97. (mapcar '(lambda (x)(lwp x))   (lst-a (car pzx) bp ))

;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun zxd (pts / pts len pt )<br /> ;(setq pts (vxs ent))<br />   (setq len (length pts))<br /> (setq pt (mapcar<br />   '(lambda(x)<br />     (/ x len)<br />   )<br />   (apply<br />     'mapcar<br />     (cons '+ pts)<br />   )<br />   )<br />       )<br />   pt<br />   )<br /> <br /> <br /> <br /> <br /> (vl-load-com)<br /> <br /> (defun lwp ( lst / )<br /> (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "SJWbj")'(100 . "AcDbPolyline") '(43 . 0.500)(cons 90 (length lst)))<br />       (mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />   )<br /> <br /> )<br /> <br /> ;@[stoyer]起点或者方向不同的两个多边形，CAD不会认为它们相同，但是用数学上集合的概念来对待它们的顶点表就好了<br /> (defun remove(l e fun)(vl-remove'nil(mapcar'(lambda(x)(if(not(equal x e fun))x))l)))<br /> (defun lst-(l1 l2 fun)(foreach x l2(setq l1(remove l1 x fun)))l1)<br /> ;用lst-求两个多边形顶点坐标表的差集，如果为nil那么这两个多边形它们是相同的，不管它们起点以及方向是否相同<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;货物分两组（样品 库存）<br /> (defun lst->2lst(lst / lst1 lst2)<br />   (setq lst1 '() lst2 '())<br /> (foreach a lst<br />     (if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))<br />       (setq lst1 (cons a lst1))<br />       (setq lst2 (cons a lst2))<br />     )<br />   )<br /> (cons (reverse lst2) (reverse lst1))<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;==========================<br /> (setvar "cmdecho" 0)<br />       (setq dxfz  (ssget '( (8 . "SJW") (0 . "POLYLINE"))))<br />       (setq dxfc  (sslength dxfz) i3 0 bb nil) <br />       (repeat dxfc <br />        (setq dxf (ssname dxfz i3))<br />        (setq pt0 (vlax-curve-getPointAtParam dxf 0) pt0 (list (car pt0) (cadr pt0)))<br />              (setq pt1 (vlax-curve-getPointAtParam dxf 1) pt1 (list (car pt1) (cadr pt1)))<br />        (setq pt2 (vlax-curve-getPointAtParam dxf 2) pt2 (list (car pt2) (cadr pt2)))<br />              (setq bb (cons (list pt0 pt1) bb) bb (cons (list pt1 pt2) bb) bb (cons (list pt2 pt0) bb))<br />        (setq i3 (+ 1 i3))<br />       )<br />   ;(setq bp0 bb bb1 nil bb2 nil);;(length bb)<br /> <br /> ;货物分两组（样品 库存）<br /> (defun lst->2lst(lst / lst1 lst2)<br />   (setq lst1 '() lst2 '())<br /> (foreach a lst<br />     (if (or (member a lst2) (vl-some'(lambda(x)(not(lst- a x 0))) lst2))<br />       (setq lst1 (cons a lst1))<br />       (setq lst2 (cons a lst2))<br />     )<br />   )<br /> (cons (reverse lst2) (reverse lst1))<br /> )<br /> <br /> <br /> (setq pzx (lst->2lst bb) )<br /> (setq bp nil)<br /> <br /> ;(mapcar '(lambda (x)(lwp x))   ) ;(car pzx)<br /> <br /> <br />    (defun lst-a (l1 l2)<br />   (vl-remove-if'(lambda(x)(member x l2))l1))<br /> <br /> ;(mapcar '(lambda (x)(lwp x))   (lst- (car pzx)  (cdr pzx) 0.1))<br /> <br /> (foreach n (car pzx)<br /> <br /> (foreach m (cdr pzx)<br /> <br /> (if (equal  (zxd n)  (zxd m) 0.1)  (setq bp0 (list n)) )<br />   )<br /> ;(setq bp (vl-remove-if'(lambda(x)(equal (zxd x) (zxd n)  0.1 ))(car pzx)  )   )<br /> <br /> (setq bp (append bp bp0))<br />   )<br /> <br /> <br /> <br /> (mapcar '(lambda (x)(lwp x))   (lst-a (car pzx) bp ))

树櫴希德

tu图片来了

树櫴希德

1. (setq ssaa (ssget "x"'( (8 . "SJWbj") (0 . "lwPOLYLINE"))))
   
2. (COMMAND "pedit" "m" ssaa "" "j" 0 "")

(setq ssaa (ssget "x"'( (8 . "SJWbj") (0 . "lwPOLYLINE"))))<br /> (COMMAND "pedit" "m" ssaa "" "j" 0 "")

wkq004

群里还有个gif贴上就直观了.

gzxl

谢谢分享，学习学习

787116960

我找这个找了好久了

787116960

为啥我的生成的不是多段线呢  求老哥发个完整生成多段线的  小白不懂怎么改

787116960

这样选择的边界也不行老哥  三角网如果有拐弯的话自动生成了三角网  面积就变大了

787116960

不知道老哥能不能做过实测的坐标点生成最外围的多段线线呢  跟这个相似围起来就可以

czb203

牛逼，我的大神，楼主出个工具箱呗