[求助]：如何提取出pline线的坐标

ruansr

如何提取出一条闭合的pline线的坐标，形成一个文本文件。

cdhua001

选定多段线——命令“LI”

ruansr

有时 li 得到的坐标列表不像上述所列的那样规则。

XDSoft

给你写个简单的程序，演示。

屏幕上打印出每个顶点的坐标。程序请在晓东工具箱下运行，程序对POLYLINE和LWPOLYLINE都起作用。

2. [font=courier]
   
3. (defun c:getPlVerts (/ e cls p1 num pl)
   
4.   (if (setq e (car (xdrx_entsel "\n请选择一条多义线<退出>:" '((0 . "*polyline")))))
   
5.     (progn
   
6.       (setq cls (xdrx_object_classname e))
   
7.       (if (= "POLYLINE" (car cls))
   
8.         (progn
   
9.           (xdrx_polyline_ConvertFrom e)
   
10.           (setq e (entlast))
    
11.         )
    
12.       )
    
13.       (setq num (xdrx_polyline_NumVerts e)
    
14.             i -1
    
15.       )
    
16.       (repeat num
    
17.         (setq p1 (xdrx_polyline_getPointAt e (setq i (1+ i)))
    
18.               pl (cons p1 pl)
    
19.         )
    
20.       )
    
21.       (princ (reverse pl))
    
22.     )
    
23.   )
    
24. )
    
25. [/font]
    

[font=courier]<br /> (defun c:getPlVerts (/ e cls p1 num pl)<br />   (if (setq e (car (xdrx_entsel "\n请选择一条多义线<退出>:" '((0 . "*polyline")))))<br />     (progn<br />       (setq cls (xdrx_object_classname e))<br />       (if (= "POLYLINE" (car cls))<br />         (progn<br />           (xdrx_polyline_ConvertFrom e)<br />           (setq e (entlast))<br />         )<br />       )<br />       (setq num (xdrx_polyline_NumVerts e)<br />             i -1<br />       )<br />       (repeat num<br />         (setq p1 (xdrx_polyline_getPointAt e (setq i (1+ i)))<br />               pl (cons p1 pl)<br />         )<br />       )<br />       (princ (reverse pl))<br />     )<br />   )<br /> )<br /> [/font]<br />

示例：

1. [font=courier]
   
2. 命令:  GETPLVERTS
   
3. 请选择一条多义线<退出>:((38383.4 15577.2 0.0) (45376.7 15577.2 0.0) (45376.7
   
4. 8328.85 0.0) (42197.9 8328.85 0.0))((38383.4 15577.2 0.0) (45376.7 15577.2 0.0)
   
5. (45376.7 8328.85 0.0) (42197.9 8328.85 0.0))
   
6. [/font]

复制代码

ruansr

再请教：
1。POLYLINE 和 LWPOLYLINE有何区别？
2。如何在贴子上贴图？

XDSoft

最初由 ruansr 发布
[B]再请教：
1。POLYLINE 和 LWPOLYLINE有何区别？
2。如何在贴子上贴图？ [/B]

POLYLINE是复杂实体（不单独），有顶点VERTEX组成，LWPOLYLINE是R14后新加的实体，是单独的实体，所有顶点信息都在实体内保存。

具体你看看ACAD的连机帮助。

贴图，你在发贴界面，上传文件里面，选上你硬盘的JPG,GIF,DWF等等，就贴到论坛来了，和传普通的ZIP,RAR文件等没有区别。

ruansr

我在第二贴中用上传附件的方法贴的图为什么没有像cdhua001贴的图那样直接显示出来呢？

XDSoft

最初由 ruansr 发布
[B]我在第二贴中用上传附件的方法贴的图为什么没有像cdhua001贴的图那样直接显示出来呢？ [/B]

你要点上传附件旁边的“浏览”，去选你硬盘的JPG,GIF等文件。

ruansr

用上述方法得到的坐标表还是不整齐，不利于打印输出，最好能做成以下格式：
x1,y1
x2,y2
...

Laoyao

VBA

2. 
   
3.   [FONT=courier new]
   
4. Sub getPLPoints()
   
5.     Dim reObj As AcadObject
   
6.     Dim reobj1 As AcadPolyline
   
7.     Dim basePoint As Variant
   
8.     Dim curPoint As Variant
   
9.     'Dim totalPoints As Long
   
10.    
    
11.     ThisDrawing.Utility.GetEntity reObj, basePoint, "please select a polyline: "
    
12.     If reObj.ObjectName = "AcDbPolyline" Then
    
13.         curPoint = reObj.Coordinates
    
14.         A = UBound(curPoint)
    
15.         
    
16.         For I = 0 To A - 1 Step 2
    
17.             Debug.Print "POINT" + Str((I + 2) / 2) + ":  X=" + Str(curPoint(I)) + "  ,   Y=" + Str(curPoint(I + 1))
    
18.         Next
    
19.         
    
20.     End If
    
21.    
    
22. End Sub
    
23. 
    
24.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub getPLPoints()<br />     Dim reObj As AcadObject<br />     Dim reobj1 As AcadPolyline<br />     Dim basePoint As Variant<br />     Dim curPoint As Variant<br />     'Dim totalPoints As Long<br />     <br />     ThisDrawing.Utility.GetEntity reObj, basePoint, "please select a polyline: "<br />     If reObj.ObjectName = "AcDbPolyline" Then<br />         curPoint = reObj.Coordinates<br />         A = UBound(curPoint)<br />         <br />         For I = 0 To A - 1 Step 2<br />             Debug.Print "POINT" + Str((I + 2) / 2) + ":  X=" + Str(curPoint(I)) + "  ,   Y=" + Str(curPoint(I + 1))<br />         Next<br />         <br />     End If<br />     <br /> End Sub<br /> <br />   [/FONT]<br />

ruansr

如何使用上面的VBA程序呢？

jsun007

;取多义线端点坐标
(defun c:plid ()
       (setq name (getstring "\n File name:"))
       (setq ent_b (entget (ssname (ssget) 0)))
       (setq ffile (open name "w"))
       (setq ent_pb (assoc 10 ent_b))
       (while (/= ent_pb nil)
          (progn
              (setq px (nth 1 ent_pb))
              (setq py (nth 2 ent_pb))
              (setq pxx (rtos px 2 6))
              (setq pyy (rtos py 2 6))
              (setq dataxy (strcat pxx " " pyy))
              (write-line dataxy ffile)
              (setq newlt (list px py))
              (setq ent_b (subst (cons 1 newlt) (assoc 10 ent_b) ent_b))
              (setq ent_pb (assoc 10 ent_b))   
         )
      )
      (close ffile)
      (princ)
)
(prompt "...loaded. --- 金鑫土木 ----   2004.2.22 ------  ")

weijie

没学过编程,以后网站开了编程学习班的时候我去学习