合并3D多段线

sz721

合并三维多段线。

Linhay

牛..先马,用上的时候好找,谢谢

jltx123456

原作者gile的程序, 请转载时保留作者版权信息!

1. ;; Join3dPoly (gile)
   
2. 
   
3. ;; Joint les objets sélectionnés en une polyligne 3d s'ils sont jointifs
   
4. 
   
5. ;; La polyligne est créée avec les propriétés courantes (calque, couleur, ...)

复制代码

http://gilecad.azurewebsites.net/LISP/Join3dPoly.lsp
http://cadxp.com/topic/21189-joindre-3d-polylignes-selon-calques/

77077

2. (vl-load-com)
   
3. ;;46.2 [功能] pline,lwpline点坐标表  By 无痕
   
4. ;;示例(vxs (car (entsel))),返回三维点坐标
   
5. (defun vxs (e / i v lst)
   
6.   (setq i -1)
   
7.   (while
   
8.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   
9.      (setq lst (cons v lst))
   
10.   )
    
11.   (reverse lst)
    
12. )
    
13. ;三维点表绘制3D多段线
    
14. (defun mk3DPOLYLINE(ptlst)
    
15.    (entmake (list '(0 . "POLYLINE") '(100 . "AcDbEntity") '(100 . "AcDb3dPolyline") '(66 . 1) '(70 . 8)))
    
16.    (foreach pt ptlst (entmake (list '(0 . "vertex") (cons 10 pt) '(70 . 32))))
    
17.    (entmake '((0 . "seqend")))
    
18. )
    
19. ;==========================
    
20. ;连接两条三维多段线 by 77077
    
21. (defun c:XX(/ ent1 ent2 list1 list2 lst)
    
22.         (princ "\n 连接两条3D多段线")
    
23. (if (and (setq ent1(CAR(entsel "\n 选择第一条3D多段线")))
    
24.                 (setq ent2(CAR(entsel "\n 选择第二条3D多段线")))
    
25.                 (setq list1 (vxs ent1))
    
26.                 (setq list2 (vxs ent2))
    
27.               )
    
28.          (progn
    
29.            (cond
    
30.              ((equal  (car list1) (car list2));起点 起点
    
31.                (setq lst (append (reverse list1) (cdr list2)))
    
32.              )
    
33.              ((equal  (car list1) (car(reverse list2))) ;起点 终点
    
34.                 (setq lst (append list2 (cdr list1)))
    
35.              )
    
36.              ((equal  (car (reverse list1)) (car list2)) ;终点 起点
    
37.                 (setq lst (append list1 (cdr list1)))
    
38.              )
    
39.              ((equal  (car (reverse list1)) (car (reverse list2)));终点 终点
    
40.                 (setq lst (append list2 (cdr(reverse list1))))
    
41.                    )
    
42.              (t (alert"两条3D多段线没有交点"))
    
43.            )
    
44.            (if lst
    
45.                    (progn
    
46.                            (mk3DPOLYLINE LST)
    
47.                            (entdel ent1)
    
48.                            (entdel ent2)
    
49.                            (princ "\n 连接成功")
    
50.                           )
    
51.                         )
    
52.    )
    
53.    (princ "\n 坑爹嘞！")
    
54.   )
    
55.         (PRINC)
    
56. )

(vl-load-com)<br /> ;;46.2 [功能] pline,lwpline点坐标表  By 无痕<br /> ;;示例(vxs (car (entsel))),返回三维点坐标<br /> (defun vxs (e / i v lst)<br />   (setq i -1)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst)<br /> )<br /> ;三维点表绘制3D多段线<br /> (defun mk3DPOLYLINE(ptlst)<br />    (entmake (list '(0 . "POLYLINE") '(100 . "AcDbEntity") '(100 . "AcDb3dPolyline") '(66 . 1) '(70 . 8)))<br />    (foreach pt ptlst (entmake (list '(0 . "vertex") (cons 10 pt) '(70 . 32))))<br />    (entmake '((0 . "seqend")))<br /> )<br /> ;==========================<br /> ;连接两条三维多段线 by 77077<br /> (defun c:XX(/ ent1 ent2 list1 list2 lst)<br />         (princ "\n 连接两条3D多段线")<br /> (if (and (setq ent1(CAR(entsel "\n 选择第一条3D多段线")))<br />                 (setq ent2(CAR(entsel "\n 选择第二条3D多段线")))<br />                 (setq list1 (vxs ent1))<br />                 (setq list2 (vxs ent2))<br />               )<br />          (progn<br />            (cond<br />              ((equal  (car list1) (car list2));起点 起点<br />                (setq lst (append (reverse list1) (cdr list2)))<br />              )<br />              ((equal  (car list1) (car(reverse list2))) ;起点 终点<br />                 (setq lst (append list2 (cdr list1)))<br />              )<br />              ((equal  (car (reverse list1)) (car list2)) ;终点 起点<br />                 (setq lst (append list1 (cdr list1)))<br />              )<br />              ((equal  (car (reverse list1)) (car (reverse list2)));终点 终点<br />                 (setq lst (append list2 (cdr(reverse list1))))<br />                    )<br />              (t (alert"两条3D多段线没有交点"))<br />            )<br />            (if lst<br />                    (progn<br />                            (mk3DPOLYLINE LST)<br />                            (entdel ent1)<br />                            (entdel ent2)<br />                            (princ "\n 连接成功")<br />                           )<br />                         )<br />    )<br />    (princ "\n 坑爹嘞！")<br />   )<br />         (PRINC)<br /> )

gzbccy

77077 发表于 2015-11-25 09:24

大神好久不见啊, 最近闭关修练?  有什么大作? 分享下啦