[必看]：急用，请高手指教！！！

yttrelq

怎样将CAD中的线段坐标和长度，保存成文件？线段是选中的线段。*-*3 *-*3 *-*3 *-*3

雪山飞狐(lzh)

VBA代码

2. 
   
3. Sub wl()
   
4. On Error Resume Next
   
5. Dim ss As AcadSelectionSet
   
6. Dim ft(0) As Integer, fd(0)
   
7. Dim pfCount As Integer
   
8. Dim i As AcadLine
   
9. Dim str As String
   
10. pfCount = ThisDrawing.PickfirstSelectionSet.Count
    
11. ThisDrawing.SelectionSets("tlstest").Delete
    
12. Set ss = ThisDrawing.SelectionSets.Add("tlstest")
    
13. ft(0) = 0: fd(0) = "Line"
    
14. If pfCount = 0 Then
    
15.     ss.SelectOnScreen ft, fd
    
16. Else
    
17.     ss.Select acSelectionSetPrevious, , , ft, fd
    
18. End If
    
19. Open "c:\1.txt" For Binary As #1
    
20. str = ""
    
21. For Each i In ss
    
22. str = str & i.StartPoint(0) & "," & i.StartPoint(1) & "," & i.StartPoint(2)
    
23. str = str & "@"
    
24. str = str & i.EndPoint(0) & "," & i.EndPoint(1) & "," & i.EndPoint(2)
    
25. str = str & "@"
    
26. str = str & CStr(i.length)
    
27. str = str & vbCrLf
    
28. Next i
    
29. Debug.Print str
    
30. Put #1, , str
    
31. Close #1
    
32. End Sub
    

<br /> Sub wl()<br /> On Error Resume Next<br /> Dim ss As AcadSelectionSet<br /> Dim ft(0) As Integer, fd(0)<br /> Dim pfCount As Integer<br /> Dim i As AcadLine<br /> Dim str As String<br /> pfCount = ThisDrawing.PickfirstSelectionSet.Count<br /> ThisDrawing.SelectionSets("tlstest").Delete<br /> Set ss = ThisDrawing.SelectionSets.Add("tlstest")<br /> ft(0) = 0: fd(0) = "Line"<br /> If pfCount = 0 Then<br />     ss.SelectOnScreen ft, fd<br /> Else<br />     ss.Select acSelectionSetPrevious, , , ft, fd<br /> End If<br /> Open "c:\1.txt" For Binary As #1<br /> str = ""<br /> For Each i In ss<br /> str = str & i.StartPoint(0) & "," & i.StartPoint(1) & "," & i.StartPoint(2)<br /> str = str & "@"<br /> str = str & i.EndPoint(0) & "," & i.EndPoint(1) & "," & i.EndPoint(2)<br /> str = str & "@"<br /> str = str & CStr(i.length)<br /> str = str & vbCrLf<br /> Next i<br /> Debug.Print str<br /> Put #1, , str<br /> Close #1<br /> End Sub<br />

Lisp代码

2. 
   
3. (defun tls-sub2cmd(filename subname cmdname)
   
4. (eval
   
5.   (list 'defun
   
6.    (read (strcat "c:" cmdname))
   
7.    nil
   
8.    (list 'vla-RunMacro '(vlax-get-acad-object) (strcat filename "!" subname))
   
9.    (princ)
   
10.   )
    
11. )
    
12. (vlax-add-cmd cmdname (strcat "C:" cmdname))
    
13. '(princ)
    
14. )
    
15. (tls-sub2cmd "tlscad.dvb" "wl" "wl")
    

<br /> (defun tls-sub2cmd(filename subname cmdname)<br /> (eval<br />   (list 'defun<br />    (read (strcat "c:" cmdname))<br />    nil<br />    (list 'vla-RunMacro '(vlax-get-acad-object) (strcat filename "!" subname))<br />    (princ)<br />   )<br /> )<br /> (vlax-add-cmd cmdname (strcat "C:" cmdname))<br /> '(princ)<br /> )<br /> (tls-sub2cmd "tlscad.dvb" "wl" "wl")<br />

yttrelq

谢谢斑竹