[原创]：※※※扩展修剪程序※※※

snsj

用ET扩展的函数做了个批量扩展修剪的工具:
[php]
;;;|增强扩展修剪工具
;;;|程序运行前请检查是否安装ET扩展工具
;;;|制作:snsj 2004.6.5
(defun c:ttr (/ ss ob blpt pt doc mspace vb kew ptt ppt minpt)
(princ "******|增强修剪程序(用于2000+版本)，制作:snsj，欢迎你光临小东CAD!!!(如程序异常,请安装ET扩展)|******")
(vl-load-com)(load "extrim.lsp")
(vla-startundomark(setq doc(vla-get-activedocument(vlax-get-acad-object))))
  (setq mspace(vla-get-modelspace doc)
        vb(vlax-make-safearray vlax-vbObject '(0 . 0))
        )
(if(ssget '((0 . "ellipse,circle,lwpolyline")))
  (progn
    (initget "A")
    (setq kew (getkword"\n外部修剪<A>/内部修剪<回车>:"))
  (vlax-for ob(vla-get-activeselectionset doc)
    (if(vlax-curve-isClosed ob)
      (progn
     (vla-getboundingbox ob 'minpt nil)
     (setq ptt(vlax-safearray->list minpt))
     (setq ppt(list(-(car ptt)100)(-(cadr ptt)100)))
      (if(=(vla-get-ObjectName ob)"AcDbPolyline")
        (progn
          (vlax-safearray-put-element vb 0 ob)
          (setq pt(vlax-get(car(vlax-safearray->list
                   (vlax-variant-value(vla-addregion mspace vb))))
                     "centroid"))
                            )
        (setq pt(vlax-get  ob "center"))
                        )       
      (if(null kew)(etrim(vlax-vla-object->ename ob)pt)
        (etrim(vlax-vla-object->ename ob)ppt))
      )))
)(princ"\n******|选择对象为空|******")
  )(vla-endundomark doc)(setvar "highlight" 1)(princ)
  )
      [/php]

snsj

最初由 snsj 发布
[B]用ET扩展的函数做了个批量扩展修剪的工具:
[php]
;;;|增强扩展修剪工具
;;;|程序运行前请检查是否安装ET扩展工具
;;;|制作:snsj 2004.6.5
(defun c:ttr (/ ss ob blpt pt doc mspace vb kew ptt ppt minpt)
(p... [/B]

效果演示:

[swf w=512 h=482]http://www.xdcad.net/bbstech/snsj/snsj-ttr.swf[/swf]

snsj

支持封闭和不封闭物体的:
[php]
;;;|增强扩展修剪工具
;;;|程序运行前请检查是否安装ET扩展工具
;;;|制作:snsj 2004.6.5
(defun c:ttr (/ ss ob blpt pt doc mspace vb kew ptt ppt minpt kw)
(princ "******|增强修剪程序(用于2000+版本)，制作:snsj，欢迎你光临小东CAD!!!(如程序异常,请安装ET扩展)|******")
(vl-load-com)(load "extrim.lsp")
(vla-startundomark(setq doc(vla-get-activedocument(vlax-get-acad-object))))
  (setq mspace(vla-get-modelspace doc)
        vb(vlax-make-safearray vlax-vbObject '(0 . 0))
        )
      (initget "A")
    (setq kw (getkword"\n处理封闭图形<A>/处理不封闭图形<回车>:"))
  (cond((null kw)
(if(ssget '((0 . "ellipse,arc,lwpolyline,line")))
  (progn
    (setq pt(getpoint "\n点取修剪方向:"))
    (vlax-for ob(vla-get-activeselectionset doc)
      (if(not(vlax-curve-isClosed ob))
         (etrim(vlax-vla-object->ename ob)pt)
      ))
    )
  )
        )
(t       
(if(ssget '((0 . "ellipse,circle,lwpolyline")))
  (progn
    (initget "A")
    (setq kew (getkword"\n外部修剪<A>/内部修剪<回车>:"))
  (vlax-for ob(vla-get-activeselectionset doc)
    (if(vlax-curve-isClosed ob)
      (progn
     (vla-getboundingbox ob 'minpt nil)
     (setq ptt(vlax-safearray->list minpt))
     (setq ppt(list(-(car ptt)100)(-(cadr ptt)100)))
      (if(=(vla-get-ObjectName ob)"AcDbPolyline")
        (progn
          (vlax-safearray-put-element vb 0 ob)
          (setq pt(vlax-get(car(vlax-safearray->list
                   (vlax-variant-value(vla-addregion mspace vb))))
                     "centroid"))
                            )
        (setq pt(vlax-get  ob "center"))
                        )       
      (if(null kew)(etrim(vlax-vla-object->ename ob)pt)
        (etrim(vlax-vla-object->ename ob)ppt))
      )))
)(princ"\n******|选择对象为空|******")
  ))
       )
(vla-endundomark doc)(setvar "highlight" 1)(princ)
  )
      [/php]

xianxl

谢谢SNSJ ！我正苦于找不到这个功能呢，尤其是后面改过的更棒！

lt_zzy

我画了一个圆和一个矩形，一条直线穿过这两个实体，
然后用TTR

提示：
无效点，多边形线段长度为零。
; 错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "orthomode" nil

snsj

不会吧，这个是依次处理的，装ET扩展工具了么？需要有ET支持的

lt_zzy

我安装了ET工具呀。
那个提示错误的变量是不是坐标转换的变量？

netbee

你是不是运行着我的坐标标注程序？
呵呵，错误处理函数中没有判断变量orthomode_old的语句，所以当程序在orthomode_old变量赋值之前出错的话，CAD将跳至这个出错处理程序，而此时执行(setvar "orthomode" orthomode_old) 是肯定会出错的。所以这里再出错，它就无法显示出错信息且无法正常退出程序啦。

2. 
   
3. 
   
4. ;;--------------------------------
   
5. 
   
6.   (defun err_new (msg)
   
7.     (setvar "orthomode" orthomode_old)
   
8.     (princ msg)
   
9.     (setclose_zb)
   
10.   ) ;_ 结束defun
    

<br /> <br /> ;;-------------------------------- <br /> <br />   (defun err_new (msg) <br />     (setvar "orthomode" orthomode_old)<br />     (princ msg) <br />     (setclose_zb) <br />   ) ;_ 结束defun <br />

去坐标标注帖子看看
http://www.xdcad.net/forum/showthread.php?s=&threadid=193061

yjtdkj

请问下面这个是怎么回事呀
命令:
TTR
******|增强修剪程序(用于2000+版本)，制作:snsj，欢迎你光临小东CAD!!!(如程序异常,
请安装ET扩展)|******
处理封闭图形<A>/处理不封闭图形<回车>:
选择对象: 找到 1 个
选择对象: 找到 1 个，总计 2 个
选择对象:
点取修剪方向:
错误: Automation 错误。 调用方法 Clear (接口 IAcadSelectionSet) 失败

andyhua5240

好东西，下载了！
明天帮你测试一下！
测试的重点是第二个，要是好的话，那就是我们这些菜鸟的福气！
谢谢！

eachy

最初由 yjtdkj 发布
[B]请问下面这个是怎么回事呀
命令:
TTR
******|增强修剪程序(用于2000+版本)，制作:snsj，欢迎你光临小东CAD!!!(如程序异常,
请安装ET扩展)|******
处理封闭图形<A>/处理不封闭图形<回车>:
选择对象: 找到 1 个... [/B]

调用 ActiveSelectionSet 的程序经常出现的毛病，程序开始前先清理"CURRENT"就可以避免。

aeo

对于任意形状的polyline ,"centroid"来判断内外显然是不行的.

snsj

恩，这个只针对大部分的情况，对形心在外部的情况可能出现相反，个别问题个别解决吧:)

黄卫文

最初由 snsj 发布
[B]恩，这个只针对大部分的情况，对形心在外部的情况可能出现相反，个别问题个别解决吧:) [/B]

建议对于任意形状的polyline，先通过由它们的点来求面积确定其点表的走向顺序，是顺时针还是逆时针方向；然后只要根据任意连续的两点就能给内外点了。

yjtdkj

最初由 eachy 发布
[B]
[处理封闭图形<A>/处理?.. [/B]

先谢谢斑竹了，不但我是个新手，能否告诉我具体怎么操作？