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