闭合平行线！

cjjh8301

求小程序，能闭合2条平行的多段线！

叮咚

1. (vl-load-com)
   
2. (defun lwpts(lwen / lwdt)
   
3.         (setq lwdt (entget lwen))
   
4.         (vl-remove-if-not '(lambda(e1) (equal (car e1) 10)) lwdt)
   
5. )
   
6. (defun c:bh()
   
7.         (prompt "\nSelect 2 lwpolylines:")
   
8.         (setq ss (ssget '((0 . "lwpolyline"))))
   
9.         (or ss (setq ss (ssadd)))
   
10.         (setq len (sslength ss) m 0)
    
11.         (if (/= len 2)
    
12.                 (princ "\n不是2根! ---程序退出......")
    
13.                 (progn
    
14.                         (setq en1 (ssname ss 0) en2 (ssname ss 1))
    
15.                         (setq data1 (lwpts en1) data2 (lwpts en2))
    
16.                         (setq pt1 (cdar data1) pt2 (cdr (last data1)))
    
17.                         (setq pt3 (cdar data2) pt4 (cdr (last data2)))
    
18.                         (setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))
    
19.                         (if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))
    
20.                         (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
    
21.                         (setq ss (ssadd (entlast) ss))
    
22.                         (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
    
23.                         (setq ss (ssadd (entlast) ss))
    
24.                         (setvar "cmdecho" 0)
    
25.                         (setvar "peditaccept" 1)
    
26.                         (command "pedit" "m"  ss "" "j" "" "")
    
27.                         (setvar "peditaccept" 0)
    
28.                         (setvar "cmdecho" 1)
    
29.                 )
    
30.         )
    
31.         (princ)
    
32. )

(vl-load-com)<br /> (defun lwpts(lwen / lwdt)<br />         (setq lwdt (entget lwen))<br />         (vl-remove-if-not '(lambda(e1) (equal (car e1) 10)) lwdt)<br /> )<br /> (defun c:bh()<br />         (prompt "\nSelect 2 lwpolylines:")<br />         (setq ss (ssget '((0 . "lwpolyline"))))<br />         (or ss (setq ss (ssadd)))<br />         (setq len (sslength ss) m 0)<br />         (if (/= len 2)<br />                 (princ "\n不是2根! ---程序退出......")<br />                 (progn<br />                         (setq en1 (ssname ss 0) en2 (ssname ss 1))<br />                         (setq data1 (lwpts en1) data2 (lwpts en2))<br />                         (setq pt1 (cdar data1) pt2 (cdr (last data1)))<br />                         (setq pt3 (cdar data2) pt4 (cdr (last data2)))<br />                         (setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))<br />                         (if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))<br />                         (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))<br />                         (setq ss (ssadd (entlast) ss))<br />                         (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))<br />                         (setq ss (ssadd (entlast) ss))<br />                         (setvar "cmdecho" 0)<br />                         (setvar "peditaccept" 1)<br />                         (command "pedit" "m"  ss "" "j" "" "")<br />                         (setvar "peditaccept" 0)<br />                         (setvar "cmdecho" 1)<br />                 )<br />         )<br />         (princ)<br /> )

yunfengning

不错，但能不能改成支持LINE线？

cjjh8301

可以了谢谢！

cjjh8301

能不能加点，闭合后同时填充上，图案名称是  ANSI36  那个！

ZZXXQQ

cjjh8301 发表于 2015-6-24 09:22
能不能加点，闭合后同时填充上，图案名称是  ANSI36  那个！

2. (vl-load-com)
   
3. (defun lwpts (lwen)
   
4. (vl-remove-if-not '(lambda(a) (= (car a) 10)) (entget lwen))
   
5. )
   
6. (defun c:bh()
   
7. (prompt "\nSelect 2 lwpolylines:")
   
8. (if (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
9.           (= (sslength ss) 2)) (progn
   
10.   (setq en1 (ssname ss 0) en2 (ssname ss 1))
    
11.   (setq data1 (lwpts en1) data2 (lwpts en2))
    
12.   (setq pt1 (cdar data1) pt2 (cdr (last data1)))
    
13.   (setq pt3 (cdar data2) pt4 (cdr (last data2)))
    
14.   (setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))
    
15.   (if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))
    
16.   (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
    
17.   (ssadd (entlast) ss)
    
18.   (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
    
19.   (ssadd (entlast) ss)
    
20.   (setvar "cmdecho" 0)
    
21.   (setvar "peditaccept" 1)
    
22.   (command "_.pedit" "m" ss "" "j" "" "")
    
23.   (command "_.HATCH" "ANSI36" "" "" "L" "")
    
24.   (setvar "peditaccept" 0)
    
25.   (setvar "cmdecho" 1)
    
26. )
    
27.   (princ "\n不是2根! ---程序退出......")
    
28. )
    
29. (princ)
    
30. )

(vl-load-com)<br /> (defun lwpts (lwen)<br /> (vl-remove-if-not '(lambda(a) (= (car a) 10)) (entget lwen))<br /> )<br /> (defun c:bh()<br /> (prompt "\nSelect 2 lwpolylines:")<br /> (if (and (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />           (= (sslength ss) 2)) (progn<br />   (setq en1 (ssname ss 0) en2 (ssname ss 1))<br />   (setq data1 (lwpts en1) data2 (lwpts en2))<br />   (setq pt1 (cdar data1) pt2 (cdr (last data1)))<br />   (setq pt3 (cdar data2) pt4 (cdr (last data2)))<br />   (setq dis1 (distance pt1 pt3) dis2 (distance pt1 pt4))<br />   (if (> dis1 dis2)(setq ptx pt3 pt3 pt4 pt4 ptx ptx nil))<br />   (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))<br />   (ssadd (entlast) ss)<br />   (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))<br />   (ssadd (entlast) ss)<br />   (setvar "cmdecho" 0)<br />   (setvar "peditaccept" 1)<br />   (command "_.pedit" "m" ss "" "j" "" "")<br />   (command "_.HATCH" "ANSI36" "" "" "L" "")<br />   (setvar "peditaccept" 0)<br />   (setvar "cmdecho" 1)<br /> )<br />   (princ "\n不是2根! ---程序退出......")<br /> )<br /> (princ)<br /> )

cjjh8301

ZZXXQQ 发表于 2015-6-24 14:59

命令后 ，选不中线

yoyoho

"LWPOYLINE"改"LWPOLYLINE"

cjjh8301

yoyoho 发表于 2015-6-25 11:47
"LWPOYLINE"改"LWPOLYLINE"

可以了，谢谢！