Đến nội dung


Hình ảnh
- - - - -

[nhờ chỉnh sửa] lisp xóa text trong 1 miền kín


  • Please log in to reply
13 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 December 2012 - 10:59 AM

Đây là lisp tôi có chỉnh sửa lại đôi chút nhưng có vấn đề là chỉ xóa được các text trong miền kín nhìn thấy trên màn hình còn những text khác cũng nằm trong miên kín nhưng không thấy trên màn hình thì không xóa được mong mọi người giúp đỡ
đây là lisp

(defun c:xtpl ()
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength dt) i 0)
(while (< i n)
(setq dt1 (ssname dt i))
(setq SS (ssget "wp" (acet-geom-vertex-list dt1) (list (cons 0 "text"))))
(command ".erase" ss "")
(setq i (+ i 1))
)
(setq sdt (sslength ss))
)

  • 0

#2 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 04 December 2012 - 11:58 AM

Đây là lisp tôi có chỉnh sửa lại đôi chút nhưng có vấn đề là chỉ xóa được các text trong miền kín nhìn thấy trên màn hình còn những text khác cũng nằm trong miên kín nhưng không thấy trên màn hình thì không xóa được mong mọi người giúp đỡ
đây là lisp


(defun c:xtpl ()
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength dt) i 0)
(while (< i n)
(setq dt1 (ssname dt i))
(setq SS (ssget "wp" (acet-geom-vertex-list dt1) (list (cons 0 "text"))))
(command ".erase" ss "")
(setq i (+ i 1))
)
(setq sdt (sslength ss))
)


Mình tặng bạn lisp có tính năng xóa text trong vùng kín chỉ cần 1 pick Point. Hy vọng bạn hài lòng

(defun C:xt (/ p ss Tong ptLst cur L)
(setvar "hpgaptol" 50.0)
(command "_.undo" "_begin")
(setq p (getpoint "\nPick vao vung can tinh: "))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ss (entlast))
(setq ptLst (GetPtLst (setq cur (vlax-ename->vla-object ss))))
(setq ssInside (ssget "_WP" ptLst '((-4 . "<OR") (0 . "TEXT") (-4 . "OR>"))))
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside)))
(entdel itm)
)
(command "_.undo" "_end")
(princ)
)

(defun getbound(p /)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(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
(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))
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)))))
)


  • 2



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 04 December 2012 - 12:44 PM

Chủ topic : viết tiêu đề nên viết hoa chữ đầu như mọi ng đang làm
Xử lý lisp bạn : nếu thấy chỉ xử đc thằng nhìn thấy thì sao bạn k thử Zoom all hết, rồi làm, rồi zoom previous ? ( nếu là bạn viết). mình thấy đâu khó suy ra nhỉ ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 December 2012 - 01:39 PM

Mình tặng bạn lisp có tính năng xóa text trong vùng kín chỉ cần 1 pick Point. Hy vọng bạn hài lòng

 (defun C:xt (/ p ss Tong ptLst cur L) (setvar "hpgaptol" 50.0) (command "_.undo" "_begin") (setq p (getpoint "\nPick vao vung can tinh: ")) (command ".boundary" "A" "B" "E" "I" "Y" "" p "") (setq ss (entlast)) (setq ptLst (GetPtLst (setq cur (vlax-ename->vla-object ss)))) (setq ssInside (ssget "_WP" ptLst '((-4 . "<OR") (0 . "TEXT") (-4 . "OR>")))) (foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside))) (entdel itm) ) (command "_.undo" "_end") (princ) ) (defun getbound(p /) (setq ent (entlast)) (command ".boundary" "A" "B" "E" "I" "Y" "" p "") (setq ent1 (entlast)) (cond ((eq ent ent1) nil) (t ent1) ) ) (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 (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)) 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))))) ) 

Hề hề hề,
Hình như bác này không đọc kỹ yêu cầu của chủ thớt. Vấn đề mà chủ thớt gặp không khắc phục bằng lisp bác tặng được đâu. Lỗi là do hàm ssget chỉ chọn các đối tượng nhòm thấy được trên màn hình. Còn những em núp gió đâu đó thì nó bỏ qua luôn. Bởi vậy để xử lý vấn đề này chỉ cần sử dụng thêm hai dòng code là có thể ngon.
Dòng 1: (command "zoom" "e") đặt phía trước hàm ssget
Dòng 2: (command "zoom" "p") đặt phía sau hàm lặp while (hay foreach của bác) .
Bác và chủ thớt hãy kiểm tra lại xem nhé.
Hề hề hề,...
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 Zuy782006

Zuy782006

    biết vẽ line

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

Đã gửi 04 December 2012 - 01:59 PM

Hề hề hề,
Hình như bác này không đọc kỹ yêu cầu của chủ thớt. Vấn đề mà chủ thớt gặp không khắc phục bằng lisp bác tặng được đâu. Lỗi là do hàm ssget chỉ chọn các đối tượng nhòm thấy được trên màn hình. Còn những em núp gió đâu đó thì nó bỏ qua luôn. Bởi vậy để xử lý vấn đề này chỉ cần sử dụng thêm hai dòng code là có thể ngon.
Dòng 1: (command "zoom" "e") đặt phía trước hàm ssget
Dòng 2: (command "zoom" "p") đặt phía sau hàm lặp while (hay foreach của bác) .
Bác và chủ thớt hãy kiểm tra lại xem nhé.
Hề hề hề,...

Zoom e hoặc all hơi phiền chi bằng zoom Object các bác nhỉ!
  • 0
Ơ hay, tại sao ta sống chốn này?
Quay cuồng mãi, vậy có gì vui !!!

#6 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 December 2012 - 02:04 PM

Chủ topic : viết tiêu đề nên viết hoa chữ đầu như mọi ng đang làm
Xử lý lisp bạn : nếu thấy chỉ xử đc thằng nhìn thấy thì sao bạn k thử Zoom all hết, rồi làm, rồi zoom previous ? ( nếu là bạn viết). mình thấy đâu khó suy ra nhỉ ^^

Rút kinh nghiệm lần sau, cám ơn bạn.
  • 0

#7 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 December 2012 - 02:07 PM

Zoom e hoặc all hơi phiền chi bằng zoom Object các bác nhỉ!

Bạn có thể viết cho mình zoom Object được không??
cám ơn bạn
  • 0

#8 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 December 2012 - 02:11 PM


Mình tặng bạn lisp có tính năng xóa text trong vùng kín chỉ cần 1 pick Point. Hy vọng bạn hài lòng


(defun C:xt (/ p ss Tong ptLst cur L)
(setvar "hpgaptol" 50.0)
(command "_.undo" "_begin")
(setq p (getpoint "\nPick vao vung can tinh: "))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ss (entlast))
(setq ptLst (GetPtLst (setq cur (vlax-ename->vla-object ss))))
(setq ssInside (ssget "_WP" ptLst '((-4 . "<OR") (0 . "TEXT") (-4 . "OR>"))))
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside)))
(entdel itm)
)
(command "_.undo" "_end")
(princ)
)

(defun getbound(p /)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(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
(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))
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)))))
)

Không xử lý được những Text ko nhìn thấy
  • 0

#9 Zuy782006

Zuy782006

    biết vẽ line

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

Đã gửi 04 December 2012 - 03:07 PM

Bạn có thể viết cho mình zoom Object được không??
cám ơn bạn

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from [url="http://www.cadviet.com/forum/index.php?showtopic=68051&pid=221519&st=0&#entry221519"]http://www.cadviet.com/forum/index.php?showtopic=68051&pid=221519&st=0&#entry221519[/url]
(defun c:xtpl ()
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength dt) i 0)
(while (< i n)
(setq dt1 (ssname dt i))
(command ".zoom" "o" dt1 "")
(setq SS (ssget "wp" (acet-geom-vertex-list dt1) (list (cons 0 "text"))))
(command ".erase" ss "")
(command ".zoom" "p")
(setq i (+ i 1))
)
(setq sdt (sslength ss))
)

  • 2
Ơ hay, tại sao ta sống chốn này?
Quay cuồng mãi, vậy có gì vui !!!

#10 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 04 December 2012 - 03:08 PM

Mình đọc tiêu đề nên post vội rồi đi ăn cơm. :). Hii. Cái này để các cao thủ giúp bạn. :D
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#11 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 December 2012 - 09:24 PM

Bạn có thể viết cho mình zoom Object được không??
cám ơn bạn

Hề hề hề,
Zoom object chỉ có từ CAD đời cao hơn 2004. Với CAD2004 trở xuống chỉ có zoom extents và zoom all mới giải quyết được.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 05 December 2012 - 08:50 AM



;; free lisp from cadviet.com
;;; this lisp was downloaded from [url="http://www.cadviet.com/forum/index.php?showtopic=68051&pid=221519&st=0&#entry221519"]http://www.cadviet.com/forum/index.php?showtopic=68051&pid=221519&st=0&#entry221519[/url]
(defun c:xtpl ()
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq n (sslength dt) i 0)
(while (< i n)
(setq dt1 (ssname dt i))
(command ".zoom" "o" dt1 "")
(setq SS (ssget "wp" (acet-geom-vertex-list dt1) (list (cons 0 "text"))))
(command ".erase" ss "")
(command ".zoom" "p")
(setq i (+ i 1))
)
(setq sdt (sslength ss))
)

Cám ơn bạn nhiều lắm
  • 0

#13 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 05 December 2012 - 08:51 AM

Mình đọc tiêu đề nên post vội rồi đi ăn cơm. :). Hii. Cái này để các cao thủ giúp bạn. :D

Làm được rồi cám ơn bạn
  • 0

#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 05 December 2012 - 08:52 AM

Hề hề hề,
Zoom object chỉ có từ CAD đời cao hơn 2004. Với CAD2004 trở xuống chỉ có zoom extents và zoom all mới giải quyết được.

Không sao cả bây giờ mình đang dùng CAD2008 mà
  • 0