按次序选线，最后生成闭合多段线~

77077

按次选线，动态生成可围合成的多段线。如图，白色线是已知线条，按次序选择，动态生成红色闭合多段线。

77077

黄老师的研究，个人觉得应该可以移植下~
http://bbs.xdcad.org/forum.php?m ... page%3D1#pid3533383

2. 
   
3. ;;[功能] 画封闭多边形----------脱了裤子放屁
   
4. (defun C:w1 (/ PTS)
   
5.   (cond ((setq pts (HH::getPoints)) (MakeXLWPOLYLINE pts)))
   
6. )
   
7. 
   
8. ;;[功能] 取点函数
   
9. (defun HH::getPoints (/ CODE FLAG P0 PT PT1 X Y)
   
10.   (while (and (setq code (grread T 8)) (or (= (car code) 3) (= (car code) 5)))
    
11.     (cond ((= (car code) 3) (setq pt (cons (cadr code) pt))))
    
12.     (redraw)
    
13.     (cond
    
14.       ((> (length pt) 1)
    
15.        (setq pt1 (cons (cadr code) pt))
    
16.        (setq pt1 (cons p0 pt1))
    
17.        (mapcar '(lambda (x y) (grdraw x y 1)) pt1 (cdr pt1))
    
18.       )
    
19.       ((equal (length pt) 1) (setq p0 (car pt)) (grdraw p0 (cadr code) 1))
    
20.       (T
    
21.        (cond ((not Flag) (setq Flag T) (princ "\n 点取起点")))
    
22.       )
    
23.     )
    
24.   )
    
25.   (redraw)
    
26.   (cond ((> (length pt) 2) (reverse pt)))
    
27. )
    
28. ;;http://bbs.xdcad.net/thread-673261-1-1.html
    
29. ;;167.3 [功能] Entmake点表生成多段线
    
30. (defun MakeXLWPOLYLINE (lst / PT)
    
31.   (entmakeX
    
32.     (append
    
33.       (list '(0 . "LWPOLYLINE")
    
34.             '(100 . "AcDbEntity")
    
35.             '(100 . "AcDbPolyline")
    
36.             (cons 90 (length lst))
    
37.             '(70 . 1)
    
38.       )
    
39.       (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
40.     )
    
41.   )
    
42. )

<br /> ;;[功能] 画封闭多边形----------脱了裤子放屁<br /> (defun C:w1 (/ PTS)<br />   (cond ((setq pts (HH::getPoints)) (MakeXLWPOLYLINE pts)))<br /> )<br /> <br /> ;;[功能] 取点函数<br /> (defun HH::getPoints (/ CODE FLAG P0 PT PT1 X Y)<br />   (while (and (setq code (grread T 8)) (or (= (car code) 3) (= (car code) 5)))<br />     (cond ((= (car code) 3) (setq pt (cons (cadr code) pt))))<br />     (redraw)<br />     (cond<br />       ((> (length pt) 1)<br />        (setq pt1 (cons (cadr code) pt))<br />        (setq pt1 (cons p0 pt1))<br />        (mapcar '(lambda (x y) (grdraw x y 1)) pt1 (cdr pt1))<br />       )<br />       ((equal (length pt) 1) (setq p0 (car pt)) (grdraw p0 (cadr code) 1))<br />       (T<br />        (cond ((not Flag) (setq Flag T) (princ "\n 点取起点")))<br />       )<br />     )<br />   )<br />   (redraw)<br />   (cond ((> (length pt) 2) (reverse pt)))<br /> )<br /> ;;http://bbs.xdcad.net/thread-673261-1-1.html<br /> ;;167.3 [功能] Entmake点表生成多段线<br /> (defun MakeXLWPOLYLINE (lst / PT)<br />   (entmakeX<br />     (append<br />       (list '(0 . "LWPOLYLINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbPolyline")<br />             (cons 90 (length lst))<br />             '(70 . 1)<br />       )<br />       (mapcar '(lambda (pt) (cons 10 pt)) lst)<br />     )<br />   )<br /> )

iLisp

bpoly命令不成？

77077

iLisp 发表于 2014-10-19 14:00
bpoly命令不成？

不想被干扰，再说个人觉得用黄大师的，能随时预览结果！

jxjaxa

77077 发表于 2014-10-19 13:44
黄老师的研究，个人觉得应该可以移植下~
http://bbs.xdcad.org/forum.php?mod=viewthread&tid=676508&pid= ...

感谢分享，努力学习！！！！！！！！