试一试:
[i][color=#990099];; Drawing Cutter, by Lee McDonnell 24.04.2009[/color][/i][b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:DwgCut [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] file path ss miPt maPt iSs fname[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] file [b][color=RED]([/color][/b][b][color=BLUE]getfiled[/color][/b] [b][color=#ff00ff]"Select Location for New Files"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] $def $def [b][color=#ff00ff]""[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]"dwg"[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] $def file[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]exit[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] path [b][color=RED]([/color][/b][b][color=BLUE]vl-filename-directory[/color][/b] file[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"INSERT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=#009900]2[/color][/b] . [b][color=#ff00ff]"BORDER"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-getBoundingBox[/color][/b] Obj [b][color=DARKRED]'[/color][/b]miPt [b][color=DARKRED]'[/color][/b]maPt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] winLst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray->list[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] miPt maPt[b][color=RED])[/color][/b][b][color=RED])[/color][/b] iSs [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_C"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] winLst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] winLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] fname [b][color=RED]([/color][/b][b][color=BLUE]vl-filename-mktemp[/color][/b] [b][color=#ff00ff]"Dwg~"[/color][/b] path [b][color=#ff00ff]".dwg"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-wBlock[/color][/b] doc fname [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSelectionSet[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> No Borders Found <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
以上内容适用于所有称为“边界”的区块。
写入的文件前缀为Dwg~