菜鸟的练习程序-----[选择线条输出坐标]

sunnylhj

因工作需要，写了这样的一个程序！请各前辈们不要见笑！

2. ;子函數，世界坐標轉換成用戶坐標  
   
3. (prompt "\n[OO] -- Export line(s) ordinate datas By . ShingYatChun")
   
4. (defun wtu (pt)
   
5.   (trans pt 0 1)
   
6.   )
   
7. (defun desame (lst / a ll) ;;;表中去除重复元素
   
8.   (while lst(setq a (car lst) lst (vl-remove a lst) ll (cons a ll)))
   
9.   (reverse ll)
   
10. )
    
11. (defun c:oo (/ pt lst ba p10 p11 sslen i n r h ent data)
    
12. (princ "\n>>> Program processing is start ...")
    
13. (prompt "\n>>> Select objects marking ...")
    
14. (setq ss (ssget '((0 . "*LINE")))
    
15.     i 0)
    
16. (setq sslen (sslength ss))
    
17. (setq osmode (getvar "osmode"))
    
18. ;;-----------輸出的座標類型-----------
    
19. (initget "World Ucs")
    
20. (setq ucs (getkword "\Export ordinate type [World/Ucs] <World>:"))
    
21. (if (= ucs nil)
    
22.   (setq ucs "World")
    
23.   )
    
24. ;;------------------------------------
    
25. (repeat sslen
    
26.   (setq ent (ssname ss i))
    
27.   (cond
    
28.     ((= (cdr (assoc 0 (entget ent))) "LINE")
    
29.       (setq p10 (cdr (assoc 10 (entget ent)))
    
30.             p11 (cdr (assoc 11 (entget ent)))
    
31.         )
    
32.       (setq lst (append lst (list p10) (list p11)))
    
33.     )
    
34.    
    
35.     ((or (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (= (cdr (assoc 0 (entget ent))) "SPLINE") )
    
36.       (setq ssdata (entget ent) s 0 )
    
37.       (repeat (length ssdata)
    
38.         (setq pp (nth s ssdata)
    
39.               key (car pp))
    
40.         (if (= key 10)
    
41.           (setq lst (append lst (list (cdr pp))))
    
42.         )
    
43.         ;(setq lst (append lst (list lst)))
    
44.         (setq s (1+ s))
    
45.       )
    
46.     )
    
47.    
    
48.     ((= (cdr (assoc 0 (entget ent))) "POLYLINE")      
    
49.       (setq s 0 )
    
50.       (while (/= (vlax-curve-getPointAtParam ent s) nil)
    
51.         (setq lst (append lst (list (vlax-curve-getPointAtParam ent s)))
    
52.             s (1+ s)
    
53.           )
    
54.       )
    
55.     )   
    
56.   )
    
57.   (setq i (1+ i))  
    
58.   )
    
59.   (if (/= (desame lst) nil)
    
60.     (setq lst (desame lst))
    
61.     );;刪除重複的元素
    
62.   (setq n 0 )
    
63.     (repeat (length lst)
    
64.       (setq ;ba (wtu (nth n lst)) ;;定義文字插入點
    
65.             data (nth n lst)
    
66.           )
    
67. ;;---------判斷座標輸出類型----------
    
68.       (if (= ucs "Ucs")
    
69.         (setq data (wtu data))
    
70.         )
    
71. ;;------------------------------------
    
72.       (if (= (length data) 2)
    
73.         (setq data (list (nth 0 data) (nth 1 data) 0))
    
74.         )
    
75.       (setq cm (strcat (rtos (nth 0 data)) "," (rtos (nth 1 data)) "," (rtos (nth 2 data))))
    
76.       ;(setvar "osmode" 0)
    
77.       (vl-cmdf "ucs" "na" "d" "orucs" ;;刪除原座標
    
78.                "ucs" "na" "s" "orucs" ;;保存原座標
    
79.              "ucs" "v") ;;切換UCS到正方向方便字體顯示
    
80.       (setq ba (wtu (nth n lst))) ;;定義文字插入點
    
81.         (vl-cmdf "-MTEXT" ba "J" "MC" "W" "0" cm "")
    
82.       (vl-cmdf "ucs" "na" "r" "orucs") ;;恢復原座標
    
83.       (setq n (1+ n))
    
84.     )
    
85. (setvar "osmode" osmode)
    
86. (princ (strcat "\n>>> Program processing is complete , " (rtos sslen 2) " objects finish ! <<<"))
    
87. (prin1)
    
88. )
    

;子函數，世界坐標轉換成用戶坐標  <br /> (prompt "\n[OO] -- Export line(s) ordinate datas By . ShingYatChun")<br /> (defun wtu (pt)<br />   (trans pt 0 1)<br />   )<br /> (defun desame (lst / a ll) ;;;表中去除重复元素<br />   (while lst(setq a (car lst) lst (vl-remove a lst) ll (cons a ll)))<br />   (reverse ll)<br /> )<br /> (defun c:oo (/ pt lst ba p10 p11 sslen i n r h ent data)<br /> (princ "\n>>> Program processing is start ...")<br /> (prompt "\n>>> Select objects marking ...")<br /> (setq ss (ssget '((0 . "*LINE")))<br />     i 0)<br /> (setq sslen (sslength ss))<br /> (setq osmode (getvar "osmode"))<br /> ;;-----------輸出的座標類型-----------<br /> (initget "World Ucs")<br /> (setq ucs (getkword "\Export ordinate type [World/Ucs] <World>:"))<br /> (if (= ucs nil)<br />   (setq ucs "World")<br />   )<br /> ;;------------------------------------<br /> (repeat sslen<br />   (setq ent (ssname ss i))<br />   (cond<br />     ((= (cdr (assoc 0 (entget ent))) "LINE")<br />       (setq p10 (cdr (assoc 10 (entget ent)))<br />             p11 (cdr (assoc 11 (entget ent)))<br />         )<br />       (setq lst (append lst (list p10) (list p11)))<br />     )<br />     <br />     ((or (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (= (cdr (assoc 0 (entget ent))) "SPLINE") )<br />       (setq ssdata (entget ent) s 0 )<br />       (repeat (length ssdata)<br />         (setq pp (nth s ssdata)<br />               key (car pp))<br />         (if (= key 10)<br />           (setq lst (append lst (list (cdr pp))))<br />         )<br />         ;(setq lst (append lst (list lst)))<br />         (setq s (1+ s))<br />       )<br />     )<br />     <br />     ((= (cdr (assoc 0 (entget ent))) "POLYLINE")      <br />       (setq s 0 )<br />       (while (/= (vlax-curve-getPointAtParam ent s) nil)<br />         (setq lst (append lst (list (vlax-curve-getPointAtParam ent s)))<br />             s (1+ s)<br />           )<br />       )<br />     )    <br />   )<br />   (setq i (1+ i))  <br />   )<br />   (if (/= (desame lst) nil)<br />     (setq lst (desame lst))<br />     );;刪除重複的元素<br />   (setq n 0 )<br />     (repeat (length lst)<br />       (setq ;ba (wtu (nth n lst)) ;;定義文字插入點<br />             data (nth n lst)<br />           )<br /> ;;---------判斷座標輸出類型----------<br />       (if (= ucs "Ucs")<br />         (setq data (wtu data))<br />         )<br /> ;;------------------------------------<br />       (if (= (length data) 2)<br />         (setq data (list (nth 0 data) (nth 1 data) 0))<br />         )<br />       (setq cm (strcat (rtos (nth 0 data)) "," (rtos (nth 1 data)) "," (rtos (nth 2 data))))<br />       ;(setvar "osmode" 0)<br />       (vl-cmdf "ucs" "na" "d" "orucs" ;;刪除原座標<br />                "ucs" "na" "s" "orucs" ;;保存原座標<br />              "ucs" "v") ;;切換UCS到正方向方便字體顯示<br />       (setq ba (wtu (nth n lst))) ;;定義文字插入點<br />         (vl-cmdf "-MTEXT" ba "J" "MC" "W" "0" cm "")<br />       (vl-cmdf "ucs" "na" "r" "orucs") ;;恢復原座標<br />       (setq n (1+ n))<br />     )<br /> (setvar "osmode" osmode)<br /> (princ (strcat "\n>>> Program processing is complete , " (rtos sslen 2) " objects finish ! <<<"))<br /> (prin1)<br /> )<br />

琴剑江山_10184

dwg001

－－－－啥用途？

lty

是线条的拐点坐标吧?

2侃刀2