Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
namhai

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

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

namhai    18
Bạn chay thử Lisp này : file

Bác Gia Bach à, cảm ơn bác nhiều vì sự nhiệt tình giúp đỡ của bác!sau này có gì bác lại chỉ giáo cho e với nha!chúc bác sức khoẻ, thành công!!! :s_big:

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
thiep    263
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 để. :bigsmile:

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

Gia_Bach, cảm ơn bạn đã hoàn chỉnh erc.lsp thành ewb.lsp thật tuyệt vời. Những ngày vắng mặt, ở nơi không có internet, Thiep cũng đã nghĩ đến hàm break-with và cũng hoàn chỉnh erc.lsp. Bây giờ thì không cần đưa lên diễn đàn nữa. Tuy nhiên EWB vẫn còn thiếu sót khi curve là spline. Còn khi curve là circle, ellipse, bạn tạo listpoint có 72 điểm, mình nghĩ là ít, mình cho đến 2009 điểm (chắc hơi nhiều).

  • Vote tăng 1

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
Lisp123    0
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)
         )
       )
     )
   )
 )

Ơ em tưởng cái líp này dùng lệnh extrim thì nó phải extrim được cả Hatch chứ nhỉ? Sao em dùng với hatch mà không được???

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
thanhtranle    7
e muốn xoá tất cả các đối tượng trong 1 vùng kín nhưng phải làm thủ công bằng lệnh trim và erase, như vậy rất mất công và tốn thời gian, bác nào có cách nào giúp e giải quyết vấn đề này 1 cách nhanh chóng không?

nghe tiêu đề là thấy hãi!

ghê quá! ghé vào xem thử coi thế nào!

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
m.rduong    0

Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

 

;; free lisp from cadviet.com
;;;-------------------------------------------------------------
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
(setq
  l1 (+ l1 d)
  p1 (vlax-curve-getPointAtDist cur l1)

)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)
)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

 

Đây là lỗi nó báo thế này :Command: erc

Free lisp from www.cadviet.com

chon duong:

Current length: 4441.7958error: bad argument type

(VLAX-CURVE-GETSTARTPOINT CUR)

mong các bạn sửa giup mình ..Rất cám ơn..

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.123
Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

 

;; free lisp from cadviet.com
;;;-------------------------------------------------------------
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
(setq
  l1 (+ l1 d)
  p1 (vlax-curve-getPointAtDist cur l1)

)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)
)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

 

Đây là lỗi nó báo thế này :Command: erc

Free lisp from www.cadviet.com

chon duong:

Current length: 4441.7958error: bad argument type

(VLAX-CURVE-GETSTARTPOINT CUR)

mong các bạn sửa giup mình ..Rất cám ơn..

Hãy thử đưa hàm (vl-load-com) lên đầu coi sao???

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
ro88    2

cái lisp EOB dùng thì tốt rồi nhưng nếu cut được hatch và block nữa thì quá tuyệt

không biết ban GiaBach co thể bổ sung thêm được không

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
thiep    263

Hatch thì cắt được chứ Block thì.... ^^

Chào ketxu và ro88, Hatch cắt được thì block cắt được luôn, không có vấn đề gì, và có thể không cần lisp cũng được. Dùng lệnh XCLIP là đủ

  • Vote tăng 1

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

Anh Thiep

em cần nó vừa xóa vừa extrim luôn đưọc không anh.

 

;; free lisp from cadviet.com
;; ERC.LSP free lisp from cadviet.com;; copyright by Thiep,06/2009;;;----------------------------(defun ss2ent (ss / i Le e)(setq i 0Le nil)(repeat (sslength ss)(setqe (ssname ss i)Le (append Le (list e))i (1+ i)))Le);;;-----------------------------------(defun fen (cur / sc glength d l1 p0)  (setq sc 2009 glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter")) d (/ (glength cur) sc) l1 0.0 p0 (vlax-curve-getStartPoint cur) L (list p0)  )  (redraw cur 4)  (repeat sc    (setq      l1 (+ l1 d)      p1 (vlax-curve-getPointAtDist cur l1)    )    (setq L (append L (List p1)))  )  L);;;---------------------------------------------------(defun c:er2c (/ cur L n ssgDEL glength)  (princ "\nFree lisp from www.cadviet.com") ;-------------------  (acet-error-init    (list      (list "cmdecho" 0    "highlight" 0    "regenmode"    1 "osmode"    0 "ucsicon"   0    "offsetdist"    0 "attreq"    0    "plinewid" 0    "plinetype" 1    "gridmode"    0 "celtype"   "CONTINUOUS"    "ucsfollow"    0 "limcheck"  0   )      T ;flag. True means use undo for error clean up.      '(if redraw_it (redraw na 4)       )    ) ;list  ) ;acet-error-init ;--------------------  (command "undo" "be")  (setvar "osmode" 0)  (setq n 0)  (initget "T N G")  (setq bit (getkword   "\nBan muon xoa Trong hay Ngoai 1 Curve, hay giua 2 Curve < T/N/G>: " )  )  (cond ((= bit "T") (setq cur    (car (entsel "\nChon curve: "))       L      (fen cur)       ssgDEL (ssget "WP" L) ) ) ((= bit "N") (setq cur (car (entsel "\nChon curve: "))       L (fen cur)       ssgDEL (ssget "X")       ssginC (ssget "CP" L)       enssginC (ss2ent ssginC) ) (foreach eni enssginC   (ssdel eni ssgDEL) ) ) ((= bit "G") (setq cur1 (car (entsel "\nChon curve ngoai: "))       L1 (fen cur1)       ssgDEL (ssget "WP" L1)       cur2 (car (entsel "\nChon curve trong: "))       L2 (fen cur2)       ssginC2 (ssget "CP" L2)       enssginC2 (ss2ent ssginC2) ) (foreach eni enssginC2   (ssdel eni ssgDEL) ) )  )  (repeat (sslength ssgDEL)    (if (and (/= (ssname ssgDEL n) cur2) (/= (ssname ssgDEL n) cur1))      (progn (entdel (ssname ssgDEL n))
;; free lisp from cadviet.com
;; ERC.LSP free lisp from cadviet.com;; copyright by Thiep,06/2009;;;----------------------------(defun ss2ent (ss / i Le e)(setq i 0Le nil)(repeat (sslength ss)(setqe (ssname ss i)Le (append Le (list e))i (1+ i)))Le);;;-----------------------------------(defun fen (cur / sc glength d l1 p0)  (setq sc 2009 glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter")) d (/ (glength cur) sc) l1 0.0 p0 (vlax-curve-getStartPoint cur) L (list p0)  )  (redraw cur 4)  (repeat sc    (setq      l1 (+ l1 d)      p1 (vlax-curve-getPointAtDist cur l1)    )    (setq L (append L (List p1)))  )  L);;;---------------------------------------------------(defun c:er2c (/ cur L n ssgDEL glength)  (princ "\nFree lisp from www.cadviet.com") ;-------------------  (acet-error-init    (list      (list "cmdecho" 0    "highlight" 0    "regenmode"    1 "osmode"    0 "ucsicon"   0    "offsetdist"    0 "attreq"    0    "plinewid" 0    "plinetype" 1    "gridmode"    0 "celtype"   "CONTINUOUS"    "ucsfollow"    0 "limcheck"  0   )      T ;flag. True means use undo for error clean up.      '(if redraw_it (redraw na 4)       )    ) ;list  ) ;acet-error-init ;--------------------  (command "undo" "be")  (setvar "osmode" 0)  (setq n 0)  (initget "T N G")  (setq bit (getkword   "\nBan muon xoa Trong hay Ngoai 1 Curve, hay giua 2 Curve < T/N/G>: " )  )  (cond ((= bit "T") (setq cur    (car (entsel "\nChon curve: "))       L      (fen cur)       ssgDEL (ssget "WP" L) ) ) ((= bit "N") (setq cur (car (entsel "\nChon curve: "))       L (fen cur)       ssgDEL (ssget "X")       ssginC (ssget "CP" L)       enssginC (ss2ent ssginC) ) (foreach eni enssginC   (ssdel eni ssgDEL) ) ) ((= bit "G") (setq cur1 (car (entsel "\nChon curve ngoai: "))       L1 (fen cur1)       ssgDEL (ssget "WP" L1)       cur2 (car (entsel "\nChon curve trong: "))       L2 (fen cur2)       ssginC2 (ssget "CP" L2)       enssginC2 (ss2ent ssginC2) ) (foreach eni enssginC2   (ssdel eni ssgDEL) ) )  )  (repeat (sslength ssgDEL)    (if (and (/= (ssname ssgDEL n) cur2) (/= (ssname ssgDEL n) cur1))      (progn (entdel (ssname ssgDEL n))

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
ducdong2009    0

Mình có vấn đề này muốn hỏi các bạn:


 

- Mình có file này


- Muốn xuất tọa độ các điểm này vào cad và có các đường đồng mức


- Có ai có cách nào hay có phần mềm nào hướng dẫn mình với


Cảm ơn nhiều.http://www.cadviet.com/upfiles/3/109075_bang_thong_ke_toa_do_1.rar


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
maivanlong    0

Em chào các anh, em đã dùng thử lisp của mọi người viết, rất hay và hữu ích. 

Nhưng nội dung công việc em cần là xoá các đối tượng nằm trong, và giao với đường bao. Không cần dùng lệnh extrim.

Nếu có thể thì các anh có thể chỉnh sửa lisp đầu tiên của anh Thiệp giúp em với ạ.

"lisp chỉ xoá các đối tượng nằm trong vùng kín" về lisp có thể xoá được các "đối tượng trong vùng kín, và giao với đường bao" (cad 2d thôi ạ, không cần 3d)

Ngoài ra nếu có thể chọn được tất cả các đường bao một lúc để xoá thì tuyệt vời ạ :D.

 

Em cám ơn và chúc sức khoẻ các anh.

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
maivanlong    0

hi vâng.ở #25 em tải về bằng nút download của diễn đàn, load vào cad thành công. Nhưng không hiểu sao khi gõ lệnh ewb thì cad không nhận lệnh và báo là " unknown command "Ewb" ...". Em copy code rồi past vào file lisp mới cũng cho kết quả tương tự. Download ở một số link khác của anh Gia_Bach như ở #27; #30 thì hình như link dropbox bị hết hạn, không tải được file.

Mà em có đọc qua đoạn giới thiệu của anh Gia_Bach thì thấy lisp này sẽ xóa đối tượng trong vùng kín và cắt đi phần nằm bên trong vùng kín của các đối tượng giao với  đường biên của vùng kín đó. Còn cái em muốn hơi khác một chút. Đó là với đối tượng trong vùng kín thì vẫn xóa. còn với các đối tượng giao với đường bao thì không cắt mà cũng xóa như đối tượng nằm trong vùng kín.

Mong được giúp đỡ  :P

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
kinhcan9988    0

Mọi người ơi cho mình hỏi cái, mình load được các lisp erc, erc2, eob nhưng đến khi bấm lệnh thì lại không nhận. Mình đã đọc và thử hết các cách sửa nhưng vẫn không được. 

 

Đây là lisp bạn cần:

;;;-------------------------------------------------------------(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)  (princ "\nFree lisp from www.cadviet.com")  (command "undo" "be")  (setvar "osmode" 0)  (setq	sc	2009	cur	(car (entsel "\nchon duong: "))	glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))	d	(/ (glength cur) sc)	l1	0.0	p0	(vlax-curve-getStartPoint cur)	L	(list p0)  )  (redraw cur 4)  (repeat sc    (setq      l1 (+ l1 d)      p1 (vlax-curve-getPointAtDist cur l1)    )    (setq L (append L (List p1)))  )  (setq ssgDEL (ssget "WP" L))  (setq n 0)  (repeat (sslength ssgDEL)    (entdel (ssname ssgDEL n))    (setq n (1+ n))  )  (command "undo" "end")  (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")  (princ))(vl-load-com)
Không phải xóa thủ công nữa nhé.

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
BKTen    6

BẠN DÙNG THỬ CÁI NÀY XEM SAO?

hi vâng.ở #25 em tải về bằng nút download của diễn đàn, load vào cad thành công. Nhưng không hiểu sao khi gõ lệnh ewb thì cad không nhận lệnh và báo là " unknown command "Ewb" ...". Em copy code rồi past vào file lisp mới cũng cho kết quả tương tự. Download ở một số link khác của anh Gia_Bach như ở #27; #30 thì hình như link dropbox bị hết hạn, không tải được file.

Mà em có đọc qua đoạn giới thiệu của anh Gia_Bach thì thấy lisp này sẽ xóa đối tượng trong vùng kín và cắt đi phần nằm bên trong vùng kín của các đối tượng giao với  đường biên của vùng kín đó. Còn cái em muốn hơi khác một chút. Đó là với đối tượng trong vùng kín thì vẫn xóa. còn với các đối tượng giao với đường bao thì không cắt mà cũng xóa như đối tượng nằm trong vùng kín.

Mong được giúp đỡ  :P

http://www.cadviet.com/upfiles/3/130150_xoa_doi_tuong_trong_vung_kin.lsp

XIN LỖI MÌNH KHÔNG BIẾT UP LÊN DIỄN ĐÀN THEO KIỂU HIỂN THỊ CODE, CHO DOWLOAD LUÔN NHÉ! CÓ AI CHỈ GIÙM MÌNH LUÔN ĐI,

 

;; XOA DOI TUONG TRONG VUNG KIN
;;; --------------------------   CLEARN OBJECT xoa doi tuong vung kin -------------------------------
 (defun c:cob ( / ob1 ver ob2 ob0 ob8 obx dem)
  (setq olderr *error* *error* at_err)
  (modes '("CMDECHO" "HIGHLIGHT" "osmode"))
  (mapcar 'setvar '("CMDECHO" "HIGHLIGHT") '(0 0))
  (command "_.undo" "_group")
  (setq ob1 (car (entsel "\nChon vung can xoa di tuong: ")))
  (if ob1 (progn
  (fi_ver ob1)
   (setq ob2 (entget (car (entsel "\nChon doi tuong xoa: "))))
    (if ob2 (progn
     (setq ob0 (assoc 0 ob2))
     (setq ob8 (assoc 8 ob2))
     (maxmin ver)
     (command "_.zoom" "_W" (list xmax ymax 0) (list xmin ymin 0))
       (setq obx (ssget "cp" ver (list ob0 ob8)))

       (if obx (progn
          (setq dem (sslength obx))
          (command "_.ERASE" "_p" "")
          (princ "- Da xoa ")
          (princ dem)
          (princ " doi tuong !!!")
        ))

     )) ; end ob1
   )) ; end ob1
  (command "_.undo" "_END")
  (moder)
  (setq *error* olderr)
  (princ)
  )
;;;
;;; -------------------------- END CLEARN OBJECT ------------------------------

Chỉnh sửa theo BKTen

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.123

BẠN DÙNG THỬ CÁI NÀY XEM SAO?

hi vâng.ở #25 em tải về bằng nút download của diễn đàn, load vào cad thành công. Nhưng không hiểu sao khi gõ lệnh ewb thì cad không nhận lệnh và báo là " unknown command "Ewb" ...". Em copy code rồi past vào file lisp mới cũng cho kết quả tương tự. Download ở một số link khác của anh Gia_Bach như ở #27; #30 thì hình như link dropbox bị hết hạn, không tải được file.

Mà em có đọc qua đoạn giới thiệu của anh Gia_Bach thì thấy lisp này sẽ xóa đối tượng trong vùng kín và cắt đi phần nằm bên trong vùng kín của các đối tượng giao với  đường biên của vùng kín đó. Còn cái em muốn hơi khác một chút. Đó là với đối tượng trong vùng kín thì vẫn xóa. còn với các đối tượng giao với đường bao thì không cắt mà cũng xóa như đối tượng nằm trong vùng kín.

Mong được giúp đỡ  :P

http://www.cadviet.com/upfiles/3/130150_xoa_doi_tuong_trong_vung_kin.lsp

XIN LỖI MÌNH KHÔNG BIẾT UP LÊN DIỄN ĐÀN THEO KIỂU HIỂN THỊ CODE, CHO DOWLOAD LUÔN NHÉ! CÓ AI CHỈ GIÙM MÌNH LUÔN ĐI,

 

;; XOA DOI TUONG TRONG VUNG KIN

;;; --------------------------   CLEARN OBJECT xoa doi tuong vung kin -------------------------------

 (defun c:cob ( / ob1 ver ob2 ob0 ob8 obx dem)

  (setq olderr *error* *error* at_err)

  (modes '("CMDECHO" "HIGHLIGHT" "osmode"))

  (mapcar 'setvar '("CMDECHO" "HIGHLIGHT") '(0 0))

  (command "_.undo" "_group")

  (setq ob1 (car (entsel "\nChon vung can xoa di tuong: ")))

  (if ob1 (progn

  (fi_ver ob1)

   (setq ob2 (entget (car (entsel "\nChon doi tuong xoa: "))))

    (if ob2 (progn

     (setq ob0 (assoc 0 ob2))

     (setq ob8 (assoc 8 ob2))

     (maxmin ver)

     (command "_.zoom" "_W" (list xmax ymax 0) (list xmin ymin 0))

       (setq obx (ssget "cp" ver (list ob0 ob8)))

 

       (if obx (progn

          (setq dem (sslength obx))

          (command "_.ERASE" "_p" "")

          (princ "- Da xoa ")

          (princ dem)

          (princ " doi tuong !!!")

        ))

 

     )) ; end ob1

   )) ; end ob1

  (command "_.undo" "_END")

  (moder)

  (setq *error* olderr)

  (princ)

  )

;;;

;;; -------------------------- END CLEARN OBJECT ------------------------------

Hề hề hề,

Không biết lisp này bãn viết hay bạn sưu tầm, nhưng nêu chỉ có vậy e rằng bạn đã post mất công bởi chẳng thể dùng được.

Lisp còn thiếu một số hàm con mà người viết đã sử dụng như các hàm (moder) (fi_ver) (modes) (maxmin ...)

Nếu là bạn viết thì hãy post thêm các hàm con này lên. (còn nếu là bạn sưu tầm thì hãy tìm hiểu thêm về các hàm con này. Nếu không rất có khả năng bạn sẽ lãnh hậu quả khi xài lisp này.

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
BKTen    6

Cảm ơn Bác Bình rất nhiều, Nhờ Bác chỉ giáo thêm, em chỉ sưu tầm thôi chứ không biết viết , hii Mong Bác chỉ dạy.

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
Tot77    501

Bạn dùng lisp của bác Thiệp dưới đây, sau khi bắt đối tượng xong bạn muốn move, copy hay xóa thì tùy bạn.

 

 
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
  (princ "\nFree lisp from www.cadviet.com")
  (command "undo" "be")
  (setvar "osmode" 0)
  (setq sc 2009
cur (car (entsel "\nchon duong: "))
glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d (/ (glength cur) sc)
l1 0.0
p0 (vlax-curve-getStartPoint cur)
L (list p0)
  )
  (redraw cur 4)
  (repeat sc
    (setq l1 (+ l1 d)
 p1 (vlax-curve-getPointAtDist cur l1)
    )
    (setq L (append L (List p1)))
  )
  (setq ssgDEL (ssget "WP" L))  
  (command "undo" "end")
  (princ  "\nChuc cac ban may man va thanh cong - Thiep 0918841230" )
  (sssetfirst nil ssgDel)
  (princ)
)
(vl-load-com)

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×