明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4792|回复: 16

[已解答] 智能修剪 改进

[复制链接]
发表于 2014-6-14 19:01 | 显示全部楼层 |阅读模式
  这是论坛里一个大大的程序   
当我看见这程序  非常喜欢  但遗憾的是不支持PL线 还有圆弧线  
  请大大 版主们帮忙改改 谢谢

让他支持 PL线 圆弧线

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2017-8-24 23:08 | 显示全部楼层
本帖最后由 sroo 于 2017-8-24 23:25 编辑

好厉害!

6楼代码好长。不过cad2006以上的版本输入剪切命令trim,按两下空格键,好像也可以实现吧,即
(defun c : Q() (command "TRIM") (command "") (princ "修剪Q") (princ))
发表于 2022-1-29 18:20 | 显示全部楼层
我工作中 碰不到这种 案例
发表于 2018-3-20 20:59 | 显示全部楼层
下載學習,謝謝版主!
发表于 2014-6-15 08:53 | 显示全部楼层
可以上个动画吗?请问和EXTRIM有何区别?
发表于 2014-6-15 11:11 来自手机 | 显示全部楼层
trim再输入f就可以修剪多段线,圆弧。按照这个编写程序
 楼主| 发表于 2014-6-15 16:35 | 显示全部楼层
荒野孤行 发表于 2014-6-15 11:11
trim再输入f就可以修剪多段线,圆弧。按照这个编写程序

大哥 能帮我把程序改改吗????
发表于 2014-6-15 20:57 | 显示全部楼层
love1030312 发表于 2014-6-15 16:35
大哥 能帮我把程序改改吗????

论坛上已经有人发过了,直接找下就好了
发表于 2014-6-16 22:05 | 显示全部楼层
估计论坛应该有完美解决的版本吧,我倒是有个凑合的程序
声明觉非原创。略加修改。
只能实现框选修剪,对于多段线,并不能完美处理。
闭合多段线得点再来一次,另外多段线的修剪后有的会是散的。。
暂时不打算深入研究
你在论坛继续找找吧,不过还得吐槽论坛的搜索功能,感觉搜索功能不是很理想。。。有的压根搜索不到。。

以下是代码,再次申明,非原创。
  1. ;;;=======================[ BreakObjects.lsp ]==============================
  2. ;;; Author: Copyright?2006,2007 Charles Alan Butler
  3. ;;; Contact @  www.TheSwamp.org
  4. ;;; Version:  1.3 April 9,2007
  5. ;;; Globalization by XANADU - www.xanadu.cz
  6. ;;; Purpose: Break All selected objects
  7. ;;;    permitted objects are lines, lwplines, plines, splines,
  8. ;;;    ellipse, circles & arcs
  9. ;;;                           
  10. ;;;  Function  c:BreakAll -      Break all objects selected
  11. ;;;  Function  c:BreakwObjects - Break many objects with a single object
  12. ;;;  Function  c:BreakObject -   Break a single object with many objects
  13. ;;;  Function  c:BreakWith -     Break selected objects with other selected objects
  14. ;;;  Function  c:BreakTouching - Break objects touching the single Break object
  15. ;;;  Function  c:BreakSelected - Break selected objects with any  objects that touch it
  16. ;;;                    
  17. ;;; Sub_Routines:      
  18. ;;;    break_with      
  19. ;;;    ssget->vla-list
  20. ;;;    list->3pair     
  21. ;;;    onlockedlayer   
  22. ;;;    get_interpts Return a list of intersect points
  23. ;;;    break_obj  Break entity at break points in list
  24. ;;; Requirements: objects must have the same z-value
  25. ;;; Restrictions: Does not Break objects on locked layers
  26. ;;; Returns:  none
  27. ;;;=====================================================================
  28. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED    ;
  29. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
  30. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.           ;
  31. ;;;                                                                   ;
  32. ;;;  You are hereby granted permission to use, copy and modify this   ;
  33. ;;;  software without charge, provided you do so exclusively for      ;
  34. ;;;  your own use or for use by others in your organization in the    ;
  35. ;;;  performance of their normal duties, and provided further that    ;
  36. ;;;  the above copyright notice appears in all copies and both that   ;
  37. ;;;  copyright notice and the limited warranty and restricted rights  ;
  38. ;;;  notice below appear in all supporting documentation.             ;
  39. ;;;=====================================================================


  40. ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  41. ;;               M A I N   S U B R O U T I N E                  
  42. ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  43. ;;打断对象,隔断对象,自断
  44. (defun NBTF_break_with (ss2brk             ss2brkwith          self
  45.                         /             cmd          intpts
  46.                         lst             masterlist          ss
  47.                         ssobjs             onlockedlayer
  48.                         ssget->vla-list                  list->3pair
  49.                         get_interpts break_obj
  50.                        )
  51.   ;; ss2brk     selection set to break
  52.   ;; ss2brkwith selection set to use as break points
  53.   ;; self       when true will allow an object to break itself
  54.   ;;            note that plined will break at each vertex
  55.   (vl-load-com)


  56.   ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  57.   ;;                S U B   F U N C T I O N S                     
  58.   ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  59.   (defun onlockedlayer (ename / entlst)
  60.     (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
  61.     (= 4 (logand 4 (cdr (assoc 70 entlst))))
  62.   )

  63.   (defun ssget->vla-list (ss / i ename lst)
  64.     (setq i -1)
  65.     (while (setq ename (ssname ss (setq i (1+ i))))
  66.       (setq lst (cons (vlax-ename->vla-object ename) lst))
  67.     )
  68.     lst
  69.   )

  70.   (defun list->3pair (old / new)
  71.     (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
  72.                  old (cdddr old)
  73.            )
  74.     )
  75.     (reverse new)
  76.   )

  77.   ;;==============================================================
  78.   ;;  return a list of intersect points
  79.   ;;==============================================================
  80.   (defun get_interpts (obj1 obj2 / iplist)
  81.     (if        (not (vl-catch-all-error-p
  82.                (setq
  83.                  iplist        (vl-catch-all-apply
  84.                           'vlax-safearray->list
  85.                           (list
  86.                             (vlax-variant-value
  87.                               (vla-intersectwith obj1 obj2 acextendnone)
  88.                             )
  89.                           )
  90.                         )
  91.                )
  92.              )
  93.         )
  94.       iplist
  95.     )
  96.   )


  97.   ;;==============================================================
  98.   ;;  Break entity at break points in list
  99.   ;;==============================================================
  100.   (defun break_obj        (ent            brkptlst   /          brkobjlst
  101.                          en            enttype    maxparam          closedobj
  102.                          minparam   obj               obj2break  p1param
  103.                          p2            p2param
  104.                         )

  105.     (setq obj2break ent
  106.           brkobjlst (list ent)
  107.           enttype   (cdr (assoc 0 (entget ent)))
  108.     )

  109.     (foreach brkpt brkptlst
  110.       ;;  get last entity created via break in case multiple breaks
  111.       (if brkobjlst
  112.         (progn
  113.           ;;  if pt not on object x, switch objects
  114.           (if (not (numberp (vl-catch-all-apply
  115.                               'vlax-curve-getdistatpoint
  116.                               (list obj2break brkpt)
  117.                             )
  118.                    )
  119.               )
  120.             (foreach obj brkobjlst        ; find the one that pt is on
  121.               (if (numberp (vl-catch-all-apply
  122.                              'vlax-curve-getdistatpoint
  123.                              (list obj brkpt)
  124.                            )
  125.                   )
  126.                 (setq obj2break obj)        ; switch objects
  127.               )
  128.             )
  129.           )
  130.         )
  131.       )

  132.       ;;  Handle any objects that can not be used with the Break Command
  133.       ;;  using one point, gap of 0.000001 is used
  134.       (cond
  135.         ((and (= "SPLINE" enttype)        ; only closed splines
  136.               (vlax-curve-isclosed obj2break)
  137.          )
  138.          (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
  139.                p2      (vlax-curve-getpointatparam
  140.                          obj2break
  141.                          (+ p1param 0.000001)
  142.                        )
  143.          )
  144.          (command "._break"
  145.                   obj2break
  146.                   "_non"
  147.                   (trans brkpt 0 1)
  148.                   "_non"
  149.                   (trans p2 0 1)
  150.          )
  151.         )
  152.         ((= "CIRCLE" enttype)                ; break the circle
  153.          (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
  154.                p2      (vlax-curve-getpointatparam
  155.                          obj2break
  156.                          (+ p1param 0.000001)
  157.                        )
  158.          )
  159.          (command "._break"
  160.                   obj2break
  161.                   "_non"
  162.                   (trans brkpt 0 1)
  163.                   "_non"
  164.                   (trans p2 0 1)
  165.          )
  166.          (setq enttype "ARC")
  167.         )
  168.         ((and (= "ELLIPSE" enttype)        ; only closed ellipse
  169.               (vlax-curve-isclosed obj2break)
  170.          )
  171.          ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005
  172.          (setq p1param        (vlax-curve-getparamatpoint obj2break brkpt)
  173.                p2param        (+ p1param 0.000001)
  174.                minparam        (min p1param p2param)
  175.                maxparam        (max p1param p2param)
  176.                obj        (vlax-ename->vla-object obj2break)
  177.          )
  178.          (vlax-put obj 'startparameter maxparam)
  179.          (vlax-put obj 'endparameter (+ minparam (* pi 2)))
  180.         )

  181.         ;;==================================
  182.         (t                                ;   Objects that can be broken     
  183.          (setq closedobj (vlax-curve-isclosed obj2break))
  184.          (command "._break"
  185.                   obj2break
  186.                   "_non"
  187.                   (trans brkpt 0 1)
  188.                   "_non"
  189.                   (trans brkpt 0 1)
  190.          )
  191.          (if (not closedobj)                ; new object was created
  192.            (setq brkobjlst (cons (entlast) brkobjlst))
  193.          )
  194.         )
  195.       )
  196.     )
  197.   )



  198.   ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  199.   ;;                   S T A R T   H E R E                        
  200.   ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  201.   (if (and ss2brk ss2brkwith)
  202.     (progn
  203.       ;;  CREATE a list of entity & it's break points
  204.       (foreach obj (ssget->vla-list ss2brk)
  205.                                         ; check each object in ss2brk
  206.         (if (not (onlockedlayer (vlax-vla-object->ename obj)))
  207.           (progn
  208.             (setq lst nil)
  209.             ;; check for break pts with other objects in ss2brkwith
  210.             (foreach intobj (ssget->vla-list ss2brkwith)
  211.               (if (and (or self (not (equal obj intobj)))
  212.                        (setq intpts (get_interpts obj intobj))
  213.                   )
  214.                 (setq lst (append (list->3pair intpts) lst))
  215.                                         ; entity w/ break points
  216.               )
  217.             )
  218.             (if        lst
  219.               (setq masterlist
  220.                      (cons (cons (vlax-vla-object->ename obj) lst)
  221.                            masterlist
  222.                      )
  223.               )
  224.             )
  225.           )
  226.         )
  227.       )
  228.       ;;  masterlist = ((ent brkpts)(ent brkpts)...)
  229.       (if masterlist
  230.         (foreach obj2brk masterlist
  231.           (break_obj (car obj2brk) (cdr obj2brk))
  232.         )
  233.       )
  234.     )
  235.   )
  236.   ;;==============================================================
  237. )




  238. ;;==========================================================
  239. ;;  选择对象被图中对象打断  
  240. ;;==========================================================


  241. ;(defun c:BreakSelected (/ cmd ss1 ss2)

  242. (defun c:tt (/ cmd ss1 ss2)  
  243. ;;  get all objects touching entities in the sscross
  244. ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
  245.   (defun gettouching (sscros / ss lst lstb lstc objl)
  246.     (and
  247.       (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
  248.             objl (mapcar 'vlax-ename->vla-object lstb)
  249.       )
  250.       (setq
  251.         ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
  252.                              (cons 410 (getvar "ctab"))))
  253.       )
  254.       (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  255.       (setq lst (mapcar 'vlax-ename->vla-object lst))
  256.       (mapcar
  257.         '(lambda (x)
  258.            (mapcar
  259.              '(lambda (y)
  260.                 (if (not
  261.                       (vl-catch-all-error-p
  262.                         (vl-catch-all-apply
  263.                           '(lambda ()
  264.                              (vlax-safearray->list
  265.                                (vlax-variant-value
  266.                                  (vla-intersectwith y x acextendnone)
  267.                                ))))))
  268.                   (setq lstc (cons (vlax-vla-object->ename x) lstc))
  269.                 )
  270.               ) objl)
  271.          ) lst)
  272.     )
  273.     lstc
  274.   )  
  275.   (setq cmd (getvar "CMDECHO"))
  276.   (setvar "CMDECHO" 0)
  277.   (command "._undo" "_begin")  
  278. ;;  get objects to break
  279.   (while(and (setq p1(getpoint "\n指定第一点:"))
  280.           (setq p3(getcorner p1 "\n指定第二点:"))
  281.           )
  282.     (setq ss1 (ssadd))
  283.   (if (and ;(not (prompt "\n(选择对象被图中对象打断)选择需要打断的对象<退出>: "))
  284.            (setq ss2 (ssget "c" p1 p3 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
  285.            (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
  286.       )
  287.     (progn
  288.       
  289.     (NBTF_break_with ss2 ss1 nil); ss2break ss2breakwith (flag nil = not to break with self)
  290.     (if(setq ss3(ssget "w" p1 p3 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
  291.       (command "_.ERASE" ss3"")
  292.       )
  293.     )
  294.   )
  295.     )
  296.     (command "._undo" "_end")
  297.     (setvar "CMDECHO" cmd)  
  298.   (princ)
  299. )


  300. ;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
  301. ;;    E n d   O f   F i l e   I f   y o u   A r e   H e r e      
  302. ;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
 楼主| 发表于 2014-6-17 08:20 | 显示全部楼层
大大   你 说话太经典了  都是我的心声啊    感谢大大
 楼主| 发表于 2014-6-17 08:21 | 显示全部楼层
edata 发表于 2014-6-16 22:05
估计论坛应该有完美解决的版本吧,我倒是有个凑合的程序
声明觉非原创。略加修改。
只能实现框选修剪,对 ...

大大   你 说话太经典了  都是我的心声啊    感谢大大
 楼主| 发表于 2014-6-17 09:09 | 显示全部楼层
edata 发表于 2014-6-16 22:05
估计论坛应该有完美解决的版本吧,我倒是有个凑合的程序
声明觉非原创。略加修改。
只能实现框选修剪,对 ...

大大 圆角部分怎么没有了
发表于 2015-9-8 10:25 | 显示全部楼层
为什么不能下载?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 10:09 , Processed in 0.245332 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表