[编程交流] 创建块

(command "_-block" nombre_bloque punto_insercion conjunto_elementos "")

[color=GREEN];; Objects to Block  -  Lee Mac[/color]
[color=GREEN];; Converts a selection of objects to a block reference.[/color]
[color=GREEN];; Limited to non-attributed blocks.[/color]
([color=BLUE]defun[/color] c:obj2blk ( [color=BLUE]/[/color] e i l n p s x )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((-4 . [color=MAROON]"<NOT"[/color]) (0 . [color=MAROON]"ATTDEF,VIEWPORT"[/color]) (-4 . [color=MAROON]"NOT>"[/color]))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]while[/color]
                   ([color=BLUE]not[/color]
                       ([color=BLUE]or[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]setq[/color] n ([color=BLUE]getstring[/color] [color=BLUE]t[/color] [color=MAROON]"\nSpecify Block Name <Anonymous>: "[/color])))
                           ([color=BLUE]and[/color]
                               ([color=BLUE]snvalid[/color] n)
                               ([color=BLUE]null[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] n))
                           )
                       )
                   )
                   ([color=BLUE]princ[/color] [color=MAROON]"\nBlock name invalid or already exists."[/color])
               )
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] n)
                   ([color=BLUE]setq[/color] n [color=MAROON]"*U"[/color])
               )
               ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify Base Point: "[/color]))
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]entmake[/color]
               ([color=BLUE]list[/color]
                  '(0 . [color=MAROON]"BLOCK"[/color])
                   ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] p 1 0))
                   ([color=BLUE]cons[/color] 02 n)
                   ([color=BLUE]cons[/color] 70 ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] n [color=MAROON]"`**"[/color]) 1 0))
               )
           )
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]entmake[/color] ([color=BLUE]entget[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 66 ([color=BLUE]entget[/color] e))))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] x ([color=BLUE]entnext[/color] e)
                             l ([color=BLUE]entget[/color]  x)
                       )
                       ([color=BLUE]while[/color] ([color=BLUE]/=[/color] [color=MAROON]"SEQEND"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 l)))
                           ([color=BLUE]entmake[/color] l)
                           ([color=BLUE]setq[/color] x ([color=BLUE]entnext[/color] x)
                                 l ([color=BLUE]entget[/color]  x)
                           )
                       )
                       ([color=BLUE]entmake[/color] l)
                   )
               )
               ([color=BLUE]entdel[/color] e)
           )
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] n ([color=BLUE]entmake[/color] '((0 . [color=MAROON]"ENDBLK"[/color]))))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"INSERT"[/color])
                       ([color=BLUE]cons[/color] 02 n)
                       ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] p 1 0))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

(command "_-block" nombre_bloque punto_insercion conjunto_elementos ""
        "_.OOPS")