[原创]：※简便的图形切割程序※

snsj

运行前检查是否安装et扩展
使用方法:
[php]
;;;|图形切割程序
;;;|制作:snsj 2004.6.7
(defun zzm(x y /)(cdr(assoc x(entget y))))
(defun c:qg (/ ent ss boxpt pt pt1 ptt ptt1 ppt os i ssn)
(princ "******|图形切割程序(用于2000+版本)，制作:snsj，欢迎你光临小东CAD!!!(如程序异常,请安装ET扩展)|******")
  (setvar "cmdecho" 0)(load "extrim.lsp")
  (setq os(getvar "osmode"))(setvar "osmode" 0)
(setq ent(car(entsel"\n选择物体<圆形、矩形或者闭合的polyline线>:"))i 0)
  (setq boxpt(acet-ent-geomextents ent)
        pt(car boxpt)pt1(cadr boxpt)
        ptt(list(-(car pt)100)(-(cadr pt)100))
        ptt1(list(/(+(car pt)(car pt1))2)(/(+(cadr pt)(cadr pt1))2))
        )
(cond((=(zzm 0 ent)"CIRCLE")
(command "._polygon" "30" (zzm 10 ent) "c" (zzm 40 ent))
(setq ss(ssget "_cp"(acet-geom-vertex-list (entlast))))
(command ".erase" (entlast) "")
      )
     ((and(=(zzm 0 ent)"LWPOLYLINE")(vlax-curve-isClosed ent))
(setq ss(ssget "_cp"(acet-geom-vertex-list ent)))
      )(t(exit))
     )
  (repeat (sslength ss)
    (setq ssn(ssname ss i))
    (if(=(zzm 0 ssn)"LEADER")
      (if(not(ssmemb(zzm 340 ssn)ss))
        (ssadd(zzm 340 ssn)ss)
        )
      )(setq i(1+ i))
    )
  (setq ppt(acet-ss-drag-move ss ptt1 "\n点取移动到的位置:" nil))
  (if(/= ppt nil)
    (progn
(command ".copy" ss "" '(0 0) '(0 0))
(command ".move" ss "" ptt1 ppt)
  (etrim ent ptt)
  (command ".scale" ss "" ppt (getint"\n输入放大倍数:")))
    )
  (setvar "highlight" 1)(setvar "osmode" os)
  (princ)
  )

[/php]

andyhua5240

我用楼主的代码做了个附件！
欢迎下载！

jerry_bj

怎么用啊？

fylinwater

(command ".scale" ss "" ppt (getint"\n输入放大倍数:")))
最好修改为(command ".scale" ss "" ppt (getReal"\n输入放大倍数:")))
选择多义线的时候最好判断是不是凸多边形，否则出错，
如果做更大补充就改给里面每个块用xclip处理一下，否则块割不了

zxdvip

好程序，能否自动把轴线两端的轴号一起接进来

wmz_0211

什么是ET扩展?

doubao

ET扩展应该就是指 Express Tools

wmz_0211

可是,这个我没有啊!

bububa918

高手，这是我找了很久类似天正图形裁减
要是事先不要画封闭线就更好，大多数用矩形裁减

ago9999

(defun c:-9 (/ ) ; 相贯线切割
  (command "rectang" pause pause)
  (sta)
  (command "ucs" "p")
  (setq rec (entlast))
  (setq rec_ss (entget rec))
  (setq n 0)
  (setq ptss (list))
  (while (< n  (length rec_ss))
    (setq rec_n (nth n rec_ss))
    (if (= 10 (nth 0 rec_n))
      (setq ptss (cons (cdr rec_n) ptss)))
    (setq n (1+ n)))
  (setq st_ss (ssget "c" (nth 0 ptss) (nth 2 ptss)))
  (command "slice" st_ss "" (nth 0 ptss) (nth 1 ptss) "@0,0,1" (nth 2 ptss))
  (command "slice" st_ss "" (nth 1 ptss) (nth 2 ptss) "@0,0,1" (nth 0 ptss))
  (command "slice" st_ss "" (nth 2 ptss) (nth 3 ptss) "@0,0,1" (nth 0 ptss))
  (command "slice" st_ss "" (nth 3 ptss) (nth 0 ptss) "@0,0,1" (nth 2 ptss))
  (command "ERASE" rec "")
  (end)
  )
(defun sta();开始
    (command "undo" "be") ; 定义返回点
    (setvar "cmdecho" 0)  ; 关闭命令提示
    (setq osn (getvar "OSMODE"));记忆捕捉
    (setvar "OSMODE" 0)
    (if (= (getvar "ucsname") nil)
        (command "ucs" "s" "sl"); 记忆UCS
        (command "ucs" "s" "sl" "y")
     )
    (command "ucs" "w")
  )
(defun end();结束
  (command "ucs" "r" "sl"); 返回UCS
  (setvar "OSMODE" osn);恢复捕捉
  (command "undo" "e"); 定义返点
  (setvar "cmdecho" 1); 打开命令提示
  (princ)
)

jarchy

具体裁减功能有什么优点,比如能裁减块?下过两个工具了.天正和清华现在都有这功能