AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Oooo-110 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Oo-2-110 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Ia15010 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Ziao1510 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 BPl3tjj [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Uos15010 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Uos15011

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在

向下

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Empty [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在

發表 由 RyanGuo 于 2013-08-07, 14:59

轉載來源:
How do I get the list of named groups being used in Autocad.

抓所有GROUP名稱
作者:Short, Jim
代碼:

(defun GetGroupList (/ grp grplist)
  (setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
  (while (/= (assoc 3 grp) nil)
    (setq grpList (cons (cdr (assoc 3 grp)) grpList)
     grp     (cdr (member (assoc 3 grp) grp))
    )
  ) ;_ end of while
  (reverse grpList)
) ;_ end of defun

查詢GROUP名稱是否存在
作者:puckett, michael
代碼:

(defun GroupNameExists (Name)
  (null
    (vl-catch-all-error-p
      (vl-catch-all-apply
   'vla-item
   (list
     (vla-get-groups
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
     Name
   )
      )
    )
  )
)
如果無法執行,
請在程式中加入下面程式碼.
代碼:
(vl-load-com)
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 37
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3826
威望值 : 310
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Empty [分享]LISP副程式-取得合乎規範的群組(GROUP)名稱

發表 由 RyanGuo 于 2013-08-07, 17:11

代碼:

;;;新群組名,回傳可行的GROUP NAME或預設群組名稱
;;;使用法(SETQ 群組名稱 (NEW_GROUP_NAME 是否可使用已有名稱 預設群組名稱))
;;;是否可使用已有名稱:1=可以,0=不可以
(defun NEW_GROUP_NAME (SN G_NAME / XXX)
  (princ "已有GROUP名稱為:\n")
  (princ (GETGROUPLIST))
  (while (EQ XXX NIL)
    (princ
      "\n群組名稱最長可以有 31 個字元。"
    )
    (IF   (EQ SN 0)
      (princ
   "群組名稱不可重複。"
      )
    )
    (SETQ XXX (getstring
      (strcat   "\n請輸入新群組名稱(或使用預設名稱: <"
         G_NAME
         "> ):"
      )
         )
    )               ;取得新群組名稱
    (cond
      ((EQ XXX "")
       (SETQ XXX G_NAME)
      ) ;_cond 第1 END
      ((GroupNameExists XXX)
       (progn
    (IF (EQ SN 1)
      (progn
        (initget "Y N")
        (IF
          (EQ
       (getkword
         "名稱與已有GROUP名稱相同,是否要使用這個名稱[Y/N]<N>:"
       )
       "Y"
          )
      (SETQ G_NAME XXX)
      (SETQ XXX NIL)
        ) ;_IF結束
      );_progn結束
      (SETQ XXX NIL)
    ) ;_IF結束
       ) ;_progn結束
      ) ;_cond 第2 END
      ((> (strlen XXX) 32)
       (SETQ XXX NIL)
      ) ;_cond 第3 END
      (T
       (SETQ G_NAME XXX)
      ) ;_cond 第4 END
    ) ;_cond結束
  ) ;_while結束
) ;_副程式NEW_GROUP_NAME結束

需搭配其他副程式使用:
[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在

可使用下面的程式來測試
代碼:

(defun C:TE (/ GNN)
  (SETQ GNN (NEW_GROUP_NAME 1 "預設群組名稱"))
  (princ GNN)
)
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 37
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3826
威望值 : 310
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Empty [分享]LISP副程式-取得升/降序連續整數LIST,給FOREACH用

發表 由 RyanGuo 于 2013-10-11, 09:19

在大部分的情況下可以用這個副程式配合FOREACH來取代REPEAT.
代碼:
;;回傳升/降序連續整數
;;(LIST4FOREACH n mot)
;;mot=[nil,"R","Z","RZ"]=[沒反轉沒零,反轉沒零,不反轉有零,反轉有零]
(defun LIST4FOREACH (n mot / lis)
  (IF (/= (TYPE n) 'INT)
    (progn
      (PRIN1 "副程式LIST4FOREACH發生錯誤,n不等於整數.")
      (EXIT)
    )
    (repeat (IF   (OR (= mot "Z") (= mot "RZ"))
         (1+ n)
         n
       )
      (SETQ
   lis (cons n lis)
   n   (1- n)
      )
    )
  ) ;_IF
  (IF (OR (= mot "R") (= mot "RZ"))
    (reverse lis)
    lis
  ) ;_IF
) ;_defun LIST4FOREACH
用這副程式好處只有一個,
那就是不用為了REPEAT弄一個計算運行次數的變數.
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 37
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3826
威望值 : 310
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Empty [分享]LISP副程式-list排序副程式

發表 由 RyanGuo 于 2013-10-11, 13:24

先將需要排序的LIST丟進一個LIST中,再將它丟進副程式裡面,
指定要有幾個元素排序就可以了.

使用上需要注意一點,如果需要排序的LIST中,有不需要排序的項目,
請千萬要指定排序到第幾個,免得資料發生非預期的錯誤.

代碼:
;;list排序副程式,需搭配code:str使用
;;回傳list為第1個元素開始排序到第n個,排序方式為升序
;;支援文字首字code排序
;;(sort:list list:A n)
(defun sort:list (list:A n)
  (repeat (IF (/= (TYPE n) 'INT)
       ;;n不為int時,自動抓取list:A的第一個元素數量
       (SETQ n (length (car list:A)))
       n
     )
    (SETQ n    (1- n)
     list:A (vl-sort list:A
           (function
             (lambda (E1 E2)
               (< (code:str (nth n E1)) (code:str (nth n E2)))
             ) ;_lambda
           )
       )
    )
  )
) ;_sort:list
需搭配另一個副程式才能成功運作
代碼:
;;回傳字串首字的code
;;若為int或real則回傳原本數值,其他類型回傳0
(defun code:str   (in)
  (COND
    ((= (TYPE in) 'STR)
     (ascii in)
    )
    ((OR (= (TYPE in) 'INT) (= (TYPE in) 'REAL))
     in
    )
    (T 0)
  )
) ;_code:str
在只有第1元素需要排列,且只需排序一次的情況,
直接用下面的程式就好,不需用到此副程式.
代碼:
(SETQ list:A
       (vl-sort   list:A
      (function
        (lambda (E1 E2)
          (< (code:str (nth 1 E1)) (code:str (nth 1 E2)))
        ) ;_lambda
      )
       )
)
其中的list:A是需要排序的LIST集合
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 37
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3826
威望值 : 310
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Empty [分享]LISP副程式-位元值控制副程式

發表 由 RyanGuo 于 2013-10-11, 17:02

代碼:
               ;位元值判斷,依位元值的T或NIL回傳T或NIL
;;(bw_ton 被判斷值 判斷值)
(defun bw_ton (int1 bit_code)
  (/= (logAnd int1 bit_code) 0)
) ;_bw_ton
代碼:
               ;位元值變動,回傳變動後數值
;;(bw_ex 被判斷值 判斷值)
(defun bw_ex (int1 bit_code)
  (IF (/= (logAnd int1 bit_code) 0)
    (- int1 bit_code)
    (+ int1 bit_code)
  )
) ;_bw_ex
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 37
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3826
威望值 : 310
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Uos15011 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Uos15010 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 BPl3tjj [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Ziao1510 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Ia15010 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Oo-2-110 [分享]轉載LISP副程式-抓所有GROUP名稱、查詢GROUP名稱是否存在 Oooo-110