[求助]自动裁剪存盘，帮我看看！！！

muhanleek

(defun c:xcc()
(setq largeextentline (car (entsel "请选择范围线:")))
(setq filename (getstring "\n请输入存盘文件名："))
(if largeextentline
(progn
    (princ "\n请稍侯...")
    (command "undo" "be")
    (setvar "plinetype" 2)(setvar "cmdecho" 0)(setvar "osmode" 0)(setvar "clayer" "0")(setvar "filedia" 0)
    (vl-load-com)
    (command "convert" "p" "")
    (setq newcoordnatelist (getlistofpline0 largeextentline));获得范围线的坐标表
   
    ;;;;;;;;;;;;;;;;;;;炸碎与范围线相交的块;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq ssblock (ssget "f" newcoordnatelist '((0 . "insert"))))
    (if ssblock
    (progn
    (setq ssi (sslength ssblock) n 0 )
    (repeat ssi
    (setq stm (ssname ssblock n))
    (command "explode" stm)
    (setq n (+ n 1))
    )
    )
    )           
    ;;;;;;;;;;;;;;;;;;;裁剪与范围线相交的对象(5次);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq dist 2.02)
    (repeat 5
    (command "offset" dist largeextentline "-1000,-1000" "")
    (setq trim_line (entlast))
    (setq trimcoordnatelist (getlistofpline0 trim_line))
    (setq objsequence 0)
    (setq coord (nth objsequence trimcoordnatelist))
   
    (command "trim" largeextentline "" "f")
    (while coord
             (command coord)
             (setq objsequence (+ objsequence 1))
             (setq coord (nth objsequence trimcoordnatelist))
    )
    (command "" "")
    (entdel trim_line)
    (setq dist (- dist 0.5))
     );end repeat
    
      ;;;;;;;;;;;;;;;;;;;获取范围线内所有的对象集合;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (command "offset" 0.01 largeextentline "-1000,-1000" "")
     (setq select_line (entlast))
     (setq selectcoordnatelist (getlistofpline0 select_line))
     (setq ssall (ssget "_cp" selectcoordnatelist))
     ;(ssdel largeextentline ssall)
     (ssdel select_line ssall)
     ;;;;;;;;;;;;;;;;;;;获取存盘路径;;;;;;;;;;;;;;;;;;;;;;;;;；；；；；；；;;;;;;;;;
    
     (setq    acadobject   (vlax-get-acad-object)
              acaddocument (vla-get-activedocument acadobject)
              docpath (vla-get-path acaddocument))
   
    (command "-wblock" (strcat docpath "\\"  filename) "" "0,0,0" ssall "");范围线内所有的对象另存
    (command "undo" "e")
    (command "undo" "");恢复原图
    (setvar "clayer" "0")
    (setvar "filedia" 1)
    (setvar "cmdecho" 1)
    (princ "\n存盘已经完毕")
    (entdel largeextentline)
    (princ)
)
(progn
(princ "\n没有选择范围线!!")(princ)
)
)

)

;获得范围线的坐标表的子函数
(defun getlistofpline0(entityname / sse_pline coordnate_vertex lastlist)
(setq sse_pline (entget entityname))
(setq lastlist nil)
(cond
((= (cdr (assoc 0 sse_pline)) "LINE")
(progn
    (setq p1 (cdr (assoc 10 sse_pline))
          p2 (cdr (assoc 11 sse_pline)))
    (setq p1 (reverse (cdr (reverse p1)))
          p2 (reverse (cdr (reverse p2))))
    (setq lastlist (list p1 p2))
)
)

((= (cdr (assoc 0 sse_pline)) "LWPOLYLINE")
(progn
    (setq lastlist (list (list 0 0)))
    (setq n 0)
    (while (/= (nth n sse_pline) nil)
            (if (= (car (nth n sse_pline)) 10)
            (setq lastlist (append lastlist (list (list (cadr (nth n sse_pline)) (caddr (nth n sse_pline)))) ))
        )
        (setq n (+ n 1))
    )
    (setq lastlist (cdr lastlist))
)
)

((= (cdr (assoc 0 sse_pline)) "POLYLINE")
(progn
    (setq lastlist (list (list 0 0)))
    (setq newentityname (entnext entityname))
    (while (= (cdr (assoc 0 (entget newentityname))) "VERTEX")
        (setq lastlist (append lastlist (list (list (cadr (assoc 10 (entget newentityname))) (caddr (assoc 10 (entget newentityname))) )) ))
        (setq newentityname (entnext newentityname))
    )
    (setq lastlist (cdr lastlist))
)
)
((= (cdr (assoc 0 sse_pline)) "ARC")
(progn
    (setq lastlist (list (list 0 0)))
    (command "pedit" entityname "y" "" "convert" "p" "s" (entlast) "")
    (setq sse_pline (entget (entlast)))
    (setq n 0)
    (while (/= (nth n sse_pline) nil)
            (if (= (car (nth n sse_pline)) 10)
            (setq lastlist (append lastlist (list (list (cadr (nth n sse_pline)) (caddr (nth n sse_pline)))) ))
        )
        (setq n (+ n 1))
    )
    (setq lastlist (cdr lastlist))
    (command "undo" 2)
))
((= (cdr (assoc 0 sse_pline)) "CIRCLE")
(progn
    (setq ra1 (cdr (assoc 40 sse_pline)))
    (setq p-center (cdr (assoc 10 sse_pline)))
    (setq p1 (polar p-center 0 ra1))
    (setq p2 (polar p-center (* pi 0.5) ra1))
    (setq p3 (polar p-center (* pi 1.0) ra1))
    (setq p4 (polar p-center (* pi 1.5) ra1))
    (setq lastlist (list p1 p2 p3 p4))
))
);end cond
(setq lastlist lastlist)
)

简单的图形没有问题！图形很大很复杂裁剪就会出问题，不知道为什么！！！

muhanleek

我发现(SSGET "F" Ptlist),如果Ptlist为水平的矩形，那么在一条边上，会有很多的对象选不上！！！

hb_xiaofen

看起来很费劲，没看完，不过用ssget选择的时候要注意，必须先用zoom “E”一下，让所有图形都显示出来，否则不显示的部分是选择不到的