sunnylhj 发表于 2014-9-20 10:30:58

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

因工作需要,写了这样的一个程序!请各前辈们不要见笑!;子函數,世界坐標轉換成用戶坐標
(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)
)



琴剑江山_10184 发表于 2014-9-20 15:49:59

dwg001 发表于 2014-9-20 16:16:51

----啥用途?

lty 发表于 2014-9-20 19:14:40

是线条的拐点坐标吧?

2侃刀2 发表于 2023-7-31 18:24:51

页: [1]
查看完整版本: 菜鸟的练习程序-----[选择线条输出坐标]