组命令例程

Noklu · 发表于 2022-7-6 09:29:25

这是一个我一直在寻找很长时间。多年来，我们一直使用AutoCAD LT，然后转向了完整的AutoCAD。LT中的组命令远优于全自动CAD。只需单击一个按钮，拾取对象，然后对其进行分组。单击另一个按钮，它们将被取消分组。然后，使用“pickstyle”选项，您可以暂时挂起组进行编辑。这就是它在其他图形程序（例如CorelDraw、Illustrator、Xara等）中的工作原理。出现了一个对话框，这样我可以“命名”一个组，然后选择对象的整个想法似乎很疯狂。这真的打断了工作流程。如果我想那样做，我会制造障碍。

有没有人知道如何使用lisp或其他定制来实现这一点？

Lee Mac · 发表于 2022-7-6 09:36:04

也许使用匿名组？

copy


(defun c:grp ( / l )
 (vl-load-com)
 ;; © Lee Mac 2010
 (if (setq l (LM:SS->VLA (ssget)))
   (vla-AppendItems
     (vla-Add
       (vla-get-Groups
         (vla-get-ActiveDocument
           (vlax-get-acad-object)
         )
       )
       "*"
     )
     (LM:ObjectVariant l)
   )
 )
 (princ)
)
;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)
;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac 2010
 (LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

StevJ · 发表于 2022-7-6 09:40:36

这一个是匿名块。
我不是这个节目的作者。
我在网上搜索时找到了它，效果很好。

史蒂夫J

copy


(princ "\n This code is provided Unscramnbled - for free - given that it is not altered")
(princ "\n Thanks for your understanding, www.xordesign.com ")
(princ "\n Type TBLOCK to start ")
(defun c:TBLOCK (/ sset tell ent ent_get entu ent_getu blk)
       (princ "\n Select objects to group into anonymous Block: ")
       (setq sset (ssget))
       (if sset (progn
            (entmake (list 
                      '(0 . "BLOCK")
                      '(2 . "*U")
                      '(70 . 1)
                      '(10  0.0 0.0 0.0)))
            (setq tell 0)
            (setq ent (ssname sset tell))
            (while ent
              (setq ent_get (entget ent))
              (if (/= (cdr (assoc 0 ent_get)) "POLYLINE")(progn
                     (setq ent_getu (cdr ent_get))
                     (entdel ent)
                     (entmake ent_getu))
                  (progn
                    (setq entu ent
                          ent_getu (cdr ent_get))
                    (while (/= (cdr (assoc 0 ent_getu)) "SEQEND")
                     (setq ent_getu (cdr (entget entu)))
                     (entmake ent_getu)
                     (setq entu (entnext entu))
                     );while
                     (entdel ent)                   
                  )
              );if
              (setq tell (+ tell 1))
              (setq ent (ssname sset tell))
            )       
            (setq blk (entmake (list '(0 . "ENDBLK"))))
            (entmake (list '(0 . "INSERT")
                            (cons 2 blk)
                            '(10 0.0 0.0 0.0)))  
         );progn
       );if
     (princ "\n Anonymous block created. Explode to ungroup")
       (princ)
)                    
(princ)

编辑：李。我一直在尝试你的匿名群组惯例，在我尝试引爆群组之前一切都很好。
不会爆炸。我想你应该知道。
再想一想，我现在可以和同事们玩得无穷无尽了。

David Bethel · 发表于 2022-7-6 09:40:51

这为您提供了匿名或命名块以及基点输入的选项：

copy


;=======================================================================
;    GroupNew.Lsp                                    Jan 03, 2008
;    New Group Into Block Anon or Named
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2008, Fabricated Designs, Inc.")
(princ "\nLoading GroupNew v1.0 ")
(setq gra_ nil lsp_file "GroupNew")
;================== Macros =============================================
(defun PDot ()(princ "."))
(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun gra_smd ()
(SetUndo)
(setq oldlay (getvar "CLAYER")
      olderr *error*
     *error* (lambda (e)
               (while (> (getvar "CMDACTIVE") 0)
                      (command))
               (and (/= e "quit / exit abort")
                    (princ (strcat "\nError: *** " e " *** ")))
               (and (= (logand (getvar "UNDOCTL")  8)
                    (command "_.UNDO" "_END" "_.U"))
               (gra_rmd))
      gra_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
               ("MENUCTL"   . 0) ("MACROTRACE" . 0)
               ("OSMODE"    . 0) ("SORTENTS"   . 119)
               ("LUPREC"    . 2) ("MODEMACRO" . ".")
               ("BLIPMODE"  . 0) ("EXPERT"     . 0)
               ("SNAPMODE"  . 1) ("PLINEWID"   . 0)
               ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
               ("ELEVATION" . 0) ("THICKNESS"  . 0)
               ("FILEDIA"   . 0) ("FILLMODE"   . 0)
               ("SPLFRAME"  . 0) ("UNITMODE"   . 0)
               ("TEXTEVAL"  . 0) ("ATTDIA"     . 0)
               ("AFLAGS"    . 0) ("ATTREQ"     . 1)
               ("ATTMODE"   . 1) ("UCSICON"    . 1)
               ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
               ("COORDS"    . 2) ("DRAGMODE"   . 2)
               ("DIMZIN"    . 1) ("PDMODE"     . 0)
               ("CECOLOR"   . "BYLAYER")
               ("CELTYPE"   . "BYLAYER")))
(foreach v gra_var
  (and (getvar (car v))
       (setq gra_rst (cons (cons (car v) (getvar (car v))) gra_rst))
       (setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)))
(princ))
(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun gra_rmd ()
 (SetLayer oldlay)
 (setq *error* olderr)
 (foreach v gra_rst (setvar (car v) (cdr v)))
 (command "_.UNDO" "_END")
 (prin1))
(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
     (command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
     (command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")  8)
     (command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
(PDot);++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (name / ldef flag)
 (cond ((or (not name)
            (not (snvalid name)))
        (princ "\nBad Aurgment Passed To SetLayer - ")
        (prin1 name)
        (exit)))
 (command "_.LAYER")
 (if (not (tblsearch "LAYER" name))
     (command "_Make" name)
     (progn
       (setq ldef (tblsearch "LAYER" name)
             flag (cdr (assoc 70 ldef)))
       (and (= (logand flag  1)  1)
            (command "_Thaw" name))
       (and (minusp (cdr (assoc 62 ldef)))
            (command "_On" name))
       (and (= (logand flag  4)  4)
            (command "_Unlock" name))
       (and (= (logand flag 16) 16)
            (princ "\nCannot Set To XRef Dependent Layer")
            (quit))
       (command "_Set" name)))
 (command "")
 name)
(PDot);************ Main Program ***************************************
(defun gra_ (/ olderr oldlay gra_var gra_rst
            bt ss i en ed pt sn sd)
 (gra_smd)
 (initget "Named Anonymous")
 (setq bt (getkword "\nBlock Type - Named/Anonymous <A>:   "))
 (if (not bt)
     (setq bt "Anonymous")
     (progn
       (setq bn "TEMP1" bc 1)
       (while (tblsearch "BLOCK" bn)
              (setq bc (1+ bc) bn (strcat "TEMP" (itoa bc))))))
 (command "_.SNAP" 1.00)
 (initget 1)
 (setq pt (getpoint "\nSpecify Base Point: "))
 (princ "\nSelect Entities To Block:   ")
 (and (setq i -1
           ss (ssget '((0 . "~VIEWPORT"))))
      (entmake (list (cons 0 "BLOCK")
                     (cons 2 (if (= bt "Named") bn "*U"))
                     (cons 10 pt)
                     (cons 70 (if (= bt "Named") 0 1))))
      (while (setq en (ssname ss (setq i (1+ i))))
            (setq ed (entget en))
            (entmake ed)
            (and (= 1 (cdr (assoc 66 ed)))
                 (setq sn en)
                 (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext sn)))))
                        (setq sn (entnext sn)
                              sd (entget sn))
                        (entmake sd))
                 (entmake (entget (entnext sn))))
            (entdel en))
      (setq in (entmake (list (cons 0 "ENDBLK")(cons 8 "0"))))
      (entmake (list (cons 0 "INSERT")(cons 2 in)(cons 8 "0")
                     (cons 10 pt))))
 (gra_rmd))
(PDot);************ Load Program ***************************************
(defun C:GroupNew () (gra_))
(if gra_ (princ "\nGroupNew Loaded\n"))
(prin1)
;|================== End Program =======================================

-大卫

Lee Mac · 发表于 2022-7-6 09:47:34

我以为这是群体的惯常行为，不是吗？

您应该能够通过“组”对话框分解组

StevJ · 发表于 2022-7-6 09:49:59

好吧，我会被浸泡！当然，你是对的。
我已经很久没有和组一起工作了，我试着用explode命令将它们解组。我真傻。

史蒂夫J

Lee Mac · 发表于 2022-7-6 09:54:56

不用担心SteveJ-直觉上，使用explode命令是有意义的。。。

Noklu · 发表于 2022-7-6 09:58:07

李，
这真的很有效。这正是我想要的。我想我唯一的问题是。。。有没有可能也解散这些团体？
换句话说。键入grp，然后选择要分组的实体，它将创建组。然后键入ugrp并选择要溶解的组。

Lee Mac · 发表于 2022-7-6 10:02:21

我不怎么操纵组对象，但可能是这样的？

copy


(defun c:grp ( / l )
 (vl-load-com)
 ;; © Lee Mac 2010
 (or *doc (setq *doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (if (setq l (LM:SS->VLA (ssget)))
   (vla-AppendItems
     (vla-Add (vla-get-Groups *doc) "*")
     (LM:ObjectVariant l)
   )
 )
 (princ)
)
(defun c:ugrp ( / group g h lst )
 (vl-load-com)
 ;; © Lee Mac 2010
 (or *doc (setq *doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 
 (vlax-for group (vla-get-Groups *doc)
   (vlax-for object group
     (setq g (cons (vla-get-Handle object) g))
   )
   (setq lst (cons (cons group g) lst) g nil)
 )
 (if lst
   (while
     (progn
       (setq e (car (entsel "\nSelect Object to Remove Grouping: ")))
       (cond
         (
           (eq 'ENAME (type e)) (setq h (vla-get-Handle (vlax-ename->vla-object e)))
           (if
             (setq group
               (vl-some
                 (function
                   (lambda ( g )
                     (if (vl-position h (cdr g)) g)
                   )
                 )
                 lst
               )
             )
             (progn
               (vla-delete (car group))
               (setq lst (vl-remove group lst))
               (princ "\n** Group Deleted **")
             )
             (princ "\n** Object is not a member of a group **")
           )
         )
       )
     )
   )
   (princ "\n** No Groups in Drawing **")
 )
 (princ)
)  
;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)
;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac 2010
 (LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

Noklu · 发表于 2022-7-6 10:06:09

李，

很酷！！它工作得很好。非常感谢。

[编程交流] 组命令例程

发表回复

精选推荐