[Yêu cầu] Nhờ viết lisp tạo nhanh wipeout

Tháng 4 4, 2012

Các bác viết dùm em lisp tạo nhanh wipeout từ nhiều đối tượng polyline cùng lúc.

Đầu vào: chọn các đối tượng polyline.

Hỏi chọn:Xóa hay không xóa các polyline đã chọn.

Đầu ra: tạo các wipeout từ các polyline ban đầu.

Em xin cảm ơn các bác trước ạ. :)

Tháng 4 4, 2012

Quick code

;Doan Van Ha - CADViet.com - Ngay 04/4/2012
;Muc dich: Convert cac Lwpolyline duoc chon thanh cac Wipeout.
(defun C:HA1( / cmd entlst xoa)
(command "undo" "be")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE")))))))
(initget "X K") (setq xoa (getkword "\n[Xoa/Khong xoa] pline cu <X>: "))
(if (= xoa "K") (setq xoa "N") (setq xoa "Y"))
(foreach ent entlst
 (setq lst (acet-geom-vertex-list ent))
 (cond
  ((= 1 (cdr (assoc 70 (entget ent))))
(command "wipeout" "p" ent xoa))
  ((and (= 0 (cdr (assoc 70 (entget ent)))) (equal (car lst) (last lst) 1E-8))
(entmod (subst (cons 70 1) (assoc 70 (entget ent)) (entget ent)))
(command "wipeout" "p" ent xoa))))
(setvar "cmdecho" cmd)
(command "undo" "end")
(princ))

P/S (17h15' ngày 05/4/2012): Hiệu chỉnh để wipeout được với cả Lwpolyline kín nhưng open.

Tháng 4 4, 2012

Em cảm ơn bác Doan Van Ha nhiều nhé. Mà lúc nãy quên mất, không nhờ viết luôn cả cái thao tác ngược lại phức tạp hơn biến từ wipeout thành poly line với. Bác xem có giúp đc e luôn ko với?

Tháng 4 4, 2012

Em cảm ơn bác Doan Van Ha nhiều nhé. Mà lúc nãy quên mất, không nhờ viết luôn cả cái thao tác ngược lại phức tạp hơn biến từ wipeout thành poly line với. Bác xem có giúp đc e luôn ko với?

Được Voi đòi... Hai Bà Trưng!

Được! Nếu đến tối chưa ai viết thì tôi viết giùm bạn. OK?

Tháng 4 4, 2012

Đặt gạch hóng phát. đang cần, chờ bác Hà ra là múc luôn :ph34r:

Tháng 4 4, 2012

Em cảm ơn bác Doan Van Ha nhiều nhé. Mà lúc nãy quên mất, không nhờ viết luôn cả cái thao tác ngược lại phức tạp hơn biến từ wipeout thành poly line với. Bác xem có giúp đc e luôn ko với?

Lisp chuyển các Wipeout thành các Lwpolyline.

;Doan Van Ha - CADViet.com - Ngay 04/4/2012
;Muc dich: Convert cac Wipeout duoc chon thanh cac Lwpolyline.
(defun C:HA2( / cmd ped entlst ss ent)
(command "undo" "be")
(setq cmd (getvar "cmdecho") ped (getvar "peditaccept"))
(setvar "cmdecho" 0) (setvar "peditaccept" 0)
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "WIPEOUT")))))))
(foreach ent1 entlst
 (setq ss (ssadd) ent (entlast))
 (command "explode" ent1)
 (while (setq ent (entnext ent))
  (setq ss (ssadd ent ss)))
 (command "pedit" "m" ss "" "y" "j" 0 ""))
(setvar "cmdecho" cmd) (setvar "peditaccept" ped) (command "undo" "end")
(princ))

Tháng 4 4, 2012

Code cũ của gile, ketxu sửa thêm 1 chút :

;; WO2PL (gile)
;; Re-creates a wipeout boundary (lwpolyline)
(defun c:wo2pl (/ ss n wo elst pts norm ans)
 (if (setq ss (ssget '((0 . "WIPEOUT"))))
 (progn
(initget "Yes No")    
(setq ans (getkword "\nDelete source object? [Yes/No] <No>: "))    
(foreach wo (ST:Ss->ListEnt ss)  
 	(setq
elst (entget wo)
norm (vunit (v^v (cdr (assoc 11 elst)) (cdr (assoc 12 elst))))
pts  (wipeout2plst wo)
 	)
 	(entmake
(append
  (list '(0 . "LWPOLYLINE")
 '(100 . "AcDbEntity")
 '(100 . "AcDbPolyline")
 (cons 90 (length pts))
 (cons 38 (caddr (trans (car pts) 0 norm)))
 '(70 . 1)
 (cons 210 norm)
  )
  (mapcar '(lambda (pt)
  	(setq pt (trans pt 0 norm))
  	(list 10 (car pt) (cadr pt))
)
pts
  )
)
 	)
  (if (or (not ans) (wcmatch (strcase ans) "YES"))(entdel wo))
(princ)  
 )))
)
;;==================SUB ROUTINES==================;;
;; returns the wipeout point list (WCS)
(defun wipeout2plst (wo / elst u v mat)
 (setq elst (entget wo)
u	(cdr (assoc 11 elst))
v	(cdr (assoc 12 elst))
mat  (list u (mapcar '- v) '(0. 0. 1.))
 )
 (mapcar
'(lambda (p)
  	(mapcar '+
   	(mxv (trp mat) p)
   	(mapcar '(lambda (x y) (/ (+ x y) 2.)) u v)
   	(cdr (assoc 10 elst))
  	)
)
(cdr
 	(mapcar 'cdr
  	(vl-remove-if-not '(lambda (x) (= (car x) 14)) elst)
 	)
)
 )
)
;; Transpose a matrix Doug Wilson
(defun trp (m)
 (apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
 (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
;; V^V
;; Returns the cross product of 2 vectors
(defun v^v (v1 v2)
 (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)
;; VUNIT
;; Returns the single unit vector
(defun vunit (v)
 ((lambda (l)
(if (/= 0 l)
  	(mapcar (function (lambda (x) (/ x l))) v)
)
  )
(distance '(0 0 0) v)
 )
)
(defun ST:Ss->ListEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l))
 )  
)

Tháng 4 4, 2012

Mình nghĩ Block và Hatch cũng là 2 thứ cần dùng wipeout.

ko biết các bạn có ý tưởng gì ko?

p/s: nếu ko dùng command và (vl-commandf) thì tốt.

Thanks!

Tháng 4 4, 2012

Có hàm make wipeout rồi mà bạn. vấn đề chỉ là bạn xử lý hatch và bock của bạn như thế nào thôi

Tháng 4 5, 2012

Có hàm make wipeout rồi mà bạn. vấn đề chỉ là bạn xử lý hatch và bock của bạn như thế nào thôi

Thì đó mới là thứ để bàn,

làm sao lấy dc boundary của Block và Hatch?

còn polyline thì cứ việc chọn xong: (command "wipeout" .........)

Tháng 4 5, 2012

Thì đó mới là thứ để bàn,

làm sao lấy dc boundary của Block và Hatch?

còn polyline thì cứ việc chọn xong: (command "wipeout" .........)

Boundary của Hatch thì khả dĩ, nhưng boundary của block thì mơ hồ quá. Vì block chứa text, line, point... May ra định nghĩa boundary của Block theo kiểu lấy rectang có ll và ur thì khả dĩ nhỉ?

Tháng 4 5, 2012

Boundary của Hatch thì khả dĩ, nhưng boundary của block thì mơ hồ quá. Vì block chứa text, line, point... May ra định nghĩa boundary của Block theo kiểu lấy rectang có ll và ur thì khả dĩ nhỉ?

Đối với Block chỉ cần che những hình kín trong block thôi, line, arc rời ko cần che (ko che dc)

Bạn có cách nào lấy boundary của Hatch mà ko dùng command + commandf thì có thể cho mình chút gợi ý ko?

p/s: về block mình có thử 1 cái ở đây: http://www.cadviet.com/forum/index.php?showtopic=62902

Hatch thì đang thử nhưng chưa work dc tất cả

Tháng 4 5, 2012

Đối với Block chỉ cần che những hình kín trong block thôi, line, arc rời ko cần che (ko che dc)

Bạn có cách nào lấy boundary của Hatch mà ko dùng command + commandf thì có thể cho mình chút gợi ý ko?

p/s: về block mình có thử 1 cái ở đây: http://www.cadviet.c...showtopic=62902

Hatch thì đang thử nhưng chưa work dc tất cả

Tôi nói khả dĩ với Hatch, nghĩa là hy vọng có thể lấy boundary của nó được, chứ chưa thử.

Cái này của Jimmy Bergmark hình như lấy được. Tôi mới test sơ qua thì thấy OK, chưa nghiên cứu kỹ. Detailing nghiên cứu xem nhé. Lệnh là HB.

;----- 3). Recreates hatch boundary by selecting a hatch
;;; HATCHB.LSP ver 2.5
;;; Known problem with some elipses and splines
;;; By Jimmy Bergmark. Copyright (C) 1997-2008 JTB World, All Rights Reserved. Website: www.jtbworld.com. E-mail: info@jtbworld.com
;;; 2000-02-12 - First release
;;; 2000-03-27 - Counterclockwise arcs and ellipses fixed
;;;          	Objects created joined to lwpolyline if possible
;;;          	Error-handling, undo of command
;;;          	Can handle PLINETYPE = 0,1,2
;;; 2000-03-30 - Integrating hatchb and hatchb14
;;;          	Selection of many hatches
;;;          	Splines supported if closed.
;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14
;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created.
;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up.
;;; 2003-02-06 - Minor fix
;;; 2003-02-17 - Area returned if no islands is found since it's not consistant
;;; 2003-05-19 - Fix to take PEDITACCEPT variable used in AutoCAD 2004 into account
;;; 2004-11-05 - Minor bugs fixed
;;; 2006-03-18 - Nothing changed from 2.1 other that it's been confirmed to work with AutoCAD 2007
;;; 2006-05-13 - Create the boundary on the same layer as the hatch using the hbl command and
;;;          	on current layer/color/linetype using the hb or hatchb command
;;; 2007-02-08 - Fixed a bug with the hbl command
;;; 2008-02-29 - Support for hatches in non WCS thanks to xiaocai
;;; Tested on AutoCAD r14, 2000, 2000i, 2002, 2004, 2005, 2006, 2007, 2008, 2009
;;; should be working on older versions too.
(defun c:hb () (hatchb nil)) ; this line can be commented out if there is an existing command called hb
(defun c:hbl () (hatchb T)) ; this line can be commented out if there is an existing command called hbl
(defun c:hatchb () (hatchb nil))
(defun hatchb (hl  / 	es	blay  ed1   ed2   loops1  	bptf  part
    		et	noe   plist ic	bul   nr	ang1  ang2  obj *ModelSpace* *PaperSpace*
    		space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss lwp
    		list->variantArray 3dPoint->2dPoint A2k ent i ss2
    		knot-list controlpoint-list kn cn pos xv bot area hst noarea
       	)
(setq A2k (>= (substr (getvar "ACADVER") 1 2) "15"))
(if A2k
  (progn
(defun list->variantArray (ptsList / arraySpace sArray)
  	(setq arraySpace
 		(vlax-make-safearray
	vlax-vbdouble
	(cons 0 (- (length ptsList) 1))))
  	(setq sArray (vlax-safearray-fill arraySpace ptsList))
  	(vlax-make-variant sArray))
(defun areaOfObject (en / curve area)
  	(if en
    (if A2k
      (progn
    	(setq curve (vlax-ename->vla-object en))
    	(if
      	(vl-catch-all-error-p
     (setq
       area
		(vl-catch-all-apply 'vlax-curve-getArea (list curve))))
	nil
	area))
      (progn
    	(command "._area" "_O" en)
    	(getvar "area")))))))
(if A2k
 (defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))))
 (defun errexit (s)
(princ "\nError:  ")
(princ s)
(restore))
 (defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ))
 (setq olderr  *error*
   	restore undox
   	*error* errexit)
 (setq oldcmdecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "._UNDO" "_BE")
 (if A2k (progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
                		(vla-get-ActiveDocument (vlax-get-acad-object)))
     	*PaperSpace* (vla-get-PaperSpace
                		(vla-get-ActiveDocument (vlax-get-acad-object))))))
; Remove for testing purpose
; (setq A2k nil)
 (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
  (progn
(setq i 0)
(setq area 0)
(setq bMoreLoops nil)
(while (setq ent (ssname ss2 i))
 	(setq noarea nil)
 	(setq ed1 (entget ent))
 	(setq layer (cdr (assoc 8 ed1)))
 	; (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch not in WCS!"))  ;modified by xiaocai
 	; (setq xv (cdr (assoc 210 ed1)))                                                  	;modified by xiaocai
 	(command "._ucs" "_w")
 	(setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
 	(if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
   	(setq space *ModelSpace*)
   	(setq space *PaperSpace*))
 	(repeat loops1
   	(setq ed1 (member (assoc 92 ed1) ed1))
   	(setq bptf (cdr (car ed1))) ; boundary path type flag
   	(setq ic (cdr (assoc 73 ed1))) ; is closed
   	(setq noe (cdr (assoc 93 ed1))) ; number of edges
(setq bot (cdr (assoc 92 ed1))) ; boundary type
(setq hst (cdr (assoc 75 ed1))) ; hatch style
   	(setq ed1 (member (assoc 72 ed1) ed1))
   	(setq bul (cdr (car ed1))) ; bulge
   	(setq plist nil)
   	(setq blist nil)
   	(cond
     	((> (boole 1 bptf 2) 0) ; polyline
  		(repeat noe
    		(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    		(setq plist (append plist (list	(trans (cdr (assoc 10 ed1)) ent 0) 	))) ;;add trans by xiaocai
    		(setq blist (append blist
                        		(if (> bul 0)
                          		(list (cdr (assoc 42 ed1)))
                          		nil))))
  		(if A2k (progn
    		(setq polypoints
               	(apply 'append
                  		(mapcar '3dPoint->2dPoint plist)))
    		(setq VLADataPts (list->variantArray polypoints))
    		(setq obj (vla-addLightweightPolyline space VLADataPts))
    		(setq nr 0)
    		(repeat (length blist)
      		(if (/= (nth nr blist) 0)
        		(vla-setBulge obj nr (nth nr blist)))
      		(setq nr (1+ nr)))
    		(if (= ic 1)
      		(vla-put-closed obj T))
    	(if hl (vla-put-layer obj layer)))
       	(progn
 		(setq ne (append (list '(0 . "POLYLINE")) (list (cons 66 1))))
 		(if (= ic 1) (setq ne (append ne (list (cons 70 1)))))
 		(if hl (setq ne (append ne (list (cons 8 layer)))))
         	(entmake ne)
         	(setq nr 0)
         	(repeat (length plist)
           	(if (= bul 0)
             	(entmake (list (cons 0 "VERTEX")
                        		(cons 10 (trans (nth nr plist) ent 0) );;add trans by xiaocai
                  		))
             	(entmake (list (cons 0 "VERTEX")
                        		(cons 10 (trans (nth nr plist) ent 0) );;add trans by xiaocai
                        		(cons 42 (nth nr blist)))))
           	(setq nr (1+ nr)))
         	(entmake '((0 . "SEQEND"))))))
     	(t ; not polyline
  		(setq lastent (entlast))
  		(setq lwp T)
  		(repeat noe
    		(setq et (cdr (assoc 72 ed1)))
    		(cond
      		((= et 1) ; line
           	(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
           	(if A2k
  	(progn
               	(setq obj (vla-AddLine
                 	space
                 	(vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0)   ) ;;add trans by xiaocai
                 	(vlax-3d-point (trans (cdr (assoc 11 ed1)) ent 0)   ) ;;add trans by xiaocai
               	))
		(if hl (vla-put-layer obj layer)))
  	(progn
		(setq ne (append (list (cons 0 "LINE"))
                   	(list (list 10 (car (trans (cdr (assoc 10 ed1)) ent 0) ) (cadr (trans (cdr (assoc 10 ed1)) ent 0)) 0)) ;;add trans by xiaocai
                   	(list (list 11 (car (trans (cdr (assoc 11 ed1)) ent 0) ) (cadr (trans (cdr (assoc 11 ed1)) ent 0)) 0)) ;;add trans by xiaocai
    		;(cons 210 xv)
                 	))
		(if hl (setq ne (append ne (list (cons 8 layer)))))
               	(entmake ne)))
           	(setq ed1 (cddr ed1)))
      		((= et 2) ; circular arc
        		(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
        		(setq ang1 (cdr (assoc 50 ed1)))
        		(setq ang2 (cdr (assoc 51 ed1)))
        		(setq cw (cdr (assoc 73 ed1)))
        		(if (and (equal ang1 0 0.00001) (equal ang2 6.28319 0.00001))
          		(progn
            		(if A2k
       	(progn
                		(setq obj (vla-AddCircle
                  		space
                  		(vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0)  )
                  		(cdr (assoc 40 ed1))))
         	(if hl (vla-put-layer obj layer)))
       	(progn
	     (setq ne (append
		  		(list (cons 0 "CIRCLE"))
		  		(list (cons 8 layer))
                                 	(list (cons 10 (trans (cdr (assoc 10 ed1)) ent 0)));;;add trans by xiaocai
                                 	(list (assoc 40 ed1))))
	     (if hl (setq ne (append ne (list (cons 8 layer)))))
                		(entmake ne)))
            		(setq lwp nil))
          		(if A2k
     	(progn
              		(setq obj (vla-AddArc
                		space
                		(vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0) );;;add trans by xiaocai
                		(cdr (assoc 40 ed1))
                		(if (= cw 0)
                  		(- 0 ang2)
                  		ang1)
                		(if (= cw 0)
                  		(- 0 ang1)
                  		ang2)))
       	(if hl (vla-put-layer obj layer)))
     	(progn
       	(setq ne (append (list (cons 0 "ARC"))
                               	(list (cons 10 (trans (cdr (assoc 10 ed1)) ent 0) ));;add trans by xiaocai
                               	(list (assoc 40 ed1))
                               	(list (cons 50
                                     	(if (= cw 0)
                                       	(- 0 ang2)
                                       	ang1)))
                               	(list (cons 51
                                     	(if (= cw 0)
                                       	(- 0 ang1)
                                       	ang2)))))
       	(if hl (setq ne (append ne (list (cons 8 layer)))))
              		(entmake ne))))
        		(setq ed1 (cddddr ed1)))
      		((= et 3) ; elliptic arc
           	(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
           	(setq ang1 (cdr (assoc 50 ed1)))
           	(setq ang2 (cdr (assoc 51 ed1)))
           	(setq cw (cdr (assoc 73 ed1)))
           	(if A2k (progn
             	(setq obj (vla-AddEllipse
                         	space
                         	(vlax-3d-point (trans (cdr (assoc 10 ed1)) ent 0)   )
                         	(vlax-3d-point (trans (cdr (assoc 11 ed1)) ent 0) );;add trans by xiaocai
                         	(cdr (assoc 40 ed1))))
             	(vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
             	(vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
  	(if hl (vla-put-layer obj layer)))
     (progn
          		(princ "\nElliptic arc not supported!")
       (setq noarea T)))
           	(setq lwp nil))
      		((= et 4) ; spline
           	(setq ed1 (member (assoc 94 (cdr ed1)) ed1))
           	(setq knot-list nil)
           	(setq controlpoint-list nil)
	(setq kn (cdr (assoc 95 ed1)))
           	(setq cn (cdr (assoc 96 ed1)))
           	(setq pos (vl-position (assoc 40 ed1) ed1))
           	(repeat kn
             	(setq knot-list (cons (cons 40 (cdr (nth pos ed1))) knot-list))
             	(setq pos (1+ pos)))
           	(setq pos (vl-position (assoc 10 ed1) ed1))
           	(repeat cn
             	(setq controlpoint-list (cons (cons 10 (trans (cdr (nth pos ed1)) ent 0)   ) controlpoint-list));;add trans by xiaocai
             	(setq pos (1+ pos)))
           	(setq knot-list (reverse knot-list))
           	(setq controlpoint-list (reverse controlpoint-list))
	(setq ne (append
               	(list '(0 . "SPLINE"))
                      		(list (cons 100 "AcDbEntity"))
                      		(list (cons 100 "AcDbSpline"))
                      		(list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74 ed1))) (* 4 (cdr (assoc 73 ed1))))))
                      		(list (cons 71 (cdr (assoc 94 ed1))))
                      		(list (cons 72 kn))
                      		(list (cons 73 cn))
                      		knot-list
                      		controlpoint-list))
	(if hl (setq ne (append ne (cons 8 layer))))
           	(entmake ne)
	(setq ed1 (member (assoc 10 ed1) ed1))
           	(setq lwp nil))
    		) ; end cond
  		) ; end repeat noe
  		(if lwp (progn
    		(setq en1 (entnext lastent))
    		(setq ss (ssadd))
    		(ssadd en1 ss)
    		(while (setq en2 (entnext en1))
      		(ssadd en2 ss)
      		(setq en1 en2))
    	(if (= (getvar "peditaccept") 1)
      		(command "_.pedit" (entlast) "_J" ss "" "")
      	(command "_.pedit" (entlast) "_Y" "_J" ss "" ""))))) ; end t
   	) ; end cond
;	Tries to get the area on islands but it's not clear how to know if an island is filled or not
;	and if it should be substracted or added to the total area.
;	(if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject (entlast)))))
;	(if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area (areaOfObject (entlast)))))
;	(princ "\n") (princ bot) (princ "\n") (princ hst) (princ "\n")
;	(princ (areaOfObject (entlast)))
 	) ; end repeat loops1
 	(if (and (= noarea nil) (= loops1 1)) (setq area (+ area (areaOfObject (entlast)))) (setq bMoreLoops T))
 	(setq i (1+ i)))))
 (if (and area (not bMoreLoops)) (progn
(princ "\nTotal Area = ")
(princ area)))
 (restore)
 (princ))

Còn thằng block, để nghiên cứu xem sao, nhưng chắc khó.

Tháng 4 5, 2012

File đính kèm: http://www.cadviet.c...304_wipeout.rar

Cho e hỏi trong bản vẽ kèm theo trên: dùng lisp HA của bác Doan Van Ha thì bỏ sót 1 đường polyline (đường này dùng lệnh PL vẽ mới) không được chọn. Dùng xong lisp HA chỉ tạo được 3 đường wipeout? Nguyên nhân do đâu ah?

Dùng HA2, sau khi biến đường wipeout về polyline, rồi dùng lại HA thì lisp HA ko nhận đường polyline vừa chuyển đổi đó được? Còn dùng WO2PL thì vẫn oki.....

Có thể bổ sung cho chọn đối tượng là đường tròn không ah hay nói chung là tất cả các đối tượng miễn sao là kín ah? Cái này cũng hay dùng đến các bác ah!!! :D

Tháng 4 5, 2012

Quick code

;Doan Van Ha - CADViet.com - Ngay 04/4/2012
;Muc dich: Tao nhieu Wipeout cung luc.
(defun C:HA( / cmd entlst xoa)
(command "undo" "be")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE")))))))
(initget "X K") (setq xoa (getkword "\n[Xoa/Khong xoa] pline cu <X>: "))
(if (= xoa "K") (setq xoa "N") (setq xoa "Y"))
(foreach ent entlst
 (command "wipeout" "p" ent xoa))
(setvar "cmdecho" cmd)
(command "undo" "end")
(princ))

Mình test thử lisp này thì bị như này là sao:

Select objects:
[Xoa/Khong xoa] pline cu <X>: x

The polyline must be closed and made up of only line segments.

Unknown command "Y". Press F1 for help.

Lisp này chỉ cần click vào đường PL thì nó sẽ tự động biến thành wipeout có thể xóa pl cũ hoặc không à? còn đối với đối tượng không phải PL thì sao? đường tròn chẳng hạn?

Tháng 4 5, 2012

File đính kèm: http://www.cadviet.c...304_wipeout.rar

Cho e hỏi trong bản vẽ kèm theo trên: dùng lisp HA của bác Doan Van Ha thì bỏ sót 1 đường polyline (đường này dùng lệnh PL vẽ mới) không được chọn. Dùng xong lisp HA chỉ tạo được 3 đường wipeout? Nguyên nhân do đâu ah?

Dùng HA2, sau khi biến đường wipeout về polyline, rồi dùng lại HA thì lisp HA ko nhận đường polyline vừa chuyển đổi đó được? Còn dùng WO2PL thì vẫn oki.....

Có thể bổ sung cho chọn đối tượng là đường tròn không ah hay nói chung là tất cả các đối tượng miễn sao là kín ah? Cái này cũng hay dùng đến các bác ah!!! :D

Bản chất của lệnh wipeout nguyên thuỷ chỉ tạo được wipeout cho polyline đóng và có các cạnh là các line (không chấp nhận arc). Trong bản vẽ của bạn chứa arc.

Tháng 4 5, 2012

Mình test thử lisp này thì bị như này là sao:

Lisp này chỉ cần click vào đường PL thì nó sẽ tự động biến thành wipeout có thể xóa pl cũ hoặc không à? còn đối với đối tượng không phải PL thì sao? đường tròn chẳng hạn?

1). Muốn xoá Pline cũ hay không là tuỳ bạn. Đây là y/c của chủ topic.

2). Y/c của chủ topic là wipeout các pline, vì vậy mà không có đường tròn hay elip...

3). Bản chất nguyên thuỷ của lệnh wipeout không wipeout được với đường tròn. Muốn làm được thì xem điều 4.

4). Bạn Ketxu đã có lisp để wipeout các đường tròn, bạn search xem.

Tháng 4 5, 2012

Thì đó mới là thứ để bàn,

làm sao lấy dc boundary của Block và Hatch?

còn polyline thì cứ việc chọn xong: (command "wipeout" .........)

Hề hề hê,

Mình có ý hơi chuối để tạo wipeout cho block như sau:

1/- Duyệt qua các đối tượng con của block, nếu thằng nào là polyiline kín thì tạo wipeout theo thằng đó sử dụng lisp của bác DoanvanHa.

2/- Nếu không có thằng polyline kín nào thì tạo polyline kín từ các diểm trả về của hàm (acet-ent-geomextents blename) rồi tạo wipeout.

do hơi lu bu nên chưa có thời gian kiểm chứng ý đồ này, nếu có gì sai sót mong các bác đừng chấp trách.

Hề hề hề,...

Tháng 4 5, 2012

Cảm ơn tất cả các bác nhé! Hí hí, ko ngờ topic mình lập đông khách quá. Chúc cadviet phát triển hơn nữa!

Tháng 4 5, 2012

1). Muốn xoá Pline cũ hay không là tuỳ bạn. Đây là y/c của chủ topic.

2). Y/c của chủ topic là wipeout các pline, vì vậy mà không có đường tròn hay elip...

3). Bản chất nguyên thuỷ của lệnh wipeout không wipeout được với đường tròn. Muốn làm được thì xem điều 4.

4). Bạn Ketxu đã có lisp để wipeout các đường tròn, bạn search xem.

Mình dùng thử lisp của bạn mà không được đối với các pline nối tiếp và khép kín, nhưng dùng được với rec là sao nhỉ? nó không có tác dụng đối với pline khép kín à???

Tháng 4 5, 2012

Mình dùng thử lisp của bạn mà không được đối với các pline nối tiếp và khép kín, nhưng dùng được với rec là sao nhỉ? nó không có tác dụng đối với pline khép kín à???

Màu đỏ: không hiểu. Post bản vẽ lên nếu giải thích chưa rõ ràng.

Tháng 4 5, 2012

Màu đỏ: không hiểu. Post bản vẽ lên nếu giải thích chưa rõ ràng.

HCN thì dùng ha được, còn hình bên phải không dùng ha được?

Tháng 4 5, 2012

HCN thì dùng ha được, còn hình bên phải không dùng ha được?

Xem mặt mũi bằng file cad chứ image thì chịu!

Tháng 4 5, 2012

Xem mặt mũi bằng file cad chứ image thì chịu!

http://www.cadviet.com/upfiles/3/100658_drawing1.dwg

Tháng 4 5, 2012

http://www.cadviet.c...58_drawing1.dwg

Hề hề hề,

Cái polyline của bạn không kín. Nó cũng chả nối tiếp với thằng nào cả.... hãy kiểm tra mã dxf 70 của nó.

Đăng nhập

[Yêu cầu] Nhờ viết lisp tạo nhanh wipeout

Các bài được khuyến nghị

victor85 10

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

victor85 10

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Detailing 281

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Detailing 281

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Detailing 281

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

bach1212 4

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hockhiem 6

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.191

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

victor85 10

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hockhiem 6