模板上有大小不一样的圆



网友答:
xiaxiang 发表于 2011-11-16 16:41

修剪多段线出了点故障，请完善一下



网友答:
  2. ;; ctrim.lsp  v1.1
  3. ;; Modified By Xiaxiang

  5. (defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent ss1 num
  6.                    ctrim_err x f_pts svd_os svd_cmd svd_err)

  8. (defun ctrim_err (s)
  9.   (if(/= s "Function cancelled")
  10.   (princ(strcat "\n\n" s))     )
  11.   (setvar "cmdecho" svd_cmd)
  12.   (setvar "osmode" svd_os)
  13.   (setq *error* svd_err)
  14. )

  16. (defun circ_pts (enm)
  17.   (setq lst    (entget enm)
  18.         ang    (* pi 2)
  19.         inc    (/ ang 64)
  20.         tmp    '()
  21.         seg    65
  22.   )
  23.   (repeat seg
  24.    (setq pt (polar(cdr(assoc 10 lst))ang
  25.             (-(cdr(assoc 40 lst))0.01))
  26.         ang (+ inc ang)
  27.    )
  28.    (setq tmp(cons pt tmp))
  29.   )
  30.   tmp
  31. )

  33. ;;add ssget function
  34. (setq num 0)
  35. (prompt "\nSelect circles: ")
  36. (setq ss1 (ssget '((0 . "CIRCLE"))))
  37. (setq ;ent     (car(entsel "\nSelect circle: ")) ;;entsel
  38.        svd_err *error*
  39.        *error* ctrim_err
  40.        svd_os  (getvar "osmode")
  41.        svd_cmd (getvar "cmdecho")
  42. )
  43. (setvar "cmdecho" 0)
  44. (setvar "osmode" 0)
  45. (repeat (sslength ss1)
  46. (setq ent(ssname ss1 num))
  47. (setq num(1+ num))
  48. (if(and ent
  49.      (=(cdr(assoc 0(entget ent)))"CIRCLE")
  50.     )
  51.   (progn
  52.    (setq f_pts(circ_pts ent))
  53.    (command "trim" ent "" "f")   ;run twice in case the same
  54.    (foreach x f_pts(command x))  ;object intersects circle twice
  55.    (command "" "")
  56.    (command "trim" ent "" "f")
  57.    (foreach x f_pts(command x))
  58.    (command "" "")
  59.    (if(setq x(ssget "wp" f_pts))
  60.     (command "erase" x "")
  61.    )
  62.   )
  63. )
  64. )
  65. (setvar "cmdecho" svd_cmd)
  66. (setvar "osmode" svd_os)
  67. (setq *error* svd_err)
  68. (princ)
  69. )


网友答:
  2. (defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent
  3.                    ctrim_err x f_pts svd_os svd_cmd svd_err)


  6. (defun ctrim_err (s)
  7.   (if(/= s "Function cancelled")
  8.   (princ(strcat "\n\n" s))     )
  9.   (setvar "cmdecho" svd_cmd)
  10.   (setvar "osmode" svd_os)
  11.   (setq *error* svd_err)
  12. )


  15. (defun circ_pts (enm)
  16.   (setq lst    (entget enm)
  17.         ang    (* pi 2)
  18.         inc    (/ ang 64)
  19.         tmp    '()
  20.         seg    65
  21.   )
  22.   (repeat seg
  23.    (setq pt (polar(cdr(assoc 10 lst))ang
  24.             (-(cdr(assoc 40 lst))0.01))
  25.         ang (+ inc ang)
  26.    )
  27.    (setq tmp(cons pt tmp))
  28.   )
  29.   tmp
  30. )


  33. (setq ent     (car(entsel "\nSelect circle: "))
  34.        svd_err *error*
  35.        *error* ctrim_err
  36.        svd_os  (getvar "osmode")
  37.        svd_cmd (getvar "cmdecho")
  38. )
  39. (setvar "cmdecho" 0)
  40. (setvar "osmode" 0)
  41. (if(and ent
  42.      (=(cdr(assoc 0(entget ent)))"CIRCLE")
  43.     )
  44.   (progn
  45.    (setq f_pts(circ_pts ent))
  46.    (command "trim" ent "" "f")   ;run twice in case the same
  47.    (foreach x f_pts(command x))  ;object intersects circle twice
  48.    (command "" "")
  49.    (command "trim" ent "" "f")
  50.    (foreach x f_pts(command x))
  51.    (command "" "")
  52.    (if(setq x(ssget "wp" f_pts))
  53.     (command "erase" x "")
  54.    )
  55.   )
  56. )
  57. (setvar "cmdecho" svd_cmd)
  58. (setvar "osmode" svd_os)
  59. (setq *error* svd_err)
  60. (princ)
  61. )



网友答:
xiaxiang 发表于 2011-11-16 15:47

您好，能不能改成框选呀，就是框选后，把框选中所有圆内的东东全剪了，谢谢！

网友答:
xiaxiang 发表于 2011-11-16 16:41

谢谢您，效果很好

网友答:
443971181 发表于 2011-11-16 16:47
谢谢您，效果很好

非常感谢！怎么给您加分呢？

网友答: 有没有c#版的？

网友答: 不错，效果很好。

网友答: 路过，学习了
  • 上一篇：[LISP]Lisp文件的加密工具和解密工具,请下载!
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025