[LISP程序]：group 处理函数

y0yxt · 发表于 2002-3-31 05:58:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun gp:search (groupName / grp)
(setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
(dictsearch (cdr (assoc -1 grp)) groupName)
)
;;; get the group name from one entity of it.
;;; return the group name and entity name list:
;; Like : ((groupname1 . ename) ( . ) ....)
;;
(defun gp:GetName (ename / ele grp)
(and
(setq ele (entget ename))
;;(assoc 102 ele)
(setq ele (mdxf 330 ele))
;;defined in pl_deal mdxf
(setq grp (dictsearch (namedobjdict) "ACAD_GROUP")
grp (mapcar 'cdr grp) ; only need value
)
(setq ele
(mapcar '(lambda (enn / loc)
(setq
loc (length (member enn grp)) ;get the loction
loc (nth loc (reverse grp))
;;get the groupname
)
(cons loc enn)
)
ele
)
)
) ;_and
ele
)
(defun mdxf ( a lst / b lst2)
(while (setq b (assoc a lst));setq
(setq lst (cdr (member b lst))
lst2 (append lst2 (list (cdr b)))
);setq
);while
)

(defun gp:search (groupName / grp) 
  (setq grp (dictsearch (namedobjdict) "ACAD_GROUP")) 
  (dictsearch (cdr (assoc -1 grp)) groupName) 
) 
;;; get the group name from one entity of it. 
;;; return the group name and entity name list: 
;; Like : ((groupname1 . ename) ( . ) ....) 
;; 
(defun gp:GetName (ename / ele grp) 
  (and 
    (setq ele (entget ename)) 
    ;;(assoc 102 ele) 
    (setq ele (mdxf 330 ele)) 
    ;;defined in pl_deal mdxf 
    (setq grp (dictsearch (namedobjdict) "ACAD_GROUP") 
          grp (mapcar 'cdr grp)                ; only need value 
    ) 
    (setq ele 
           (mapcar '(lambda (enn / loc) 
                      (setq 
                        loc (length (member enn grp)) ;get the loction 
                        loc (nth loc (reverse grp)) 
                            ;;get the groupname 
                      ) 
                      (cons loc enn) 
                    ) 
                   ele 
           ) 
    ) 
  ) ;_and 
  ele 
) 
(defun mdxf ( a lst / b lst2) 
 
(while (setq b (assoc a lst));setq 
(setq  lst (cdr (member b lst)) 
      lst2 (append lst2 (list (cdr b))) 
);setq 
);while 
)

y0yxt · 发表于 2002-3-31 06:03:00

(defun gp:create (name descrip ss)
(and name
descrip
ss
(cond
((gp:search name)
(command "-group" "create" name "Y" descrip ss "")
)
(T
(command "-group" "create" name descrip ss "")
)
)
) ;_and
T
;;always return T
)
(defun gp:delete (groupName)
(if (gp:search groupName)
(command "-group" "explode" groupname)
)
)
(defun gp:rename (groupName newName)
(if (gp:search groupName)
(command "-group" "rename" groupName newName)
)
)
(defun gp:add (groupName ss)
(if (gp:search groupName)
;;; (if (= 'PICKSET (type ss))
;;; (command "-group" "add" groupName ss)
(command "-group" "add" groupName ss "")
;;; )
)
T
)
(defun gp:remove (groupName ss)
(if (gp:search groupName)
(command "-group" "remove" groupName ss "")
)
)

(defun gp:create (name descrip ss) 
  (and name 
       descrip 
       ss 
       (cond 
         ((gp:search name) 
          (command "-group" "create" name "Y" descrip ss "") 
         ) 
         (T 
          (command "-group" "create" name descrip ss "") 
         ) 
       ) 
  ) ;_and 
  T 
  ;;always return T 
) 
 
(defun gp:delete (groupName) 
  (if (gp:search groupName) 
    (command "-group" "explode" groupname) 
  ) 
) 
(defun gp:rename (groupName newName) 
  (if (gp:search groupName) 
    (command "-group" "rename" groupName newName) 
  ) 
) 
(defun gp:add (groupName ss) 
  (if (gp:search groupName) 
;;;    (if (= 'PICKSET (type ss)) 
;;;      (command "-group" "add" groupName ss) 
    (command "-group" "add" groupName ss "") 
;;;      ) 
  ) 
  T 
) 
(defun gp:remove (groupName ss) 
  (if (gp:search groupName) 
    (command "-group" "remove" groupName ss "") 
  ) 
)

YueFeng · 发表于 2002-3-31 08:00:52

老兄，还是提供个LSP程序文件下载吧。在这里，这样的字体看得好累人哟。

y0yxt · 发表于 2002-4-3 02:05:34

应楼上的要求，摘出有关函数，未全面测试。
Password: yxt

e2002 · 发表于 2002-4-3 04:05:22

很好！非常感谢！如果能用ActiveX方法就更好了...

y0yxt · 发表于 2002-4-3 04:48:44

我一般不用ActiveX的，只能请高手代劳了。

jx2008 · 发表于 2008-11-9 14:08:57

提供的链接无法下载！

qiaqiadeng · 发表于 2008-11-20 19:49:46

楼主的member用的很熟啊，高啊，淆了一招。

xfyy · 发表于 2008-12-9 19:07:49

很好！非常感谢

colatree · 发表于 2008-12-12 11:25:18

我對group使用不是很熟
是否可作一個例子說明
謝謝！

qiuxiang129 · 发表于 2008-12-13 00:49:45

下载还要时间间隔

albbzdc156 · 发表于 2008-12-13 20:32:32

论坛有的附件是不是丢失了

szzjchh · 发表于 2013-10-18 02:22:37

下载在哪呀

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：group 处理函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子