[LISP函数-点集]： 给点表，绘制PLINE

eachy

2. 
   
3. ;|
   
4.    给点表，绘制PLINE，封闭
   
5. |;
   
6. (defun $XDLSP_Draw_Pline (pts tf)
   
7.                                         ;(xdrx_sysVar_push "osmode")
   
8.   (setvar "osmode" 0)
   
9.   (apply
   
10.     'command
    
11.     (cons "pline" pts)
    
12.   )
    
13.   (if tf
    
14.     (command "c")
    
15.     (command "")
    
16.   )
    
17.                                         ;(xdrx_sysVar_pop)
    
18. )
    
19. (defun xd-mkpline (pts tf)
    
20.   (entmake
    
21.     (append
    
22.       '((0 . "lwpolyline") (100 . "AcDbEntity") (100 . "AcDbPolyline"))
    
23.       (list (cons 90 (length pts)))
    
24.       (list (cons 70
    
25.                   (if tf
    
26.                     1
    
27.                     0
    
28.                   )
    
29.             )
    
30.       )
    
31.       (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pts)
    
32.     )
    
33.   )
    
34. )

<br /> ;|<br />    给点表，绘制PLINE，封闭<br /> |;<br /> (defun $XDLSP_Draw_Pline (pts tf)<br />                                         ;(xdrx_sysVar_push "osmode")<br />   (setvar "osmode" 0)<br />   (apply<br />     'command<br />     (cons "pline" pts)<br />   )<br />   (if tf<br />     (command "c")<br />     (command "")<br />   )<br />                                         ;(xdrx_sysVar_pop)<br /> )<br /> (defun xd-mkpline (pts tf)<br />   (entmake<br />     (append<br />       '((0 . "lwpolyline") (100 . "AcDbEntity") (100 . "AcDbPolyline"))<br />       (list (cons 90 (length pts)))<br />       (list (cons 70<br />                   (if tf<br />                     1<br />                     0<br />                   )<br />             )<br />       )<br />       (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pts)<br />     )<br />   )<br /> )

它山之石

这是个简单的
只是把线画出来
不如ea的可以指定图层什么的

[php]
(defun pts2PL ( pts)
  (vl-cmdf "pline")
  ;;  (mapcar '(lambda (x) (vl-cmdf x)) pts)
  (mapcar 'vl-cmdf pts)
  ;;如果下面最后这样 就多一个顶点
  ;;(vl-cmdf (car pts) "")
  ;;下面这样闭合
   (vl-cmdf "c")
)

[/php]

taner

2. 
   
3.   [FONT=courier new]
   
4. ;;;[url]http://www.theswamp.org/index.php?topic=20575.0[/url]
   
5. ;;  Expects pts to be a list of 2D or 3D points
   
6. ;;  Returns the ename of the new pline object
   
7. (defun makePline (pts                        ; list of points
   
8.                   closed                ; 1 for closed 0 overwise
   
9.                   layer                        ; if new layer entmake will create it
   
10.                   ;;  must be a valid layer name
    
11.                   / zdir elv)
    
12.   ;; catch nil layer name - CAB added
    
13.   (or layer (setq layer (getvar "CLAYER")))
    
14. 
    
15.   (setq        zdir (trans '(0 0 1) 1 0 t)
    
16.         elv  (caddr (trans (car pts) 1 zdir))
    
17.   )
    
18.   (entmakex                                ; CAB added x
    
19.     (append
    
20.       (list '(0 . "LWPOLYLINE")
    
21.             '(100 . "AcDbEntity")
    
22.             '(100 . "AcDbPolyline")
    
23.             (cons 8 layer)                ; CAB added
    
24.             (cons 90 (length pts))
    
25.             (cons 70 closed)                ; 1 for closed 0 overwise
    
26.             (cons 38 elv)
    
27.             (cons 210 zdir)
    
28.       )
    
29.       (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) pts)
    
30.     )
    
31.   )
    
32. )  [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;[url]http://www.theswamp.org/index.php?topic=20575.0[/url]<br /> ;;  Expects pts to be a list of 2D or 3D points<br /> ;;  Returns the ename of the new pline object<br /> (defun makePline (pts                        ; list of points<br />                   closed                ; 1 for closed 0 overwise<br />                   layer                        ; if new layer entmake will create it<br />                   ;;  must be a valid layer name<br />                   / zdir elv)<br />   ;; catch nil layer name - CAB added<br />   (or layer (setq layer (getvar "CLAYER")))<br /> <br />   (setq        zdir (trans '(0 0 1) 1 0 t)<br />         elv  (caddr (trans (car pts) 1 zdir))<br />   )<br />   (entmakex                                ; CAB added x<br />     (append<br />       (list '(0 . "LWPOLYLINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbPolyline")<br />             (cons 8 layer)                ; CAB added<br />             (cons 90 (length pts))<br />             (cons 70 closed)                ; 1 for closed 0 overwise<br />             (cons 38 elv)<br />             (cons 210 zdir)<br />       )<br />       (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) pts)<br />     )<br />   )<br /> )  [/FONT]<br />

晓希

学习一下，我想用pline画个东西，一天没实现，很失败。

yjch

大有用处，谢谢楼主

zhangjianjie630

找了很久，很开心

tzfcn

不错，很好的代码。

warrior2020

小白，看不太懂。简要说一下具体功能就好了