Rated 5/5 based on 240179 internet user reviews

Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

lisp xóa tất cả các đối tượng trong 1 vùng kín


  • Please log in to reply
74 replies to this topic

#21 thiep

thiep

    biết dimdiameter

  • Members
  • PipPipPipPipPip
  • 331 Bài viết
Điểm đánh giá: 247 (khá)

Đã gửi 01 July 2009 - 12:51 PM

Bác Thiếp à,,sory bác vì lúc đầu e chỉ gặp rắc rối với 1 curve, vấn đề về 2 curve là ý tưởng phát sinh mà, hìhì...nhưng sao lisp này không kết hợp được với extrim giống như 1 curve hả bác thiep?nếu kết hợp được với extrim thì tuyệt quá bác thiêp a!Thanks bác nhiều nhiều nha

Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.
  • 0

#22 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 01 July 2009 - 01:43 PM

Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

vâng,chúc bác có chuyến công tác vui vẻ và thành công, mong được sự tiếp tục giúp đỡ của bác cũng như của cadviet :s_big:
  • 2
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#23 billgateviet

billgateviet

    biết vẽ pline

  • Members
  • PipPip
  • 63 Bài viết
Điểm đánh giá: 29 (tàm tạm)

Đã gửi 01 July 2009 - 02:29 PM

Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

Đi công tác xa chớ có ăn gà rừng là "ngẻo cổ" đó nghe. Chúc pác mnột chuyến công tác ZUI ZẺ
  • 1

#24 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 01 July 2009 - 03:52 PM

Mong Bác Thiệp có một chuyến công tác tốt đẹp và thuận lợi.
  • 0

#25 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 02 July 2009 - 09:12 AM

Nanhai à, vì ban đầu bạn chỉ yêu cầu xóa các đối tượng trong 1 curve.
Sau đó thì Nanhai yêu cầu thêm xóa các đối tượng ngoài 1 curve.
Bây giờ thì yêu cầu thêm xóa các đối tượng giữa 2 curve, chứ không có "hình như" bạn ạ
...........
Lisp đã chỉnh sửa:

ERC.LSP free lisp from cadviet.com
;; copyright by Thiep,06/2009
................................

Chào các bạn.
Về cơ bản thì LISP ERC của bạn Thiệp đã giải quyết đuợc các yêu cầu xóa các đối tuợng trong, ngoài và giữa 2 đuờng bao.
Tuy nhiên với các đối tuợng có giao với đuờng bao thì Lisp ERC chưa hoàn chỉnh.
Để giải quyết vấn đề xóa các đối tuợng có giao với đuờng bao, tui dùng giải pháp là cắt các đối tuợng này tại giao điểm với đuờng bao, sử dụng hàm break_with của CAB trên www.TheSwamp.org
Do hàm break_with chỉ cắt các đối tuợng lines, lwplines, plines, splines, ellipse, circles & arcs nên với các đối tuợng còn lại như Text, Dimension,... LISP không giải quyết triệt để. :s_big:

Các bạn chạy thử và cho ý kiến. File
(defun c:EWB (/ ov vl ss1 ss2 ptLst plSet) ;EWB -> Erase With Boundary  (defun *error* (msg)        (if ov (mapcar 'setvar vl ov)) ; reset Sys vars    (princ (strcat "\n<< Error: " msg " >>")) ; Print Error Message    (princ) ; Exit Cleanly    )  (command "_.undo" "_begin")  (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list        ov (mapcar 'getvar vl)) ; Get Old values    (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE  (initget "T N G")  (setq	bit (getkword "\nBan muon xoa Trong hay Ngoai duong bao, hay Giua 2 duong bao <T/N/G>: " ) )  (cond    ((= bit "T") ;xoa Trong duong bao     (princ"\n<<< Chon duong bao >>> ")     (if (and (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))	      (setq ssInside (GetssInside ss))	      (> (sslength ssInside) 0))       (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside))) ) ; xoa ssInside       )     )        ((= bit "G") ;xoa giua 2 duong bao     (princ"\n<<< Chon duong bao ngoai >>> ")     (setq ssN (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))     (princ"\n<<< Chon duong bao trong >>> ")     (setq ssT (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))	   curT (ssname ssT 0)	   ssT (GetssInside ssT)	   ssN (GetssInside ssN))     (if (and ssT (> (sslength ssT) 0) ssN (> (sslength ssN) 0) )       (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssT)))	 (if (ssmemb e ssN) (ssdel e ssN)))       )     (if (ssmemb curT ssN) (ssdel curT ssN))     (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssN))) ) ; xoa ss     )    ((= bit "N") ;xoa Ngoai duong bao     (initget "T G")     (setq bit (getkword "\nXoa Tat ca doi tuong ngoai duong bao, hay chi doi tuong Giao voi duong bao <T/G>: " ) )     (princ"\n<<< Chon duong bao >>> ")     (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))	   cur (ssname ss 0))     (if (= bit "T")       (progn ;xoa Tat ca doi tuong ngoai duong bao	 (setq ssInside (GetssInside ss)	       ssAll (ssget "x" (list (cons 410 (getvar "ctab")))) )	 (if (and ssInside (> (sslength ssInside) 0) )	   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside)))	     (if (ssmemb e ssAll) (ssdel e ssAll)))	   )	 (if (ssmemb cur ssAll) (ssdel cur ssAll))	 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssAll))) ) ; xoa ss	 )       ;chi xoa doi tuong Giao voi duong bao       (if (and (setq ssOutside (GetssOutside ss))		(> (sslength ssOutside) 0))	 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssOutside))) ) ; xoa ssOutside	 )       );if     );;xoa Ngoai duong bao    );cond  (mapcar 'setvar vl ov) ; reset Sys Vars  (command "_.undo" "_end")  (princ))(defun GetssOutside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)    (if (and (setq lstss1 (gettouching ss2))	   (setq ss1 (ssadd))	   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)	   )    (progn ; co ssTouching       (break_with ss1 ss2 nil 0)      (setq cur (ssname ss2 0)	    ssTouching (ssadd)	    ssOutside (ssadd))      (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))      ;loc ssTouching -> ssOutside      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))	(if	  (or	    (not(insidep (vlax-curve-getStartPoint e) cur))	    (not(insidep (vlax-curve-getEndPoint e) cur))	    (not(insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2)) cur))	    );or	  (ssadd e ssOutside)	  );if	);foreach      );progn    );if  (if (ssmemb cur ssOutside) (ssdel cur ssOutside))  ssOutside  )(defun GetssInside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)  (setq ptLst (GetPtLst (setq cur (ssname ss2 0)))	ssInside (ssget "_WP" ptLst ) )    (if (and (setq lstss1 (gettouching ss2))	   (setq ss1 (ssadd))	   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)	   )    (progn ; co ssTouching      (break_with ss1 ss2 nil 0)      (setq ssTouching (ssadd))      (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))      ;loc ssTouching -> ssInside      (or ssInside (setq ssInside (ssadd)) )      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))	(if	  (and (insidep (vlax-curve-getStartPoint e) cur)	       (insidep (vlax-curve-getEndPoint e) cur)	       (insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2))  cur)	       )	  (ssadd e ssInside)	  );if	);foreach      );progn    );if  (if (ssmemb cur ssInside) (ssdel cur ssInside))  ssInside  ) (defun GetPtLst (obj / startparam endparam anginc delta div inc pt ptlst)  (defun ZClosed (lst)    (if (and (vlax-curve-isClosed obj)       (not(equal (car lst)(last lst) 1e-6)))      (append lst (list (car lst)))      lst))    (or (eq (type obj) 'VLA-OBJECT)    (setq obj (vlax-ename->vla-object obj)))  (setq typ (vlax-get obj 'ObjectName))  (if (or (eq typ "AcDbCircle") (eq typ "AcDbEllipse"))    (progn      (setq param 0)      (while (< param (* pi 2))	(setq pt (vlax-curve-getPointAtParam obj param)	      ptlst (cons pt ptlst)	      param (+ (/ (* pi 2) 72) param))	)      (reverse ptlst)      )    (progn ;Pline (eq typ "AcDbPolyline")      (setq param (vlax-curve-getStartParam obj)	    endparam (vlax-curve-getEndParam obj)	    anginc (* pi (/ 7.5 180.0)))      (setq tparam param)      (while (<= param endparam)	(setq pt (vlax-curve-getPointAtParam obj param))	(if (not (equal pt (car ptlst) 1e-12))	  (setq ptlst (cons pt ptlst)))	(if  (and (/= param endparam)		  (setq blg (abs (vlax-invoke obj 'GetBulge param)))		  (/= 0 blg))	  (progn	    (setq delta (* 4 (atan blg)) ;included angle		  inc (/ 1.0 (1+ (fix (/ delta anginc))))                  arcparam (+ param inc))	    (while (< arcparam (1+ param))	      (setq pt (vlax-curve-getPointAtParam obj arcparam)                    ptlst (cons pt ptlst)                    arcparam (+ inc arcparam))))	  )	(setq param (1+ param))	)      (if (and (apply 'and ptlst)	       (> (length ptlst) 1))	(ZClosed (reverse ptlst))	)      )    )  );;  Copyright © 2009, Lee McDonnell;;  (Contact Lee Mac, CADTutor.net)(defun insidep  (pt Obj / Obj Tol ang doc spc flag int lin xV yV)  (defun vlax-list->3D-point (lst flag)  (if lst    (cons ((if flag car cadr) lst)          (vlax-list->3D-point (cdddr lst) flag))))  (or (eq 'VLA-OBJECT (type Obj))      (setq Obj (vlax-ename->vla-object Obj)))  (if (not(vlax-curve-getParamAtPoint Obj pt))    (progn  (setq Tol  (/ pi 6) ; Uncertainty        ang  0.0 flag T)  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))        spc (if (zerop (vla-get-activespace doc))              (if (= (vla-get-mspace doc) :vlax-true)                (vla-get-modelspace doc)                (vla-get-paperspace doc))              (vla-get-modelspace doc)))  (while (and (< ang (* 2 pi)) flag)    (setq flag (and                 (setq int                   (vlax-invoke                     (setq lin                       (vla-addLine spc                         (vlax-3D-point pt)                           (vlax-3D-point                             (polar pt ang                               (if (vlax-property-available-p Obj 'length)                                 (vla-get-length Obj) 1.0)))))                                  'IntersectWith Obj                                    acExtendThisEntity))                 (<= 6 (length int))                 (setq xV (vl-sort (vlax-list->3D-point int T) '<)                       yV (vl-sort (vlax-list->3D-point int nil) '<))                 (or (<= (car xV) (car pt) (last xV))                     (<= (car yV) (cadr pt) (last yV))))          ang  (+ ang Tol))    (vla-delete lin))  flag  )    T    ));;; Author: Copyrightゥ 2006-2008 Charles Alan Butler ;;; Contact @  www.TheSwamp.org;;===========================================================================  ;;  get all objects touching entities in the sscross                           ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"  ;;  returns a list of enames  ;;=========================================================================== (defun gettouching (sscros / ss lst lstb lstc objl)    (and      (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))            objl (mapcar 'vlax-ename->vla-object lstb)      )      (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")				 (cons 410 (getvar "ctab"))))      )      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))      (setq lst (mapcar 'vlax-ename->vla-object lst))      (mapcar        '(lambda (x)           (mapcar             '(lambda (y)                (if (not                      (vl-catch-all-error-p                        (vl-catch-all-apply                          '(lambda ()                             (vlax-safearray->list                               (vlax-variant-value                                 (vla-intersectwith y x acextendnone)                               ))))))                  (setq lstc (cons (vlax-vla-object->ename x) lstc))                )              ) objl)         ) lst)    )    lstc  );;; Author: Copyrightゥ 2006-2008 Charles Alan Butler ;;; Contact @  www.TheSwamp.org(defun break_with (ss2brk ss2brkwith self Gap / cmd intpts lst masterlist ss ssobjs                   onlockedlayer ssget->vla-list list->3pair GetNewEntities oc                   get_interpts break_obj GetLastEnt LastEntInDatabase ss2brkwithList                  )  ;; 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  ;;  ;; return list of enames of new objects    (vl-load-com)    (princ "\nCalculating Break Points, Please Wait.\n");;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;                S U B   F U N C T I O N S                      ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  ;;  return T if entity is on a locked layer  (defun onlockedlayer (ename / entlst)    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))    (= 4 (logand 4 (cdr (assoc 70 entlst))))  )  ;;  return a list of objects from a selection set;|  (defun ssget->vla-list (ss)    (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss ))))  )|;  (defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7       (setq i -1)       (while (setq  ename (ssname ss (setq i (1+ i))))         (setq allobj (cons (vlax-ename->vla-object ename) allobj))       )       allobj  )    ;;  return a list of lists grouped by 3 from a flat list  (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 BrkGap / brkobjlst en enttype maxparam closedobj                  minparam obj obj2break p1param p2param brkpt2 dlst idx brkptS                  brkptE brkpt result GapFlg result ignore dist tmppt                  #ofpts 2gap enddist lastent obj2break stdist                 )  (or BrkGap (setq BrkGap 0.0)) ; default to 0  (setq BrkGap (/ BrkGap 2.0)) ; if Gap use 1/2 per side of break point    (setq obj2break ent        brkobjlst (list ent)        enttype   (cdr (assoc 0 (entget ent)))        GapFlg    (not (zerop BrkGap)) ; gap > 0        closedobj (vlax-curve-isclosed obj2break)  )  ;; when zero gap no need to break at end points  (if (zerop Brkgap)    (setq spt (vlax-curve-getstartpoint ent)          ept (vlax-curve-getendpoint ent)          brkptlst (vl-remove-if '(lambda(x) (or (< (distance x spt) 0.0001)                                                 (< (distance x ept) 0.0001)))                                 brkptlst)    )  )  (if brkptlst    (progn  ;;  sort break points based on the distance along the break object  ;;  get distance to break point, catch error if pt is off end  ;; ver 2.0 fix - added COND to fix break point is at the end of a  ;; line which is not a valid break but does no harm  (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam obj2break                                               ;; ver 2.0 fix                                               (cond ((vlax-curve-getparamatpoint obj2break x))                                                   ((vlax-curve-getparamatpoint obj2break                                                     (vlax-curve-getclosestpointto obj2break x))))))                            ) brkptlst))  ;; sort primary list on distance  (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2)))))    (if GapFlg ; gap > 0    ;; Brkptlst starts as the break point and then a list of pairs of points    ;;  is creates as the break points    (progn      ;;  create a list of list of break points      ;;  ((idx# stpoint distance)(idx# endpoint distance)...)      (setq idx 0)      (foreach brkpt brkptlst                ;; ----------------------------------------------------------        ;;  create start break point, then create end break point            ;;  ((idx# startpoint distance)(idx# endpoint distance)...)          ;; ----------------------------------------------------------        (setq dist (cadr brkpt)) ; distance to center of gap        ;;  subtract gap to get start point of break gap        (cond          ((and (minusp (setq stDist (- dist BrkGap))) closedobj )           (setq stdist (+ (vlax-curve-getdistatparam obj2break                             (vlax-curve-getendparam obj2break)) stDist))           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))           )          ((minusp stDist) ; off start of object so get startpoint           (setq dlst (cons (list idx (vlax-curve-getstartpoint obj2break) 0.0) dlst))           )          (t           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))          )        )        ;;  add gap to get end point of break gap        (cond          ((and (> (setq stDist (+ dist BrkGap))                   (setq endDist (vlax-curve-getdistatparam obj2break                                     (vlax-curve-getendparam obj2break)))) closedobj )           (setq stdist (- stDist endDist))           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))           )          ((> stDist endDist) ; off end of object so get endpoint           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                        (vlax-curve-getendparam obj2break))                                  endDist) dlst))           )          (t           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))          )        )        ;; -------------------------------------------------------        (setq idx (1+ IDX))      ) ; foreach brkpt brkptlst            (setq dlst (reverse dlst))      ;;  remove the points of the gap segments that overlap      (setq idx -1            2gap (* BrkGap 2)            #ofPts (length Brkptlst)      )      (while (<= (setq idx (1+ idx)) #ofPts)        (cond          ((null result) ; 1st time through           (setq result (list (car dlst)) ; get first start point                 result (cons (nth (1+(* idx 2)) dlst) result))          )          ((= idx #ofPts) ; last pass, check for wrap           (if (and closedobj (> #ofPts 1)                    (<= (+(- (vlax-curve-getdistatparam obj2break                            (vlax-curve-getendparam obj2break))                          (cadr (last BrkPtLst))) (cadar BrkPtLst)) 2Gap))             (progn               (if (zerop (rem (length result) 2))                 (setq result (cdr result)) ; remove the last end point               )               ;;  ignore previous endpoint and present start point               (setq result (cons (cadr (reverse result)) result) ; get last end point                     result (cdr (reverse result))                     result (reverse (cdr result)))             )           )          )          ;; Break Gap Overlaps          ((< (cadr (nth idx Brkptlst)) (+ (cadr (nth (1- idx) Brkptlst)) 2Gap))           (if (zerop (rem (length result) 2))             (setq result (cdr result)) ; remove the last end point           )           ;;  ignore previous endpoint and present start point           (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get present end point           )          ;; Break Gap does Not Overlap previous point           (t           (setq result (cons (nth (* idx 2) dlst) result)) ; get this start point           (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get this end point          )        ) ; end cond stmt      ) ; while            (setq dlst     (reverse result)            brkptlst nil)      (while dlst ; grab the points only        (setq brkptlst (cons (list (cadar dlst)(cadadr dlst)) brkptlst)              dlst   (cddr dlst))      )    )  )  ;;   -----------------------------------------------------  ;; (if (equal  a ent) (princ)) ; debug CAB  -------------   (foreach brkpt (reverse brkptlst)    (if GapFlg ; gap > 0      (setq brkptS (car brkpt)            brkptE (cadr brkpt))      (setq brkptS (car brkpt)            brkptE brkptS)    )    ;;  get last entity created via break in case multiple breaks    (if brkobjlst      (progn        (setq tmppt brkptS) ; use only one of the pair of breakpoints        ;;  if pt not on object x, switch objects        (if (not (numberp (vl-catch-all-apply                            'vlax-curve-getdistatpoint (list obj2break tmppt))))          (progn ; find the one that pt is on            (setq idx (length brkobjlst))            (while (and (not (minusp (setq idx (1- idx))))                        (setq obj (nth idx brkobjlst))                        (if (numberp (vl-catch-all-apply                                       'vlax-curve-getdistatpoint (list obj tmppt)))                          (null (setq obj2break obj)) ; switch objects, null causes exit                          t                        )                   )            )          )        )      )    )    (setq closedobj (vlax-curve-isclosed obj2break))    (if GapFlg ; gap > 0      (if closedobj        (progn ; need to break a closed object          (setq brkpt2 (vlax-curve-getPointAtDist obj2break                     (- (vlax-curve-getDistAtPoint obj2break brkptE) 0.00001)))          (command "._break" obj2break "_non" (trans brkpt2 0 1)                   "_non" (trans brkptE 0 1))          (and (= "CIRCLE" enttype) (setq enttype "ARC"))          (setq BrkptE brkpt2)        )      )      (if (and closedobj                (not (setq brkptE (vlax-curve-getPointAtDist obj2break                       (+ (vlax-curve-getdistatparam obj2break                            ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))                            ;; ver 2.0 fix                            (cond ((vlax-curve-getparamatpoint obj2break brkpts))                                  ((vlax-curve-getparamatpoint obj2break                                      (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))))        (setq brkptE (vlax-curve-getPointAtDist obj2break                       (- (vlax-curve-getdistatparam obj2break                            ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001)))                            ;; ver 2.0 fix                            (cond ((vlax-curve-getparamatpoint obj2break brkpts))                                  ((vlax-curve-getparamatpoint obj2break                                      (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))       )    ) ; endif        ;; (if (null brkptE) (princ)) ; debug        (setq LastEnt (GetLastEnt))    (command "._break" obj2break "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1))    (and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r"))    (and (= "CIRCLE" enttype) (setq enttype "ARC"))    (if (and (not closedobj) ; new object was created             (not (equal LastEnt (entlast))))        (setq brkobjlst (cons (entlast) brkobjlst))    )  )  )  ) ; endif brkptlst  ) ; defun break_obj;;====================================;;  CAB - get last entity in datatbase(defun GetLastEnt ( / ename result )  (if (setq result (entlast))    (while (setq ename (entnext result))      (setq result ename)    )  )  result);;===================================;;  CAB - return a list of new enames(defun GetNewEntities (ename / new)  (cond    ((null ename) (alert "Ename nil"))    ((eq 'ENAME (type ename))      (while (setq ename (entnext ename))        (if (entget ename) (setq new (cons ename new)))      )    )    ((alert "Ename wrong type."))  )  new)    ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  ;;         S T A R T  S U B R O U T I N E   H E R E                ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++       (setq LastEntInDatabase (GetLastEnt))    (if (and ss2brk ss2brkwith)    (progn      (setq oc 0            ss2brkwithList (ssget->vla-list ss2brkwith))      (if (> (* (sslength ss2brk)(length ss2brkwithList)) 5000)        (setq *BrkVerbose* t)      )      (and *BrkVerbose*           (princ (strcat "Objects to be Checked: "            (itoa (* (sslength ss2brk)(length ss2brkwithList))) "\n")))      ;;  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  ss2brkwithList              (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              )              (and *BrkVerbose* (princ (strcat "Objects Checked: " (itoa (setq oc (1+ oc))) "\r")))            )            (if lst              (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))            )          )        )      )          (and *BrkVerbose* (princ "\nBreaking Objects.\n"))      (setq *brkcnt* 0) ; break counter      ;;  masterlist = ((ent brkpts)(ent brkpts)...)      (if masterlist        (foreach obj2brk masterlist          (break_obj (car obj2brk) (cdr obj2brk) Gap)        )      )      )  );;==============================================================   (and (zerop *brkcnt*) (princ "\nNone to be broken."))   (setq *BrkVerbose* nil)  (GetNewEntities LastEntInDatabase) ; return list of enames of new objects)

  • 6

#26 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 543 (tốt)

Đã gửi 02 July 2009 - 09:52 AM

Chào các bạn.
Về cơ bản thì LISP ERC của bạn Thiệp đã giải quyết đuợc các yêu cầu xóa các đối tuợng trong, ngoài và giữa 2 đuờng bao.
Tuy nhiên với các đối tuợng có giao với đuờng bao thì Lisp ERC chưa hoàn chỉnh.
Để giải quyết vấn đề xóa các đối tuợng có giao với đuờng bao, tui dùng giải pháp là cắt các đối tuợng này tại giao điểm với đuờng bao, sử dụng hàm break_with của CAB trên www.TheSwamp.org
Do hàm break_with chỉ cắt các đối tuợng lines, lwplines, plines, splines, ellipse, circles & arcs nên với các đối tuợng còn lại như Text, Dimension,... LISP không giải quyết triệt để. :s_big:

Các bạn chạy thử và cho ý kiến.

(defun c:EWB (/ ov vl ss1 ss2 ptLst plSet) ;EWB -> Erase With Boundary  (defun *error* (msg)        (if ov (mapcar 'setvar vl ov)) ; reset Sys vars    (princ (strcat "\n<< Error: " msg " >>")) ; Print Error Message    (princ) ; Exit Cleanly    )  (command "_.undo" "_begin")  (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list        ov (mapcar 'getvar vl)) ; Get Old values    (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE  (initget "T N G")  (setq	bit (getkword "\nBan muon xoa Trong hay Ngoai duong bao, hay Giua 2 duong bao <T/N/G>: " ) )  (cond    ((= bit "T") ;xoa Trong duong bao     (princ"\n<<< Chon duong bao >>> ")     (if (and (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))	      (setq ssInside (GetssInside ss))	      (> (sslength ssInside) 0))       (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside))) ) ; xoa ssInside       )     )        ((= bit "G") ;xoa giua 2 duong bao     (princ"\n<<< Chon duong bao ngoai >>> ")     (setq ssN (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))     (princ"\n<<< Chon duong bao trong >>> ")     (setq ssT (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))	   curT (ssname ssT 0)	   ssT (GetssInside ssT)	   ssN (GetssInside ssN))     (if (and ssT (> (sslength ssT) 0) ssN (> (sslength ssN) 0) )       (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssT)))	 (if (ssmemb e ssN) (ssdel e ssN)))       )     (if (ssmemb curT ssN) (ssdel curT ssN))     (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssN))) ) ; xoa ss     )    ((= bit "N") ;xoa Ngoai duong bao     (initget "T G")     (setq bit (getkword "\nXoa Tat ca doi tuong ngoai duong bao, hay chi doi tuong Giao voi duong bao <T/G>: " ) )     (princ"\n<<< Chon duong bao >>> ")     (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))	   cur (ssname ss 0))     (if (= bit "T")       (progn ;xoa Tat ca doi tuong ngoai duong bao	 (setq ssInside (GetssInside ss)	       ssAll (ssget "x" (list (cons 410 (getvar "ctab")))) )	 (if (and ssInside (> (sslength ssInside) 0) )	   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside)))	     (if (ssmemb e ssAll) (ssdel e ssAll)))	   )	 (if (ssmemb cur ssAll) (ssdel cur ssAll))	 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssAll))) ) ; xoa ss	 )       ;chi xoa doi tuong Giao voi duong bao       (if (and (setq ssOutside (GetssOutside ss))		(> (sslength ssOutside) 0))	 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssOutside))) ) ; xoa ssOutside	 )       );if     );;xoa Ngoai duong bao    );cond  (mapcar 'setvar vl ov) ; reset Sys Vars  (command "_.undo" "_end")  (princ))(defun GetssOutside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)    (if (and (setq lstss1 (gettouching ss2))	   (setq ss1 (ssadd))	   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)	   )    (progn ; co ssTouching       (break_with ss1 ss2 nil 0)      (setq cur (ssname ss2 0)	    ssTouching (ssadd)	    ssOutside (ssadd))      (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))      ;loc ssTouching -> ssOutside      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))	(if	  (or	    (not(insidep (vlax-curve-getStartPoint e) cur))	    (not(insidep (vlax-curve-getEndPoint e) cur))	    (not(insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)                              (vlax-curve-getEndParam e))2)) cur))	    );or	  (ssadd e ssOutside)	  );if	);foreach      );progn    );if  (if (ssmemb cur ssOutside) (ssdel cur ssOutside))  ssOutside  )(defun GetssInside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)  (setq ptLst (GetPtLst (setq cur (ssname ss2 0)))	ssInside (ssget "_WP" ptLst ) )    (if (and (setq lstss1 (gettouching ss2))	   (setq ss1 (ssadd))	   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)	   )    (progn ; co ssTouching      (break_with ss1 ss2 nil 0)      (setq ssTouching (ssadd))      (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))      ;loc ssTouching -> ssInside      (or ssInside (setq ssInside (ssadd)) )      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))	(if	  (and (insidep (vlax-curve-getStartPoint e) cur)	       (insidep (vlax-curve-getEndPoint e) cur)	       (insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)                           (vlax-curve-getEndParam e))2))  cur)	       )	  (ssadd e ssInside)	  );if	);foreach      );progn    );if  (if (ssmemb cur ssInside) (ssdel cur ssInside))  ssInside  ) (defun GetPtLst (obj / startparam endparam anginc delta div inc pt ptlst)  (defun ZClosed (lst)    (if (and (vlax-curve-isClosed obj)       (not(equal (car lst)(last lst) 1e-6)))      (append lst (list (car lst)))      lst))    (or (eq (type obj) 'VLA-OBJECT)    (setq obj (vlax-ename->vla-object obj)))  (setq typ (vlax-get obj 'ObjectName))  (if (or (eq typ "AcDbCircle") (eq typ "AcDbEllipse"))    (progn      (setq param 0)      (while (< param (* pi 2))	(setq pt (vlax-curve-getPointAtParam obj param)	      ptlst (cons pt ptlst)	      param (+ (/ (* pi 2) 72) param))	)      (reverse ptlst)      )    (progn ;Pline (eq typ "AcDbPolyline")      (setq param (vlax-curve-getStartParam obj)	    endparam (vlax-curve-getEndParam obj)	    anginc (* pi (/ 7.5 180.0)))      (setq tparam param)      (while (<= param endparam)	(setq pt (vlax-curve-getPointAtParam obj param))	(if (not (equal pt (car ptlst) 1e-12))	  (setq ptlst (cons pt ptlst)))	(if  (and (/= param endparam)		  (setq blg (abs (vlax-invoke obj 'GetBulge param)))		  (/= 0 blg))	  (progn	    (setq delta (* 4 (atan blg)) ;included angle		  inc (/ 1.0 (1+ (fix (/ delta anginc))))                  arcparam (+ param inc))	    (while (< arcparam (1+ param))	      (setq pt (vlax-curve-getPointAtParam obj arcparam)                    ptlst (cons pt ptlst)                    arcparam (+ inc arcparam))))	  )	(setq param (1+ param))	)      (if (and (apply 'and ptlst)	       (> (length ptlst) 1))	(ZClosed (reverse ptlst))	)      )    )  );;  Copyright © 2009, Lee McDonnell;;  (Contact Lee Mac, CADTutor.net)(defun insidep  (pt Obj / Obj Tol ang doc spc flag int lin xV yV)  (defun vlax-list->3D-point (lst flag)  (if lst    (cons ((if flag car cadr) lst)          (vlax-list->3D-point (cdddr lst) flag))))  (or (eq 'VLA-OBJECT (type Obj))      (setq Obj (vlax-ename->vla-object Obj)))  (if (not(vlax-curve-getParamAtPoint Obj pt))    (progn  (setq Tol  (/ pi 6) ; Uncertainty        ang  0.0 flag T)  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))        spc (if (zerop (vla-get-activespace doc))              (if (= (vla-get-mspace doc) :vlax-true)                (vla-get-modelspace doc)                (vla-get-paperspace doc))              (vla-get-modelspace doc)))  (while (and (< ang (* 2 pi)) flag)    (setq flag (and                 (setq int                   (vlax-invoke                     (setq lin                       (vla-addLine spc                         (vlax-3D-point pt)                           (vlax-3D-point                             (polar pt ang                               (if (vlax-property-available-p Obj 'length)                                 (vla-get-length Obj) 1.0)))))                                  'IntersectWith Obj                                    acExtendThisEntity))                 (<= 6 (length int))                 (setq xV (vl-sort (vlax-list->3D-point int T) '<)                       yV (vl-sort (vlax-list->3D-point int nil) '<))                 (or (<= (car xV) (car pt) (last xV))                     (<= (car yV) (cadr pt) (last yV))))          ang  (+ ang Tol))    (vla-delete lin))  flag  )    T    ));;; Author: Copyrightゥ 2006-2008 Charles Alan Butler ;;; Contact @  www.TheSwamp.org;;===========================================================================  ;;  get all objects touching entities in the sscross                           ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"  ;;  returns a list of enames  ;;=========================================================================== (defun gettouching (sscros / ss lst lstb lstc objl)    (and      (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))            objl (mapcar 'vlax-ename->vla-object lstb)      )      (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")				 (cons 410 (getvar "ctab"))))      )      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))      (setq lst (mapcar 'vlax-ename->vla-object lst))      (mapcar        '(lambda (x)           (mapcar             '(lambda (y)                (if (not                      (vl-catch-all-error-p                        (vl-catch-all-apply                          '(lambda ()                             (vlax-safearray->list                               (vlax-variant-value                                 (vla-intersectwith y x acextendnone)                               ))))))                  (setq lstc (cons (vlax-vla-object->ename x) lstc))                )              ) objl)         ) lst)    )    lstc  );;; Author: Copyrightゥ 2006-2008 Charles Alan Butler ;;; Contact @  www.TheSwamp.org(defun break_with (ss2brk ss2brkwith self Gap / cmd intpts lst masterlist ss ssobjs                   onlockedlayer ssget->vla-list list->3pair GetNewEntities oc                   get_interpts break_obj GetLastEnt LastEntInDatabase ss2brkwithList                  )  ;; 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  ;;  ;; return list of enames of new objects    (vl-load-com)    (princ "\nCalculating Break Points, Please Wait.\n");;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;                S U B   F U N C T I O N S                      ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  ;;  return T if entity is on a locked layer  (defun onlockedlayer (ename / entlst)    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))    (= 4 (logand 4 (cdr (assoc 70 entlst))))  )  ;;  return a list of objects from a selection set;|  (defun ssget->vla-list (ss)    (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss ))))  )|;  (defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7       (setq i -1)       (while (setq  ename (ssname ss (setq i (1+ i))))         (setq allobj (cons (vlax-ename->vla-object ename) allobj))       )       allobj  )    ;;  return a list of lists grouped by 3 from a flat list  (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 BrkGap / brkobjlst en enttype maxparam closedobj                  minparam obj obj2break p1param p2param brkpt2 dlst idx brkptS                  brkptE brkpt result GapFlg result ignore dist tmppt                  #ofpts 2gap enddist lastent obj2break stdist                 )  (or BrkGap (setq BrkGap 0.0)) ; default to 0  (setq BrkGap (/ BrkGap 2.0)) ; if Gap use 1/2 per side of break point    (setq obj2break ent        brkobjlst (list ent)        enttype   (cdr (assoc 0 (entget ent)))        GapFlg    (not (zerop BrkGap)) ; gap > 0        closedobj (vlax-curve-isclosed obj2break)  )  ;; when zero gap no need to break at end points  (if (zerop Brkgap)    (setq spt (vlax-curve-getstartpoint ent)          ept (vlax-curve-getendpoint ent)          brkptlst (vl-remove-if '(lambda(x) (or (< (distance x spt) 0.0001)                                                 (< (distance x ept) 0.0001)))                                 brkptlst)    )  )  (if brkptlst    (progn  ;;  sort break points based on the distance along the break object  ;;  get distance to break point, catch error if pt is off end  ;; ver 2.0 fix - added COND to fix break point is at the end of a  ;; line which is not a valid break but does no harm  (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam obj2break                                               ;; ver 2.0 fix                                               (cond ((vlax-curve-getparamatpoint obj2break x))                                                   ((vlax-curve-getparamatpoint obj2break                                                     (vlax-curve-getclosestpointto obj2break x))))))                            ) brkptlst))  ;; sort primary list on distance  (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2)))))    (if GapFlg ; gap > 0    ;; Brkptlst starts as the break point and then a list of pairs of points    ;;  is creates as the break points    (progn      ;;  create a list of list of break points      ;;  ((idx# stpoint distance)(idx# endpoint distance)...)      (setq idx 0)      (foreach brkpt brkptlst                ;; ----------------------------------------------------------        ;;  create start break point, then create end break point            ;;  ((idx# startpoint distance)(idx# endpoint distance)...)          ;; ----------------------------------------------------------        (setq dist (cadr brkpt)) ; distance to center of gap        ;;  subtract gap to get start point of break gap        (cond          ((and (minusp (setq stDist (- dist BrkGap))) closedobj )           (setq stdist (+ (vlax-curve-getdistatparam obj2break                             (vlax-curve-getendparam obj2break)) stDist))           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))           )          ((minusp stDist) ; off start of object so get startpoint           (setq dlst (cons (list idx (vlax-curve-getstartpoint obj2break) 0.0) dlst))           )          (t           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))          )        )        ;;  add gap to get end point of break gap        (cond          ((and (> (setq stDist (+ dist BrkGap))                   (setq endDist (vlax-curve-getdistatparam obj2break                                     (vlax-curve-getendparam obj2break)))) closedobj )           (setq stdist (- stDist endDist))           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))           )          ((> stDist endDist) ; off end of object so get endpoint           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                        (vlax-curve-getendparam obj2break))                                  endDist) dlst))           )          (t           (setq dlst (cons (list idx                                  (vlax-curve-getpointatparam obj2break                                         (vlax-curve-getparamatdist obj2break stDist))                                  stDist) dlst))          )        )        ;; -------------------------------------------------------        (setq idx (1+ IDX))      ) ; foreach brkpt brkptlst            (setq dlst (reverse dlst))      ;;  remove the points of the gap segments that overlap      (setq idx -1            2gap (* BrkGap 2)            #ofPts (length Brkptlst)      )      (while (<= (setq idx (1+ idx)) #ofPts)        (cond          ((null result) ; 1st time through           (setq result (list (car dlst)) ; get first start point                 result (cons (nth (1+(* idx 2)) dlst) result))          )          ((= idx #ofPts) ; last pass, check for wrap           (if (and closedobj (> #ofPts 1)                    (<= (+(- (vlax-curve-getdistatparam obj2break                            (vlax-curve-getendparam obj2break))                          (cadr (last BrkPtLst))) (cadar BrkPtLst)) 2Gap))             (progn               (if (zerop (rem (length result) 2))                 (setq result (cdr result)) ; remove the last end point               )               ;;  ignore previous endpoint and present start point               (setq result (cons (cadr (reverse result)) result) ; get last end point                     result (cdr (reverse result))                     result (reverse (cdr result)))             )           )          )          ;; Break Gap Overlaps          ((< (cadr (nth idx Brkptlst)) (+ (cadr (nth (1- idx) Brkptlst)) 2Gap))           (if (zerop (rem (length result) 2))             (setq result (cdr result)) ; remove the last end point           )           ;;  ignore previous endpoint and present start point           (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get present end point           )          ;; Break Gap does Not Overlap previous point           (t           (setq result (cons (nth (* idx 2) dlst) result)) ; get this start point           (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get this end point          )        ) ; end cond stmt      ) ; while            (setq dlst     (reverse result)            brkptlst nil)      (while dlst ; grab the points only        (setq brkptlst (cons (list (cadar dlst)(cadadr dlst)) brkptlst)              dlst   (cddr dlst))      )    )  )  ;;   -----------------------------------------------------  ;; (if (equal  a ent) (princ)) ; debug CAB  -------------   (foreach brkpt (reverse brkptlst)    (if GapFlg ; gap > 0      (setq brkptS (car brkpt)            brkptE (cadr brkpt))      (setq brkptS (car brkpt)            brkptE brkptS)    )    ;;  get last entity created via break in case multiple breaks    (if brkobjlst      (progn        (setq tmppt brkptS) ; use only one of the pair of breakpoints        ;;  if pt not on object x, switch objects        (if (not (numberp (vl-catch-all-apply                            'vlax-curve-getdistatpoint (list obj2break tmppt))))          (progn ; find the one that pt is on            (setq idx (length brkobjlst))            (while (and (not (minusp (setq idx (1- idx))))                        (setq obj (nth idx brkobjlst))                        (if (numberp (vl-catch-all-apply                                       'vlax-curve-getdistatpoint (list obj tmppt)))                          (null (setq obj2break obj)) ; switch objects, null causes exit                          t                        )                   )            )          )        )      )    )    (setq closedobj (vlax-curve-isclosed obj2break))    (if GapFlg ; gap > 0      (if closedobj        (progn ; need to break a closed object          (setq brkpt2 (vlax-curve-getPointAtDist obj2break                     (- (vlax-curve-getDistAtPoint obj2break brkptE) 0.00001)))          (command "._break" obj2break "_non" (trans brkpt2 0 1)                   "_non" (trans brkptE 0 1))          (and (= "CIRCLE" enttype) (setq enttype "ARC"))          (setq BrkptE brkpt2)        )      )      (if (and closedobj                (not (setq brkptE (vlax-curve-getPointAtDist obj2break                       (+ (vlax-curve-getdistatparam obj2break                            ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))                            ;; ver 2.0 fix                            (cond ((vlax-curve-getparamatpoint obj2break brkpts))                                  ((vlax-curve-getparamatpoint obj2break                                      (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))))        (setq brkptE (vlax-curve-getPointAtDist obj2break                       (- (vlax-curve-getdistatparam obj2break                            ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001)))                            ;; ver 2.0 fix                            (cond ((vlax-curve-getparamatpoint obj2break brkpts))                                  ((vlax-curve-getparamatpoint obj2break                                      (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001)))       )    ) ; endif        ;; (if (null brkptE) (princ)) ; debug        (setq LastEnt (GetLastEnt))    (command "._break" obj2break "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1))    (and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r"))    (and (= "CIRCLE" enttype) (setq enttype "ARC"))    (if (and (not closedobj) ; new object was created             (not (equal LastEnt (entlast))))        (setq brkobjlst (cons (entlast) brkobjlst))    )  )  )  ) ; endif brkptlst  ) ; defun break_obj;;====================================;;  CAB - get last entity in datatbase(defun GetLastEnt ( / ename result )  (if (setq result (entlast))    (while (setq ename (entnext result))      (setq result ename)    )  )  result);;===================================;;  CAB - return a list of new enames(defun GetNewEntities (ename / new)  (cond    ((null ename) (alert "Ename nil"))    ((eq 'ENAME (type ename))      (while (setq ename (entnext ename))        (if (entget ename) (setq new (cons ename new)))      )    )    ((alert "Ename wrong type."))  )  new)    ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  ;;         S T A R T  S U B R O U T I N E   H E R E                ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++       (setq LastEntInDatabase (GetLastEnt))    (if (and ss2brk ss2brkwith)    (progn      (setq oc 0            ss2brkwithList (ssget->vla-list ss2brkwith))      (if (> (* (sslength ss2brk)(length ss2brkwithList)) 5000)        (setq *BrkVerbose* t)      )      (and *BrkVerbose*           (princ (strcat "Objects to be Checked: "            (itoa (* (sslength ss2brk)(length ss2brkwithList))) "\n")))      ;;  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  ss2brkwithList              (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              )              (and *BrkVerbose* (princ (strcat "Objects Checked: " (itoa (setq oc (1+ oc))) "\r")))            )            (if lst              (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))            )          )        )      )          (and *BrkVerbose* (princ "\nBreaking Objects.\n"))      (setq *brkcnt* 0) ; break counter      ;;  masterlist = ((ent brkpts)(ent brkpts)...)      (if masterlist        (foreach obj2brk masterlist          (break_obj (car obj2brk) (cdr obj2brk) Gap)        )      )      )  );;==============================================================   (and (zerop *brkcnt*) (princ "\nNone to be broken."))   (setq *BrkVerbose* nil)  (GetNewEntities LastEntInDatabase) ; return list of enames of new objects)

Mình đã chạy thử và có thông báo như sau: << Error: too many arguments >>
Chắc là trong quá trình copy lên diễn đàn bị lỗi. Bác có thể gửi kèm luôn file được không?
  • 0

#27 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 02 July 2009 - 10:00 AM

Mình đã chạy thử và có thông báo như sau: << Error: too many arguments >>
Chắc là trong quá trình copy lên diễn đàn bị lỗi. Bác có thể gửi kèm luôn file được không?

Chào Nataca
Bạn dùng chức năng Dowload file của diễn đàn, sau đó xóa dòng .../t/g ... /t/n/g..." tại cuối file EWB.lsp
hay download file
Nhờ Admin xem lại chức năng Dowload file.
(setq bit (getkword "\nBan muon xoa Trong hay Ngoai duong bao, hay Giua 2 duong bao... /t/n/g...: " ) )
(setq bit (getkword "\nBan muon xoa Trong hay Ngoai duong bao, hay Giua 2 duong bao (T/N/G): " ) )
Thanks
  • 3

#28 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 02 July 2009 - 11:10 AM

bác Gia Bach à, sao e không thể xoá được các đối tượng là đường đồng mức?e đang làm bình đồ, muốn xoá các đường đông mức nằm ngoài 1 vùng kín nhưng chỉ xoá được các đối tượng khác thôi, còn với đường đồng mức thì không làm được.có phải vì các đường đồng mức có thuộc tính gì khác với các đường pline bình thường?
  • 1
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#29 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 02 July 2009 - 11:10 AM

Thank Bác gia bach nhiều. Sau khi text thử thì nó chạy rất tuyệt tương đương như lệnh đóng Fence bên Micro, nay em nhờ Bác có thể viết thêm 1 lệnh tương tự như lệnh Ewb nhưng lần này là nó không xoá mà chỉ cho mình chọn đối tượng thôi. Thank cá Bác nhiều. :s_big:
  • 0

#30 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 02 July 2009 - 12:46 PM

Thank Bác gia bach nhiều. Sau khi text thử thì nó chạy rất tuyệt tương đương như lệnh đóng Fence bên Micro, nay em nhờ Bác có thể viết thêm 1 lệnh tương tự như lệnh Ewb nhưng lần này là nó không xoá mà chỉ cho mình chọn đối tượng thôi. Thank cá Bác nhiều. :s_big:

Chào xuandao0708
Bạn chạy thử Lisp chọn đối tuợng với đuờng bao : SWB
dowload here
  • 1

#31 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 02 July 2009 - 02:00 PM

Chào namhai
Theo suy đoán của tui : các đuờng đồng mức có cao độ khác nhau -> không có giao với đuờng bao, do đó LISP không xóa các đuờng này.

E nghĩ khi chuyển sang CAD thì các đường đồng mức cũng là 1 đối tượng của CAD chứ?Nếu explode đường đồng mức thì xoá bình thường bác a, có phải trong đường đông mức trong trường hợp này được hiểu là 1 block, vì cũng không copy=>paste clip được?nhưng lại trim được, điều này lại trái ngược với giả thuyết nó là 1 block?Vậy có cách nào giải quyết được vấn đề này không , mong các cao thủ giúp đỡ? e làm thiết kế đường, vẽ đường mặt bằng tuyến trên bình đồ và muốn xoá các đường đồng mức trong mặt bằng tuyến đấy, làm thủ công rất mất thời gian.
  • 1
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#32 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 02 July 2009 - 02:59 PM

Cá mơn Bác Gia Bach nhiều, lisp lệnh swb chưa chạy đúng ý em lắm vì khi chọn đối tượng trong vùng kín để copy ra riêng thì bản vẽ chính của mình bị phá nát ngay vùng kín mình chọn. Không biết Bác có giải pháp nào để khi chọn các đối tượng trong 1 vùng kín dùng lệnh copy thì bản vẽ chính của mình không bị phá nát như khi dùng lệnh SWB. Thank Bác nhiều.
Đây là file cad mẫu:
http://www.cadviet.c...iles/mau1_2.dwg
  • 0

#33 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 02 July 2009 - 04:20 PM

Bạn có thể Upload file Cad lên diễn đàn ?

đây là file mà e đã xoá bằng thủ công, bác xem có cách nào giúp e xoá được các đường đồng mức khó chịu đây không nhé :s_big:
http://www.cadviet.c..._TONG_THE_1.dwg
  • 0
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#34 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 02 July 2009 - 04:23 PM

Cá mơn Bác Gia Bach nhiều, lisp lệnh swb chưa chạy đúng ý em lắm vì khi chọn đối tượng trong vùng kín để copy ra riêng thì bản vẽ chính của mình bị phá nát ngay vùng kín mình chọn. Không biết Bác có giải pháp nào để khi chọn các đối tượng trong 1 vùng kín dùng lệnh copy thì bản vẽ chính của mình không bị phá nát như khi dùng lệnh SWB. Thank Bác nhiều.
Đây là file cad mẫu:
http://www.cadviet.c...iles/mau1_2.dwg

Đúng là : đuợc voi đòi Hai bà Trưng .... Hình đã gửi
  • 1

#35 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 02 July 2009 - 04:56 PM

Trong file CAD của bạn, đuờng bao có cao độ Z=0, các đuờng đồng mức có cao độ Z khác 0
-> Đuờng bao và đuờng đồng mức thực tế không giao nhau (mặc dù trên mặt bằng nhìn thấy giao nhau).
Lisp chỉ chạy đuợc với các đối tuợng có giao (cắt). :s_big:

e explode đường đồng mức và thấy vẫn xoá được các đối tượng có Z khác 0 mà, nhưng chỉ xoá được những đối tượng nằm trong curve chứ không xoá được các đường giao với curve?
  • 0
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#36 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 02 July 2009 - 05:49 PM

Hix, Bác GiaBach thông cảm, không phải em được voi mà đòi bà Trương đâu. Tại em thấy lệnh Ewb nó tương đối giống 1 lệnh trong Micro nên em nhờ Bác viết hộ thêm 1 lệnh chọn đối tượng trong vùng kín, nhưng không ngờ sau khi chọn và copy ra thì nó phá nát bản vẽ. Monh Bác thông cảm, nếu có gì sai sót mong Bác bỏ qua cho em. Thank Bác nhiều.
  • 0

#37 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 03 July 2009 - 01:16 PM

Hix, Bác GiaBach thông cảm, không phải em được voi mà đòi bà Trương đâu. Tại em thấy lệnh Ewb nó tương đối giống 1 lệnh trong Micro nên em nhờ Bác viết hộ thêm 1 lệnh chọn đối tượng trong vùng kín, nhưng không ngờ sau khi chọn và copy ra thì nó phá nát bản vẽ. Monh Bác thông cảm, nếu có gì sai sót mong Bác bỏ qua cho em. Thank Bác nhiều.

Chào xuandao0708
Bạn chạy thử Lisp Copy đối tuợng chọn theo đuờng bao.
Hy vọng đúng ý bạn. :s_big: download here
  • 5

#38 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 03 July 2009 - 01:55 PM

e explode đường đồng mức và thấy vẫn xoá được các đối tượng có Z khác 0 mà, nhưng chỉ xoá được những đối tượng nằm trong curve chứ không xoá được các đường giao với curve?

Chào namhai
Với các đối tượng nằm trong và ngoài curve : Lisp làm việc bình thuờng.
Với đối tượng có giao với curve trên mặt bằng nhưng nếu trong không gian chúng không giao nhau (không đồng phẳng) thì Lisp không xử lý đuợc.
Bạn có thể dùng Lisp này để xóa tất cả đối tượng nằm ngoài curve. (không phân biệt có giao trên mặt bằng hay giao trong không gian)
(defun C:EOB (  / en ss lst ssall bbox) ;EOB -> Erasre Out Boudary(vl-load-com)  (if (and (setq en (car(entsel "\n Chon duong bao : ")))           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))    (progn      (setq bbox (ACET-ENT-GEOMEXTENTS en))      (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))      (command "_.Zoom" "0.95x")      (if (null etrim)(load "extrim.lsp"))      (etrim en (polar                  (car bbox)                  (angle (car bbox)(cadr bbox))                  (* (distance (car bbox)(cadr bbox)) 1.1)))      (if (and            (setq ss (ssget "_CP" lst))            (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))           )        (progn          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))          (foreach e1 lst (ssdel e1 ssall))          (ACET-SS-ENTDEL ssall)          )        )      )    )  )

  • 2

#39 quanghuy181

quanghuy181

    biết vẽ line

  • Members
  • PipPip
  • 28 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 03 July 2009 - 01:57 PM

Lệnh EBO
Command: eob

Chon duong bao : ; error: no function definition: ACET-ENT-GEOMEXTENTS

Command:
Command: EOB
Chon duong bao : ; error: no function definition: ACET-ENT-GEOMEXTENTS

Command:
Command: EOB
Chon duong bao : ; error: no function definition: ACET-ENT-GEOMEXTENTS

Đừng nói là em chưa cài bộ EXPRESS TOOL nha. Em cài rồi bác ạ.
  • 0

#40 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1297 Bài viết
Điểm đánh giá: 1343 (rất tốt)

Đã gửi 03 July 2009 - 02:50 PM

.....................
Chon duong bao : ; error: no function definition: ACET-ENT-GEOMEXTENTS
.............
Đừng nói là em chưa cài bộ EXPRESS TOOL nha. Em cài rồi bác ạ.

Chào quanghuy181
Có lẽ thư viện EXPRESS TOOLS chưa đuợc active.
Bạn cần thực thi lệnh EXPRESSTOOLS để active thư viện EXPRESS TOOLS truớc khi sử dụng.
  • 1