明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2091|回复: 1

请高手帮忙看看

[复制链接]
发表于 2012-3-5 16:50:03 | 显示全部楼层 |阅读模式
怎样融合这两个lisp命令为一个?使用交点打断时,自动先打断多段线。即交点打断包含多段线。
1.多段线打断:
;;;选择的pline线在端点处全部断开.
(defun c:bb (/ ss i en) ;_定义命令名 2006/10/14 师兄
  (defun bb1 (e / bg ed no p10 pl pl10 plist pltype pt1 pt2)
    (defun GETPLVTX (E / ED)
      (defun DXF (NO)
(cdr (assoc NO ED))
      )     ;end defun
      (defun GETLWPL (ED / pl pl10)
(while
   (setq ED (cdr (member (setq PL10 (assoc 10 ED)) ED)))
    (setq PL (cons (cdr PL10) PL))
)
(reverse PL)
      )     ;end defun
      (defun GETPL (ED / e p10 pl)
(setq E (DXF -1))
(while
   (setq E (entnext E))
    (if
      (setq P10 (cdr (assoc 10 (entget E))))
       (setq PL (cons P10 PL))
    )    ;end if
)    ;end while
(reverse PL)
      )     ;end defun
      (setq ED (entget E))
      (setq PLTYPE (DXF 0))
      (cond
((= "POLYLINE" PLTYPE)
  (GETPL ED)
)
((= "LWPOLYLINE" PLTYPE)
  (GETLWPL ED)
)
      )
    )
    ;;下边为了适应多个对象,这行注释,并将e作为此函数的参数
;;;   (setq e (car (entsel "选择要断开全部端点的多线段? ")))
    (setq ED (entget E))
     ;(setq pw (cdr (assoc 41 ED)))  
     ;(setvar "plinewid" Pw)
    (setq bg T)
    (setq plist (GETPLVTX e))
     ;(command "erase" e "")
    (while (or bg (and pt1 pt2))
      (if (= bg T)
(setq bg nil)
(progn (command "break" e pt2 "@")
        (setq e (entlast))
)
      )
      (setq pt1 (car plist))
      (setq plist (cdr plist))
      (setq pt2 (car plist))
    )
  )
;;;下边是师兄加的部份
  (princ "\n选择要全部断开端点的多段:") ;_提示用户
  (setq ss (ssget)) ;_构建选择集 SS
  (setq i '0) ;_步进初值 0
  (if (= (type ss) 'PICKSET) ;_判断选择集有效性
    (repeat (sslength ss) ;_循环选择集中每一个对象
      (setq en (ssname ss i) ;_本次循环要处理的图元
     i  (1+ i) ;_下一图元的选择集索引加1
      )
      (bb1 en) ;_运行打断程序
    )
  )
  (princ);_静默退出
)
2.交点打断:
;;;=======================[ BreakObjects.lsp ]==============================
;;; Author: Copyright?2006,2007 Charles Alan Butler
;;; Contact @  www.TheSwamp.org
;;; Version:  1.3 April 9,2007
;;; Globalization by XANADU - www.xanadu.cz
;;; Purpose: Break All selected objects
;;;    permitted objects are lines, lwplines, plines, splines,
;;;    ellipse, circles & arcs
;;;                           
;;;  Function  c:BreakAll -      Break all objects selected
;;;  Function  c:BreakwObjects - Break many objects with a single object
;;;  Function  c:BreakObject -   Break a single object with many objects
;;;  Function  c:BreakWith -     Break selected objects with other selected objects
;;;  Function  c:BreakTouching - Break objects touching the single Break object
;;;  Function  c:BreakSelected - Break selected objects with any  objects that touch it
;;;                    
;;; Sub_Routines:      
;;;    break_with      
;;;    ssget->vla-list
;;;    list->3pair     
;;;    onlockedlayer   
;;;    get_interpts Return a list of intersect points
;;;    break_obj  Break entity at break points in list
;;; Requirements: objects must have the same z-value
;;; Restrictions: Does not Break objects on locked layers
;;; Returns:  none
;;;=====================================================================
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED    ;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.           ;
;;;                                                                   ;
;;;  You are hereby granted permission to use, copy and modify this   ;
;;;  software without charge, provided you do so exclusively for      ;
;;;  your own use or for use by others in your organization in the    ;
;;;  performance of their normal duties, and provided further that    ;
;;;  the above copyright notice appears in all copies and both that   ;
;;;  copyright notice and the limited warranty and restricted rights  ;
;;;  notice below appear in all supporting documentation.             ;
;;;=====================================================================

;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;               M A I N   S U B R O U T I N E                  
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;打断对象,隔断对象,自断
(defun NBTF_break_with (ss2brk      ss2brkwith   self
   /      cmd   intpts
   lst      masterlist   ss
   ssobjs      onlockedlayer
   ssget->vla-list    list->3pair
   get_interpts break_obj
         )
  ;; ss2brk     selection set to break
  ;; ss2brkwith selection set to use as break points
  ;; self       when true will allow an object to break itself
  ;;            note that plined will break at each vertex
  (vl-load-com)

  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;                S U B   F U N C T I O N S                     
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (defun onlockedlayer (ename / entlst)
    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
    (= 4 (logand 4 (cdr (assoc 70 entlst))))
  )
  (defun ssget->vla-list (ss / i ename lst)
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq lst (cons (vlax-ename->vla-object ename) lst))
    )
    lst
  )
  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
   old (cdddr old)
    )
    )
    (reverse new)
  )
  ;;==============================================================
  ;;  return a list of intersect points
  ;;==============================================================
  (defun get_interpts (obj1 obj2 / iplist)
    (if (not (vl-catch-all-error-p
        (setq
   iplist (vl-catch-all-apply
     'vlax-safearray->list
     (list
       (vlax-variant-value
         (vla-intersectwith obj1 obj2 acextendnone)
       )
     )
   )
        )
      )
)
      iplist
    )
  )

  ;;==============================================================
  ;;  Break entity at break points in list
  ;;==============================================================
  (defun break_obj (ent     brkptlst   /   brkobjlst
    en     enttype    maxparam   closedobj
    minparam   obj        obj2break  p1param
    p2     p2param
   )
    (setq obj2break ent
   brkobjlst (list ent)
   enttype   (cdr (assoc 0 (entget ent)))
    )
    (foreach brkpt brkptlst
      ;;  get last entity created via break in case multiple breaks
      (if brkobjlst
(progn
   ;;  if pt not on object x, switch objects
   (if (not (numberp (vl-catch-all-apply
         'vlax-curve-getdistatpoint
         (list obj2break brkpt)
       )
     )
       )
     (foreach obj brkobjlst ; find the one that pt is on
       (if (numberp (vl-catch-all-apply
        'vlax-curve-getdistatpoint
        (list obj brkpt)
      )
    )
  (setq obj2break obj) ; switch objects
       )
     )
   )
)
      )
      ;;  Handle any objects that can not be used with the Break Command
      ;;  using one point, gap of 0.000001 is used
      (cond
((and (= "SPLINE" enttype) ; only closed splines
       (vlax-curve-isclosed obj2break)
  )
  (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
        p2      (vlax-curve-getpointatparam
    obj2break
    (+ p1param 0.000001)
         )
  )
  (command "._break"
    obj2break
    "_non"
    (trans brkpt 0 1)
    "_non"
    (trans p2 0 1)
  )
)
((= "CIRCLE" enttype)  ; break the circle
  (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
        p2      (vlax-curve-getpointatparam
    obj2break
    (+ p1param 0.000001)
         )
  )
  (command "._break"
    obj2break
    "_non"
    (trans brkpt 0 1)
    "_non"
    (trans p2 0 1)
  )
  (setq enttype "ARC")
)
((and (= "ELLIPSE" enttype) ; only closed ellipse
       (vlax-curve-isclosed obj2break)
  )
  ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005
  (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
        p2param (+ p1param 0.000001)
        minparam (min p1param p2param)
        maxparam (max p1param p2param)
        obj (vlax-ename->vla-object obj2break)
  )
  (vlax-put obj 'startparameter maxparam)
  (vlax-put obj 'endparameter (+ minparam (* pi 2)))
)
;;==================================
(t    ;   Objects that can be broken     
  (setq closedobj (vlax-curve-isclosed obj2break))
  (command "._break"
    obj2break
    "_non"
    (trans brkpt 0 1)
    "_non"
    (trans brkpt 0 1)
  )
  (if (not closedobj)  ; new object was created
    (setq brkobjlst (cons (entlast) brkobjlst))
  )
)
      )
    )
  )

  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;                   S T A R T   H E R E                        
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (if (and ss2brk ss2brkwith)
    (progn
      ;;  CREATE a list of entity & it's break points
      (foreach obj (ssget->vla-list ss2brk)
     ; check each object in ss2brk
(if (not (onlockedlayer (vlax-vla-object->ename obj)))
   (progn
     (setq lst nil)
     ;; check for break pts with other objects in ss2brkwith
     (foreach intobj (ssget->vla-list ss2brkwith)
       (if (and (or self (not (equal obj intobj)))
         (setq intpts (get_interpts obj intobj))
    )
  (setq lst (append (list->3pair intpts) lst))
     ; entity w/ break points
       )
     )
     (if lst
       (setq masterlist
       (cons (cons (vlax-vla-object->ename obj) lst)
      masterlist
       )
       )
     )
   )
)
      )
      ;;  masterlist = ((ent brkpts)(ent brkpts)...)
      (if masterlist
(foreach obj2brk masterlist
   (break_obj (car obj2brk) (cdr obj2brk))
)
      )
    )
  )
  ;;==============================================================
)

;;==========================================
;;        Break all objects selected        
;;==========================================
(defun c:breakall (/ cmd ss)
  (command "._undo" "_begin")
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
;;  get objects to break
  (prompt "\n选择需要打断的对象: ")
  (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
     (NBTF_break_with ss ss nil); ss2break ss2breakwith (flag nil = not to break with self)
  )
  (setvar "CMDECHO" cmd)
  (command "._undo" "_end")
  (princ)
)


;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;;    E n d   O f   F i l e   I f   y o u   A r e   H e r e      
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

发表于 2014-5-19 01:14:22 | 显示全部楼层
这个好像很厉害,可能是论坛交点打断目前最好的源码了吧。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-5-24 17:21 , Processed in 0.177208 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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