+ Reply to Thread
Page 1 of 3 1 2 3 LastLast
Results 1 to 10 of 24
  1. #1
    Senior Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2010
    Posts
    220

    Default Lisp or codes to explode group of entities (gathered by GROUP command)

    Registered forum members do not see this ad.

    Hello GUYS.

    Is there any ready lisp or codes that could explode a group of enities that
    gathered by Group command please ?

    Thank you all.

    Sweety

  2. #2
    kruuger
    Guest

    Default

    here is nice collection of "PURGE" routines (PurgeAllGroups)

    kruuger

  3. #3
    Senior Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2010
    Posts
    220

    Default

    Quote Originally Posted by kruuger View Post
    here is nice collection of "PURGE" routines (PurgeAllGroups)

    kruuger
    Where is that collection dear krugger ?

    Thanxxxxxxx

  4. #4
    kruuger
    Guest

    Default

    Quote Originally Posted by Sweety View Post
    Where is that collection dear krugger ?

    Thanxxxxxxx
    upsss link is here: http://www.jtbworld.com/lisp/purger.htm
    kruuger

  5. #5
    Senior Member
    Computer Details
    VVA's Computer Details
    Operating System:
    Windows 7
    CPU:
    Intel Core i5-2400
    RAM:
    8 Gb
    Graphics:
    Nvidia Quadro 600
    Primary Storage:
    Seagate 500 GB + WD 750 GB
    Monitor:
    Philips 27"
    Using
    AutoCAD 2013
    Join Date
    Dec 2006
    Location
    Minsk, Belarus
    Posts
    447

    Default

    Try it
    PAG - Purge All Groups
    PEG - Purge Empty Groups
    PUG - Purge Unnamed Groups (like *Annn)
    Code:
    ; Ф-ция PurgeAllGroups
    ; Удаляет описание всех групп
    ; Аргумент [Тип]:
    ;   НЕТ
    ; Возвращает: Nil
    (vl-load-com)
      (defun PurgeAllGroups (/ grpList index grp)
      (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
      (setq index 1)
      (while (setq grp (nth index grplist))
        (if  (= (car grp) 3)
          (entdel (cdr (nth (+ index 1) grplist)))
        )
        (setq index (+ 1 index))
      )
      (princ))
    
    ; Ф-ция PurgeEmptyGroups
    ; Удаляет описание всех пустых групп
    ; Аргумент [Тип]:
    ;   Named = Тип [INT]
    ;       0 — только именованные группы
    ;       1 — только неименованные группы
    ;   t,nil — все группы
    ; Возвращает: Nil
    (defun PurgeEmptyGroups ( named / grpList index grp egrp named_list e_list)
      ;;; Библиотечная ф-ция, возвращает multiple group code
    (defun massoc (key alist / x nlist)
      (foreach x alist
        (if (eq key (car x))
          (setq nlist (cons (cdr x) nlist))
        ))
      (reverse nlist))
      (setq named_list '(0 1))
      (if (member named named_list)(setq named_list (list named)))
      (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
      (setq index 1)
      (while (setq grp (nth index grplist))
        (if  (= (car grp) 3)
          (progn
      (setq egrp (entget (cdr (nth (+ index 1) grplist))))
      (if (member (cdr (assoc 70 egrp)) named_list)
        (progn
          (setq e_list (massoc 340 egrp))
          (if(not (vl-member-if 'entget e_list))
            (entdel (cdr (nth (+ index 1) grplist)))
            )
          )
        )
      )
          )
        (setq index (+ 1 index))
      )
      (princ))
    
    
    ; Ф-ция PurgeAllUnNamedGroups
    ; Удаляет описание всех анонимных групп *Annn
    ; Аргумент [Тип]:
    ; НЕТ
    ; Возвращает: Nil
    (defun PurgeAllUnNamedGroups (/ grpList index grp)
      (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
      (setq index 1)
      (while (setq grp (nth index grplist))
        (if  (= (car grp) 3)
          (progn
      (if (= (chr 42) (substr (cdr grp) 1 1))
        (entdel (cdr (nth (+ index 1) grplist)))
      )
          )
        )
        (setq index (+ 1 index))
      )
      (princ)
    )
    
    ; Ф-ция DeleteGroupbyName
    ; Удаление группы по имени.
    ; Аргумент [Тип]:
    ;   Name = Имя группы [STR]
    ; Возвращает: Null
    (defun DeleteGroupbyName (Name)
    (or *kpblc-activedoc*
       (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    )
     (vl-catch-all-apply
     '(lambda ()
       (vla-delete
        (vla-item
         (vla-get-groups *kpblc-activedoc*)
         Name
        )
       )
      )
     )
     (princ)
    )
    
    ; Ф-ция GetObjGroupNames
    ; Возвращает список имен групп объекта или nil.
    ; Arguments [Type]:
    ;   Obj = Object [VLA-OBJECT]
    ;   Obj = Object [ENAME]
    ; Возвращает [Type]:
    ;   Список имен групп[LIST]
    ;
    (defun GetObjGroupNames (Obj / Cur_ID NmeLst)
     (or *kpblc-activedoc*
       (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    )
     (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj)))
     (setq Cur_ID (vla-get-ObjectID Obj))
     (vlax-for Grp (vla-get-Groups *kpblc-activedoc*)
      (vlax-for Ent Grp
       (if (equal (vla-get-ObjectID Ent) Cur_ID)
        (setq NmeLst (cons (vla-get-Name Grp) NmeLst))
       )
       (vlax-release-object Ent)
      )
      (vlax-release-object Grp)
     )
     (reverse NmeLst)
    )
    
     ;;;Удаляет все пустые группы (именованные и неименованные)
     ;;;Объеткты, входящие в группы удаленны, а описание групп осталось
     ;;;http://dwg.ru/forum/viewtopic.php?t=4762
    (defun PurgeAllEmptyGroups  ()(PurgeEmptyGroups t))
     ;;;Удаляет все пустые группы (именованные)
    (defun PurgeAllNamedEmptyGroups  ()(PurgeEmptyGroups 0))
     ;;;Удаляет все пустые группы (неименованные)
    (defun PurgeAllUnNamedEmptyGroups  ()(PurgeEmptyGroups 1))
    ;;;=======================================================
    ;;; Команды
    ;;;=======================================================
    ;;; Удаляет все группы Purge All Groups
    (defun C:PAG ()(PurgeAllGroups))
    ;;; Удаляет все пустые группы   Purge Empty Groups
    (defun C:PEG ()(PurgeAllEmptyGroups))
    ;;; Удаляет все неименованные группы  Purge Unnamed Groups
    (defun C:PUG ()(PurgeAllUnNamedGroups))

  6. #6
    Senior Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2010
    Posts
    220

    Default

    Quote Originally Posted by kruuger View Post
    upsss link is here: http://www.jtbworld.com/lisp/purger.htm
    kruuger
    Thanks a lot.

    But I am not looking forward to use purge command which although already existed in Autocad .

    I need to explode group on entities that collected with eachothers by group command .

    Thanks

  7. #7
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows 8.1
    Discipline
    Landscape
    Using
    AutoCAD 2015
    Join Date
    Apr 2010
    Posts
    2,995

    Default

    All "GROUPS" within the drawing or a particular GROUP? by name or via selection?

  8. #8
    kruuger
    Guest

    Default

    Quote Originally Posted by Sweety View Post
    Thanks a lot.

    But I am not looking forward to use purge command which although already existed in Autocad .

    I need to explode group on entities that collected with eachothers by group command .

    Thanks
    did you try my or VVA code?
    Purge here means explode all group (you can't purge group with autocad PURGE command).
    kruuger

  9. #9
    Senior Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2010
    Posts
    220

    Default

    Quote Originally Posted by VVA View Post
    Try it
    PAG - Purge All Groups
    PEG - Purge Empty Groups
    PUG - Purge Unnamed Groups (like *Annn)
    Code:
    ; Ф-ция PurgeAllGroups
    ; Удаляет описание всех групп
    ; Аргумент [Тип]:
    ; НЕТ
    ; Возвращает: Nil
    (vl-load-com)
    (defun PurgeAllGroups (/ grpList index grp)
    (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
    (setq index 1)
    (while (setq grp (nth index grplist))
    (if (= (car grp) 3)
    (entdel (cdr (nth (+ index 1) grplist)))
    )
    (setq index (+ 1 index))
    )
    (princ))
    
    ; Ф-ция PurgeEmptyGroups
    ; Удаляет описание всех пустых групп
    ; Аргумент [Тип]:
    ; Named = Тип [INT]
    ; 0 — только именованные группы
    ; 1 — только неименованные группы
    ; t,nil — все группы
    ; Возвращает: Nil
    (defun PurgeEmptyGroups ( named / grpList index grp egrp named_list e_list)
    ;;; Библиотечная ф-ция, возвращает multiple group code
    (defun massoc (key alist / x nlist)
    (foreach x alist
    (if (eq key (car x))
    (setq nlist (cons (cdr x) nlist))
    ))
    (reverse nlist))
    (setq named_list '(0 1))
    (if (member named named_list)(setq named_list (list named)))
    (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
    (setq index 1)
    (while (setq grp (nth index grplist))
    (if (= (car grp) 3)
    (progn
    (setq egrp (entget (cdr (nth (+ index 1) grplist))))
    (if (member (cdr (assoc 70 egrp)) named_list)
    (progn
    (setq e_list (massoc 340 egrp))
    (if(not (vl-member-if 'entget e_list))
    (entdel (cdr (nth (+ index 1) grplist)))
    )
    )
    )
    )
    )
    (setq index (+ 1 index))
    )
    (princ))
    
    
    ; Ф-ция PurgeAllUnNamedGroups
    ; Удаляет описание всех анонимных групп *Annn
    ; Аргумент [Тип]:
    ; НЕТ
    ; Возвращает: Nil
    (defun PurgeAllUnNamedGroups (/ grpList index grp)
    (setq grpList (dictsearch (namedobjdict) "ACAD_GROUP"))
    (setq index 1)
    (while (setq grp (nth index grplist))
    (if (= (car grp) 3)
    (progn
    (if (= (chr 42) (substr (cdr grp) 1 1))
    (entdel (cdr (nth (+ index 1) grplist)))
    )
    )
    )
    (setq index (+ 1 index))
    )
    (princ)
    )
    
    ; Ф-ция DeleteGroupbyName
    ; Удаление группы по имени.
    ; Аргумент [Тип]:
    ; Name = Имя группы [STR]
    ; Возвращает: Null
    (defun DeleteGroupbyName (Name)
    (or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    )
    (vl-catch-all-apply
    '(lambda ()
    (vla-delete
    (vla-item
    (vla-get-groups *kpblc-activedoc*)
    Name
    )
    )
    )
    )
    (princ)
    )
    
    ; Ф-ция GetObjGroupNames
    ; Возвращает список имен групп объекта или nil.
    ; Arguments [Type]:
    ; Obj = Object [VLA-OBJECT]
    ; Obj = Object [ENAME]
    ; Возвращает [Type]:
    ; Список имен групп [LIST]
    ;
    (defun GetObjGroupNames (Obj / Cur_ID NmeLst)
    (or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    )
    (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj)))
    (setq Cur_ID (vla-get-ObjectID Obj))
    (vlax-for Grp (vla-get-Groups *kpblc-activedoc*)
    (vlax-for Ent Grp
    (if (equal (vla-get-ObjectID Ent) Cur_ID)
    (setq NmeLst (cons (vla-get-Name Grp) NmeLst))
    )
    (vlax-release-object Ent)
    )
    (vlax-release-object Grp)
    )
    (reverse NmeLst)
    )
    
    ;;;Удаляет все пустые группы (именованные и неименованные)
    ;;;Объеткты, входящие в группы удаленны, а описание групп осталось
    ;;;http://dwg.ru/forum/viewtopic.php?t=4762
    (defun PurgeAllEmptyGroups ()(PurgeEmptyGroups t))
    ;;;Удаляет все пустые группы (именованные)
    (defun PurgeAllNamedEmptyGroups ()(PurgeEmptyGroups 0))
    ;;;Удаляет все пустые группы (неименованные)
    (defun PurgeAllUnNamedEmptyGroups ()(PurgeEmptyGroups 1))
    ;;;=======================================================
    ;;; Команды
    ;;;=======================================================
    ;;; Удаляет все группы Purge All Groups
    (defun C:PAG ()(PurgeAllGroups))
    ;;; Удаляет все пустые группы Purge Empty Groups
    (defun C:PEG ()(PurgeAllEmptyGroups))
    ;;; Удаляет все неименованные группы Purge Unnamed Groups
    (defun C:PUG ()(PurgeAllUnNamedGroups))
    Thank you so much Mr VVA.

    that's really great .

    But how to make it by the user selection one by one ?

    Appreciated

  10. #10
    Senior Member
    Using
    AutoCAD 2010
    Join Date
    Aug 2010
    Posts
    220

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by pBe View Post
    All "GROUPS" within the drawing or a particular GROUP? by name or via selection?
    Yes, it would be very great if I could select one group by one .

    Thanks

Similar Threads

  1. VBA - working with group codes - need some help
    By BUrBaKy in forum .NET, ObjectARX & VBA
    Replies: 5
    Last Post: 2nd Jun 2010, 07:53 am
  2. Group Command question
    By gtwatson in forum AutoCAD Beginners' Area
    Replies: 6
    Last Post: 27th May 2009, 01:03 pm
  3. Group Codes
    By Chris H. in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 9th May 2008, 09:19 pm
  4. Entity group codes question
    By George Duls in forum AutoLISP, Visual LISP & DCL
    Replies: 16
    Last Post: 9th Nov 2007, 12:30 pm
  5. group command/extend trimm command not working
    By BITDRAUGHTY in forum AutoCAD Beginners' Area
    Replies: 3
    Last Post: 22nd Mar 2006, 06:01 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts