Đến nội dung


Hình ảnh
- - - - -

Viết giúp Lisp xoá text trong khoảng nhất định


  • Please log in to reply
48 replies to this topic

#21 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 19 August 2010 - 05:46 PM

Tui không phải trong nghề nên cũng không hiểu hết được yêu cầu của các bạn.
Như đã viết ở trên, tui nghĩ vấn đề của các bạn là : Xóa(chuyển Layer) các TEXT nằm chồng lấp lên nhau sau đó xuất ra file các số liệu của TEXT.
Các bạn dùng thử LISP này xem có đáp ứng đuợc không.
- bổ sung : File xuât ra phải có 4 cột: N0(Text) X (Tọa độ X) Y (Tọa dộ Y) H (Tọa dộ Z)
(do không biết qui luật của Số thứ tự)

to NDBNGO : việc lọc LAYER không khó, cái chính là chúng ta thống nhất đuợc mục tiêu của vấn đề, đang chờ ý kiến của bạn. Đã chạy thử LISP trên file Cad bạn gửi.

(defun c:FText (/ ent ent1 fil fil1 i j lst newlayer pos ss ss0 ss1 ss_tmp str str1 tmp tmp1)
;|By Gia Bach 2010|;
(defun MakeBound (ent / ang elist ll lr tb tb1 tb2 ul ur)
(setq elist (entget ent)
ang (cdr (assoc 50 elist))
tb (textbox elist)
tb1 (car tb)
tb2 (cadr tb)
ll (polar (cdr (assoc 10 elist))
(+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))
lr (polar ll ang (- (car tb2) (car tb1)))
ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) )
(list ll lr ur ul))

(command "_.undo" "be")
(setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) ss0 (ssadd))
(while (> (sslength ss) 0)
(setq ent (ssname ss 0)
lst (MakeBound ent) )
(ssdel ent ss)
(if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))
(progn
(setq i -1)
(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
(if (not (equal ent ent1))
(progn
(setq str1 (append (list (list (cdr (assoc 1 (entget ent1)))
(cdr (assoc 10 (entget ent1))))) str1))
(ssadd ent1 ss1)
(if (ssmemb ent1 ss) (ssdel ent1 ss))
(if (ssmemb ent1 ss0) (ssdel ent1 ss0))))) ) )
(if (not (ssmemb ent ss1)) (ssadd ent ss0)) )
(setq j -1)
(while (setq ent (ssname ss0 (setq j (1+ j))))
(setq str (append (list (list (cdr (assoc 1 (entget ent)))
(cdr (assoc 10 (entget ent))))) str)) )
(if (> (sslength ss1) 0)
(progn
(setq newlayer "CV");(getstring t "\nNhap ten layer chua Text can filter :"))
(if (not (tblsearch "layer" newlayer))
(command "-layer" "n" newlayer "c" 2 newlayer "") )
(command "change" ss1 "" "p" "la" newlayer "")
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(progn
(setq fil (open tmp "w") )
(foreach txt str
(setq pos (cadr txt))
(write-line (strcat (car txt) (chr 44) (rtos(car pos)) (chr 44) (rtos(cadr pos))(chr 44)
(rtos(caddr pos)))fil) )
(close fil)
(setq tmp1 (strcat (vl-filename-directory tmp) "\\"
(vl-filename-base tmp) "_filter"
(vl-filename-extension tmp))
fil1 (open tmp1 "w"))
(foreach txt str1
(setq pos (cadr txt))
(write-line (strcat (car txt) (chr 44) (rtos(car pos)) (chr 44) (rtos(cadr pos))(chr 44)
(rtos(caddr pos))) fil1) )
(close fil1) )) ) )
(command "_.undo" "e")
(princ))

Tuyệt vời.
  • 1



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







#22 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 20 August 2010 - 09:38 AM

Bạn giabach phải cho người dùng nhập giá trị khoảng cách cần loại bỏ .Lisp của bạn chỉ tự xóa ở gần trong bản này ,với tỷ lệ khác thì không được.
bạn sửa giúp nhé.Sau đó mình bàn tiếp về số thứ tự được.
Xóa như bạn vevezula là được ,nhưng mỗi tội phải chạy 3-4 lần mới ưng ý.
Cảm ơn bạn.

với tỷ lệ khác thì không được. : Lisp ở trên không phụ thuộc vào tỉ lệ bản vẽ.

Update lisp : cho phép người dùng nhập giá trị khoảng cách cần loại bỏ.
- nói thêm về giá trị này : đó là khoảng cách từ đuờng bao của Text (tưong tự lệnh OFFSET)
Lisp sẽ lọc các Text có giao với đuờng bao Offset này (đuờng màu cyal)
Hình đã gửi

File Cad kết quả : Filter_text.dwg
(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp)
;|By Gia Bach 2010|;
(defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur)
(setq elist (entget ent)
ang (cdr (assoc 50 elist))
tb (textbox elist)
tb1 (car tb)
tb2 (cadr tb)
ll (polar (cdr (assoc 10 elist))
(+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))
lr (polar ll ang (- (car tb2) (car tb1)))
ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) )
(setq ang (angle ll lr) )
(setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))) )
(list ll lr ur ul))

(command "_.undo" "be")
(setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) )
(or *ofset (setq *ofset 0.5))
(initget 4)
(setq ofset (getreal (strcat "\nNhap khoang cach duong vien : <" (rtos *ofset) ">")))
(if (= ofset nil) (setq ofset *ofset) (setq *ofset ofset))

(while (> (sslength ss) 0)
(setq ent (ssname ss 0)
lst (GetBound ent ofset) )
(ssdel ent ss)
(if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))
(progn
(setq i -1)
(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
(if (not (equal ent ent1))
(progn
(ssadd ent1 ss1)
(if (ssmemb ent1 ss) (ssdel ent1 ss)) ))) ) ) )
(if (> (sslength ss1) 0)
(progn
(setq newlayer "Text_Filter")
(if (not (tblsearch "layer" newlayer))
(command "-layer" "n" newlayer "c" 2 newlayer "") )
(command "change" ss1 "" "p" "la" newlayer "") ) )
(command "_.undo" "e")
(princ))

  • 3

#23 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 20 August 2010 - 10:00 AM

Bạn giabach phải cho người dùng nhập giá trị khoảng cách cần loại bỏ .Lisp của bạn chỉ tự xóa ở gần trong bản này ,với tỷ lệ khác thì không được.
bạn sửa giúp nhé.Sau đó mình bàn tiếp về số thứ tự được.
Xóa như bạn vevezula là được ,nhưng mỗi tội phải chạy 3-4 lần mới ưng ý.
Cảm ơn bạn.

Xin chào bạn NDBNGO. Bác Gia_Bach ra tạo ra sản phẩm tuyệt vời như thế mà bạn lại chưa biết cách sử dụng. Hôm qua muộn quá rồi nên mình không thể post lên cách dùng hiệu quả lisp Ftext của bác Gia_bach. Bác ấy thật tuyệt vời cả về kỹ năng cũng như trình độ toán học. Mình mới học lập trình lisp, cũng chưa cho ra sản phẩm gì gọi là tâm đắc mà chỉ có ý chỉnh sửa theo ý của mình. (Hiểu được phương pháp và cách làm mới là 1 vấn đề để sau này nó ngấm mới thích). Theo cách của bạn là cần phải nhập giá trị khoảng cách vào phải không? Đơn giản, bạn xem chiều cao text hiện tại là bao nhiêu? bạn muốn khoảng cách là bao nhiêu? Xong rồi đấy, bạn chỉ cần cho chiều cao text tăng lên theo khoảng cách bạn muốn nhập vào là được, sau đó dùng lệnh ftext, bây giờ, bạn hãy cho chiều cao chữ trở về height ban đầu là được. Bạn thử làm theo tôi xem có ổn không. Nếu bạn không làm được thì tôi upload 1 bản vẽ ví dụ lên nhé:
http://www.4shared.c...Lvjnq/test.html
Mình post bài này hơi muộn một chút vì mình ko chắc là bác Gia_bach sử dụng phương pháp ấy. Nó liên quan đến đường bao textbox của text.
  • 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







#24 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 20 August 2010 - 10:20 AM

Gửi tới bác Gia_bach
Chào bác gia_bach.
Em định lập ra một topic mới để bàn luận trong diễn đàn nhưng vấn đề em đưa ra hơi riêng tư một chút nên nhờ bác gia_bach cao thủ giúp đỡ.
Đây cũng là một bài toán cũng rất bổ ích cho việc lọc text. Em có file này bác xem giúp em:
http://www.4shared.c.../xuat_text.html
Xin nhờ bác lấy dùm em toạ độ (X, Y) của 2 text (thực chất là cùng một do justify căn chỉnh).
Về độ cao Z thì bottom right ta lấy phần nguyên và top left ta lấy ra phần thập phân sau dấu phẩy
Nếu bottom right (ctr+ u) thì là số dương và bottom right là số âm.
Sau khi quét chọn thì sẽ lưu ra tệp txt với định dạng STT X Y Z
Cảm ơn bác Gia_Bach rất nhiều. (Đó là số liệu chuyên ngành hàng hải bác ạ, họ chơi khó mình nên em không có cách nào khác bác ạ! hic)
Chờ tin bác
  • 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







#25 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 20 August 2010 - 11:24 AM

Gửi tới bác Gia_bach
Chào bác gia_bach.
Em định lập ra một topic mới để bàn luận trong diễn đàn nhưng vấn đề em đưa ra hơi riêng tư một chút nên nhờ bác gia_bach cao thủ giúp đỡ.
Đây cũng là một bài toán cũng rất bổ ích cho việc lọc text. Em có file này bác xem giúp em:
http://www.4shared.c.../xuat_text.html
Xin nhờ bác lấy dùm em toạ độ (X, Y) của 2 text (thực chất là cùng một do justify căn chỉnh).
Về độ cao Z thì bottom right ta lấy phần nguyên và top left ta lấy ra phần thập phân sau dấu phẩy
Nếu bottom right (ctr+ u) thì là số dương và [b] bottom right
là số âm.
Sau khi quét chọn thì sẽ lưu ra tệp txt với định dạng STT X Y Z
Cảm ơn bác Gia_Bach rất nhiều. (Đó là số liệu chuyên ngành hàng hải bác ạ, họ chơi khó mình nên em không có cách nào khác bác ạ! hic)
Chờ tin bác

Sau khi quét chọn thì sẽ lưu ra tệp txt với định dạng STT X Y Z

[b]STT
: qui tắc đánh số STT ra sao ? lấy giá trị ở đâu ?

PS : Tui không chắc là có đủ thời gian để giúp bạn đuợc. :D
  • 1

#26 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 20 August 2010 - 11:38 AM

Sau khi quét chọn thì sẽ lưu ra tệp txt với định dạng STT X Y Z

STT : qui tắc đánh số STT ra sao ? lấy giá trị ở đâu ?

PS : Tui không chắc là có đủ thời gian để giúp bạn đuợc. :D

STT không cần cũng được bác ạ, em chỉ cần X Y Z thôi
Cảm ơn bác đã reply lại ngay. Bác rất bận đúng không ạ. Vậy lúc nào rảnh bác có thể viết dùm em bác nhé. Cảm ơn bác rất nhiều
  • 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







#27 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 22 August 2010 - 04:19 PM

STT không cần cũng được bác ạ, em chỉ cần X Y Z thôi
Cảm ơn bác đã reply lại ngay. Bác rất bận đúng không ạ. Vậy lúc nào rảnh bác có thể viết dùm em bác nhé. Cảm ơn bác rất nhiều

Chào bạn thanhduan2407,
Trong lúc bác Giabach đang bận, mình viết thử cái này để bạn dùng thử xem có đạt yêu cầu không nhé. Lisp mình viết dựa trên cái file chứa các text mẫu mà bạn đã gửi và đã tess thử trên đó thấy OK. Bạn dùng thử nếu thấy có gì chưa hợp ý hãy pót lên vì có thể mình chưa hiểu đúng ý bạn.Bạn thông cảm nhé vì mình không phải có cùng chuyên môn với bạn.
Khi lisp yêu cầu bạn nhập tên file lưu số liệu bạn nhớ nhập cái tên bạn muốn và lưu ý nó để mở lại sau này. Lisp này chỉ lưu lại các giá trị X,Y,Z chứ chưa có STT như bạn đã post.
Chúc bạn vui.

(defun c:xtxt (/ p1 p2 ss n i plist polst en els pt ss1 m j en1 els1 pt1 txtail txtint txtz
txtlst tmp fil pos z )
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint p1 "\n Chon diem thu hai"))
(setq ss (ssget "w" p1 p2 '((0 . "Point")))
n (sslength ss)
i 0
plist (list)
polst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
pt (cdr (assoc 10 els))
ss1 (ssget "w" p1 p2 '((0 . "text")))
m (sslength ss1)
j 0
plist (append plist (list pt))
)
(While (< j m)
(setq en1 (ssname ss1 j)
els1 (entget en1)
pt1 (cdr (assoc 11 els1))
)
(if (and (= (cdr (assoc 72 els1)) 0) (= (cdr (assoc 73 els1)) 3) (equal pt pt1))
(setq txtail (cdr (assoc 1 els1))))
(if (and (= (cdr (assoc 72 els1)) 2) (= (cdr (assoc 73 els1)) 1) (equal pt pt1))
(progn
(setq txtint (cdr (assoc 1 els1)))
(if (= (substr txtint 1 3) "%%U")
(setq txtint (substr txtint 4))
(setq txtint (strcat "-" txtint ))
)
)
)
(setq j (1+ j))
)
(setq txtz (strcat txtint "." txtail)
txtlst (list txtz)
plist (append plist txtlst)
)
(setq polst (append polst (list plist))
plist (list))
(setq i (1+ i))
)
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(progn
(setq fil (open tmp "w") )
(foreach pos polst
(setq z (cadr pos))
(write-line (strcat (rtos (car (car pos))) (chr 44) (rtos (cadr (car pos))) (chr 44) z) fil)
)
(close fil) ))

(command "undo" "e")
(princ)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#28 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 August 2010 - 05:05 PM

Chào bạn thanhduan2407,
Trong lúc bác Giabach đang bận, mình viết thử cái này để bạn dùng thử xem có đạt yêu cầu không nhé. Lisp mình viết dựa trên cái file chứa các text mẫu mà bạn đã gửi và đã tess thử trên đó thấy OK. Bạn dùng thử nếu thấy có gì chưa hợp ý hãy pót lên vì có thể mình chưa hiểu đúng ý bạn.Bạn thông cảm nhé vì mình không phải có cùng chuyên môn với bạn.
Khi lisp yêu cầu bạn nhập tên file lưu số liệu bạn nhớ nhập cái tên bạn muốn và lưu ý nó để mở lại sau này. Lisp này chỉ lưu lại các giá trị X,Y,Z chứ chưa có STT như bạn đã post.
Chúc bạn vui.


(defun c:xtxt (/ p1 p2 ss n i plist polst en els pt ss1 m j en1 els1 pt1 txtail txtint txtz
txtlst tmp fil pos z )
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint p1 "\n Chon diem thu hai"))
(setq ss (ssget "w" p1 p2 '((0 . "Point")))
n (sslength ss)
i 0
plist (list)
polst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
pt (cdr (assoc 10 els))
ss1 (ssget "w" p1 p2 '((0 . "text")))
m (sslength ss1)
j 0
plist (append plist (list pt))
)
(While (< j m)
(setq en1 (ssname ss1 j)
els1 (entget en1)
pt1 (cdr (assoc 11 els1))
)
(if (and (= (cdr (assoc 72 els1)) 0) (= (cdr (assoc 73 els1)) 3) (equal pt pt1))
(setq txtail (cdr (assoc 1 els1))))
(if (and (= (cdr (assoc 72 els1)) 2) (= (cdr (assoc 73 els1)) 1) (equal pt pt1))
(progn
(setq txtint (cdr (assoc 1 els1)))
(if (= (substr txtint 1 3) "%%U")
(setq txtint (substr txtint 4))
(setq txtint (strcat "-" txtint ))
)
)
)
(setq j (1+ j))
)
(setq txtz (strcat txtint "." txtail)
txtlst (list txtz)
plist (append plist txtlst)
)
(setq polst (append polst (list plist))
plist (list))
(setq i (1+ i))
)
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(progn
(setq fil (open tmp "w") )
(foreach pos polst
(setq z (cadr pos))
(write-line (strcat (rtos (car (car pos))) (chr 44) (rtos (cadr (car pos))) (chr 44) z) fil)
)
(close fil) ))

(command "undo" "e")
(princ)
)

Dạ vâng.
Em cảm ơn bác phamthanhbinh nhiều.
Em đã thử nghiệm và cho kết quả rất chính xác. Nhưng em hỏi bác chút là tại sao ta không thực hiện quét chọn đối tượng theo cửa sổ window mà phải kích chọn hai điểm. Bác có thể chỉnh sửa lại được không ạ? Cảm ơn bác rất rất nhiều.
  • 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







#29 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 22 August 2010 - 06:00 PM

Dạ vâng.
Em cảm ơn bác phamthanhbinh nhiều.
Em đã thử nghiệm và cho kết quả rất chính xác. Nhưng em hỏi bác chút là tại sao ta không thực hiện quét chọn đối tượng theo cửa sổ window mà phải kích chọn hai điểm. Bác có thể chỉnh sửa lại được không ạ? Cảm ơn bác rất rất nhiều.

Bạn sửa dòng này :
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint p1 "\n Chon diem thu hai"))

thành dòng :
(setq p1 (getpoint "\n Chon diem dau")
p2 (getcorner p1 "\n Chon diem thu hai"))
  • 2

#30 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 23 August 2010 - 03:50 PM

Chào bạn thanhduan2407,
Trong lúc bác Giabach đang bận, mình viết thử cái này để bạn dùng thử xem có đạt yêu cầu không nhé. Lisp mình viết dựa trên cái file chứa các text mẫu mà bạn đã gửi và đã tess thử trên đó thấy OK. Bạn dùng thử nếu thấy có gì chưa hợp ý hãy pót lên vì có thể mình chưa hiểu đúng ý bạn.Bạn thông cảm nhé vì mình không phải có cùng chuyên môn với bạn.
Khi lisp yêu cầu bạn nhập tên file lưu số liệu bạn nhớ nhập cái tên bạn muốn và lưu ý nó để mở lại sau này. Lisp này chỉ lưu lại các giá trị X,Y,Z chứ chưa có STT như bạn đã post.
Chúc bạn vui.


(defun c:xtxt (/ p1 p2 ss n i plist polst en els pt ss1 m j en1 els1 pt1 txtail txtint txtz
txtlst tmp fil pos z )
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint p1 "\n Chon diem thu hai"))
(setq ss (ssget "w" p1 p2 '((0 . "Point")))
n (sslength ss)
i 0
plist (list)
polst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
pt (cdr (assoc 10 els))
ss1 (ssget "w" p1 p2 '((0 . "text")))
m (sslength ss1)
j 0
plist (append plist (list pt))
)
(While (< j m)
(setq en1 (ssname ss1 j)
els1 (entget en1)
pt1 (cdr (assoc 11 els1))
)
(if (and (= (cdr (assoc 72 els1)) 0) (= (cdr (assoc 73 els1)) 3) (equal pt pt1))
(setq txtail (cdr (assoc 1 els1))))
(if (and (= (cdr (assoc 72 els1)) 2) (= (cdr (assoc 73 els1)) 1) (equal pt pt1))
(progn
(setq txtint (cdr (assoc 1 els1)))
(if (= (substr txtint 1 3) "%%U")
(setq txtint (substr txtint 4))
(setq txtint (strcat "-" txtint ))
)
)
)
(setq j (1+ j))
)
(setq txtz (strcat txtint "." txtail)
txtlst (list txtz)
plist (append plist txtlst)
)
(setq polst (append polst (list plist))
plist (list))
(setq i (1+ i))
)
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(progn
(setq fil (open tmp "w") )
(foreach pos polst
(setq z (cadr pos))
(write-line (strcat (rtos (car (car pos))) (chr 44) (rtos (cadr (car pos))) (chr 44) z) fil)
)
(close fil) ))

(command "undo" "e")
(princ)
)

Chào bác phamthanhbinh
Xin có góp ý với bác về Lisp xtxt
- mặc dù là Lisp cho kết quả chính xác nhưng với dòng
(ssget "w" p1 p2 '((0 . "text")))
bác phải lần luợt duyệt qua toàn bộ tập hợp chọn này để tìm ra cặp có cùng insert point (với file có nhiều Text thì thời gian này là đáng kể).
Trong khi đó cặp Text này luôn có vị trí điểm chèn trùng với điểm chèn của POINT, vây ta có thể rút gọn bộ tập hợp chọn này bằng:
(ssget pt '((0 . "text")))
hay an toàn hơn
(ssget "_C" (polar pt (/ (* 3 pi) 4) hTxt) (polar pt (/ pi -4) hTxt) (list (cons 0 "TEXT") ) )
với hTxt là chiều cao của Text.

Chúc bác sức khỏe!
  • 1

#31 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 23 August 2010 - 06:19 PM

Bạn sửa dòng này :
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint p1 "\n Chon diem thu hai"))

thành dòng :
(setq p1 (getpoint "\n Chon diem dau")
p2 (getcorner p1 "\n Chon diem thu hai"))

Cảm ơn bác Tue_NV đã reply. Em đã chỉnh sửa xong cái đó rồi bác à, cũng giống như bác đã hướng dẫn. Chẳng lẽ đến cái đó mà em cũng không biết chỉnh sửa thì em không dám lên diễn đàn bàn luận đâu. Hi. Lần trước em đã reply cho bác nhưng nghĩ chắc bác đang bận nên không trả lời được. Trình vl-, vlax- của bác cao quá nên em nhiều cái đọc không hiểu. Bác có thể nghiên cứu tiếp giúp em phần " Chọn đối tượng theo thuộc tính được lọc filter trong vùng kín " . Vấn đề này chỉ là chọn đối tượng thôi bác à để mình xử lý theo cách riêng (giống như lệnh "ssx" đó bác). Em vẫn chờ đợi tin của bác. Vấn đề này em tin sẽ có rất nhiều người tìm hiểu và sẽ thường xuyên sử dụng. Em rất yêu Cad bác ạ.
  • 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







#32 NDBNGO

NDBNGO

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 25 August 2010 - 10:28 AM

Tôi muốn thêm 1 yêu cầu nữa trong bài vừa nêu.Nếu trong các bản vẽ của tôi không chỉ có text mà có thể có thêm các block nũa.Sau khi sử lý bước 1 (Theo chương trình cua ban Gia bach đã hết các text đè và trong khoảng thì lại có các block nằm đè hoặc gần trong khoảng( khác layer).Như vậy khi in sẽ đè lên rất xấu.Vậy tôi muốnn các block này phải dich chuyển (chứ không xóa)1 lượng do người dùng yêu cầu.Các block này cũng lại nằm trong 1layer khác
Như vậy phải phải viết lại lisp của bạn Giabach như thê nào .CÓ thể viết 1 lisp để thực hiện yêu cầu thứ 2.
Cảm ơn các bạn.
  • 0

#33 VUVUZELA

VUVUZELA

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 210 Bài viết
Điểm đánh giá: 97 (tàm tạm)

Đã gửi 26 August 2010 - 03:27 PM

Ẹc, bác NDBNGO đòi hỏi nhiều quá
Kiểu này thì các bác đo vẽ bình đồ bước Quy hoạch và TKCS chỉ có nước khóc ... vì các bác tốn công cấy block, điểm ... chống copy file
Và các bác khảo sát của bước TKBVTC lầy hồ sơ trên tẩy xóa + chỉnh lại 1 tý ... lấy tiền KHỎE không
Tội lỗi ... tội lỗi ...

Bon ... on ... n
  • 0

Hệ thống Liên Kết, Thiết Kế Tự Động

ttps://www.facebook...etThietKeTuDong


#34 NDBNGO

NDBNGO

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 26 August 2010 - 05:05 PM

Muốn học để biêt cho tường tận thì phải đặt ra mọi trường hợp có thể xẩy ra để giải quyết chứ . Sao lại phản đối mình chuyện đó nhỉ .
Cảm ơn
  • 0

#35 bk_pro

bk_pro

    Chưa sử dụng CAD

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

Đã gửi 11 December 2010 - 05:29 PM

Chào các anh.
Em là lĩnh mới đọc thấy cái lisp này khá hay nhưng nó có một điểm chưa hoàn thiện
1) Nếu text có điểm piont 3D nữa thì em thấy chỉ lọc được text chứ piont chưa lọc được.
2) Bác nào có thể sửa lọc text thành lọc cả point luôn được không.
  • 0

#36 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 27 December 2010 - 02:32 PM

với tỷ lệ khác thì không được. : Lisp ở trên không phụ thuộc vào tỉ lệ bản vẽ.

Update lisp : cho phép người dùng nhập giá trị khoảng cách cần loại bỏ.
- nói thêm về giá trị này : đó là khoảng cách từ đuờng bao của Text (tưong tự lệnh OFFSET)
Lisp sẽ lọc các Text có giao với đuờng bao Offset này (đuờng màu cyal)
Hình đã gửi

File Cad kết quả : Filter_text.dwg

(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp)
;|By Gia Bach 2010|;
(defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur)
(setq elist (entget ent)
ang (cdr (assoc 50 elist))
tb (textbox elist)
tb1 (car tb)
tb2 (cadr tb)
ll (polar (cdr (assoc 10 elist))
(+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))
lr (polar ll ang (- (car tb2) (car tb1)))
ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) )
(setq ang (angle ll lr) )
(setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))) )
(list ll lr ur ul))

(command "_.undo" "be")
(setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) )
(or *ofset (setq *ofset 0.5))
(initget 4)
(setq ofset (getreal (strcat "\nNhap khoang cach duong vien : <" (rtos *ofset) ">")))
(if (= ofset nil) (setq ofset *ofset) (setq *ofset ofset))

(while (> (sslength ss) 0)
(setq ent (ssname ss 0)
lst (GetBound ent ofset) )
(ssdel ent ss)
(if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))
(progn
(setq i -1)
(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
(if (not (equal ent ent1))
(progn
(ssadd ent1 ss1)
(if (ssmemb ent1 ss) (ssdel ent1 ss)) ))) ) ) )
(if (> (sslength ss1) 0)
(progn
(setq newlayer "Text_Filter")
(if (not (tblsearch "layer" newlayer))
(command "-layer" "n" newlayer "c" 2 newlayer "") )
(command "change" ss1 "" "p" "la" newlayer "") ) )
(command "_.undo" "e")
(princ))

Trước hết em xin chân thành cảm ơn bác Gia_Bach đã nhiệt tình giúp chúng em có được bài toán và ứng dụng rất hay trong việc lọc text. Lisp lọc text dựa trên sự giao nhau của đường bao text.
Hình đã gửi
Tuy nhiên trong quá trình sử dụng thì lisp cũng đánh dấu lọc khi text đứng 1 mình. Em không biết được nguyên nhân tại đâu nữa. Em đang làm lọc text nhưng sếp em lại yêu cầu là chỉ xoá những text trùng đè lên nhau.Nhiều text mặc dù chữ không trùng đè lên nhau nhưng đường bao text lại giao nhau nên nó bị đánh dấu:
Hình đã gửi
Các bác có thể giúp em chỉnh sửa lại lisp giải quyết được vấn đề text không đè lên nhau mà đường bao text lại giao nhau. Bài toán này được đặt ra là do bọn em đi đo sâu dưới nước nên số liệu tương đối dày và nhiều, nếu mà xoá nhiều quá thì họ sẽ coi như là đo sâu bị gián đoạn tín hiệu vệ tinh nên không chấp thuận.
Lisp em dùng là lisp này:
(defun c:FText (/ ent ent1 fil fil1 i j lst newlayer pos ss ss0 ss1 ss_tmp str str1 tmp tmp1)
;|By Gia Bach 2010|;
(defun MakeBound (ent / ang elist ll lr tb tb1 tb2 ul ur)
(setq elist (entget ent)
ang (cdr (assoc 50 elist))
tb (textbox elist)
tb1 (car tb)
tb2 (cadr tb)
ll (polar (cdr (assoc 10 elist))
(+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))
lr (polar ll ang (- (car tb2) (car tb1)))
ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) )
(list ll lr ur ul))

(command "_.undo" "be")
(setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) ss0 (ssadd))
(while (> (sslength ss) 0)
(setq ent (ssname ss 0)
lst (MakeBound ent) )
(ssdel ent ss)
(if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))
(progn
(setq i -1)
(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
(if (not (equal ent ent1))
(progn
(setq str1 (append (list (list (cdr (assoc 1 (entget ent1)))
(cdr (assoc 10 (entget ent1))))) str1))
(ssadd ent1 ss1)
(if (ssmemb ent1 ss) (ssdel ent1 ss))
(if (ssmemb ent1 ss0) (ssdel ent1 ss0))))) ) )
(if (not (ssmemb ent ss1)) (ssadd ent ss0)) )
(setq j -1)
(while (setq ent (ssname ss0 (setq j (1+ j))))
(setq str (append (list (list (cdr (assoc 1 (entget ent)))
(cdr (assoc 10 (entget ent))))) str)) )
(if (> (sslength ss1) 0)
(progn
(setq newlayer "CV");(getstring t "\nNhap ten layer chua Text can filter :"))
(if (not (tblsearch "layer" newlayer))
(command "-layer" "n" newlayer "c" 2 newlayer "") )
(command "change" ss1 "" "p" "la" newlayer "")
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(progn
(setq fil (open tmp "w") )
(foreach txt str
(setq pos (cadr txt))
(write-line (strcat (car txt) (chr 44) (rtos(car pos)) (chr 44) (rtos(cadr pos))(chr 44)
(rtos(caddr pos)))fil) )
(close fil)
(setq tmp1 (strcat (vl-filename-directory tmp) "\\"
(vl-filename-base tmp) "_filter"
(vl-filename-extension tmp))
fil1 (open tmp1 "w"))
(foreach txt str1
(setq pos (cadr txt))
(write-line (strcat (car txt) (chr 44) (rtos(car pos)) (chr 44) (rtos(cadr pos))(chr 44)
(rtos(caddr pos))) fil1) )
(close fil1) )) ) )
(command "_.undo" "e")
(princ))
Cảm ơn các bác nhiều.
  • 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







#37 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 22 April 2014 - 08:28 AM

với tỷ lệ khác thì không được. : Lisp ở trên không phụ thuộc vào tỉ lệ bản vẽ.

Update lisp : cho phép người dùng nhập giá trị khoảng cách cần loại bỏ.
- nói thêm về giá trị này : đó là khoảng cách từ đuờng bao của Text (tưong tự lệnh OFFSET)
Lisp sẽ lọc các Text có giao với đuờng bao Offset này (đuờng màu cyal)
offsettext.jpg

File Cad kết quả : Filter_text.dwg

(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp)  ;|By Gia Bach 2010|;(defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur)  (setq elist (entget ent)	ang   (cdr (assoc 50 elist))	tb    (textbox elist)	tb1   (car tb)	tb2   (cadr tb)	ll    (polar (cdr (assoc 10 elist))		     (+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))	lr    (polar ll ang (- (car tb2) (car tb1)))	ur    (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))	ul    (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1)))    )  (setq ang (angle ll lr) )  (setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))	lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))	ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))	ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))    )  (list ll lr ur ul))    (command "_.undo" "be")    (setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) )    (or *ofset (setq *ofset 0.5))  (initget 4)  (setq ofset (getreal (strcat "\nNhap khoang cach duong vien : <" (rtos *ofset) ">")))  (if (= ofset nil)  (setq ofset *ofset) (setq *ofset ofset))    (while (> (sslength ss) 0)    (setq ent (ssname ss 0)	  lst (GetBound ent ofset) )    (ssdel ent ss)    (if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))      (progn	(setq i -1)	(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))	  (if (not (equal ent ent1))	    (progn	      	      (ssadd ent1 ss1)	      (if (ssmemb ent1 ss) (ssdel ent1 ss))  ))) ) )   )    (if (> (sslength ss1) 0)    (progn      (setq newlayer "Text_Filter")      (if (not (tblsearch "layer" newlayer))	(command "-layer" "n" newlayer "c" 2 newlayer "")	)               (command "change" ss1 "" "p" "la" newlayer "")        ) )  (command "_.undo" "e")  (princ))

Xin chào bác Gia Bach và tất cả mọi người. Mình đã load lisp file text của anh gia bach nhugw ko hiểu bị lỗi gì mà ko dùng được cho file này. Mong anh em giúp đỡ. Đây là file mình cần làm nhưng ko biết bị lỗi gì mà ko lọc được các text gần nhau. Mong anh và mọi người chỉ cho lỗi giúp

Ngày trước mình có sử dụng một lần thì được nhưng giờ làm lại cho các file thì ko được mà ko hiện lỗi gì cả. Mong anh em giúp cho. Bác gia bach bận nhiều việc  quá mong nhờ anh phamthanhbinh và anh em khác xem giúp. Xin cảm ơn các anh

https://www.mediafir...7ruw4u4trd3ddm2


  • 0

#38 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 22 April 2014 - 10:07 AM

Xin chào bác Gia Bach và tất cả mọi người. Mình đã load lisp file text của anh gia bach nhugw ko hiểu bị lỗi gì mà ko dùng được cho file này. Mong anh em giúp đỡ. Đây là file mình cần làm nhưng ko biết bị lỗi gì mà ko lọc được các text gần nhau. Mong anh và mọi người chỉ cho lỗi giúp

Ngày trước mình có sử dụng một lần thì được nhưng giờ làm lại cho các file thì ko được mà ko hiện lỗi gì cả. Mong anh em giúp cho. Bác gia bach bận nhiều việc  quá mong nhờ anh phamthanhbinh và anh em khác xem giúp. Xin cảm ơn các anh

https://www.mediafir...7ruw4u4trd3ddm2

Hề hề hề,

File của bác gia_bach sử dụng cho các text có căn lề là baseline left trong khi text của bạn có căn lề là baseline center.

Do vậy việc lọc không thực hiện được. 


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#39 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 22 April 2014 - 10:15 AM

Hề hề hề,

File của bác gia_bach sử dụng cho các text có căn lề là baseline left trong khi text của bạn có căn lề là baseline center.

Do vậy việc lọc không thực hiện được. 

Dạ em cảm ơn anh. Anh có thể sửa lại giúp em là có thể sử dụng cho  cả trường hợp căn lề baseline center được ko anh. Tại vì nếu căn lề là baseline left thì vị trí text sẽ sai mất so với cọc (trường hợp của em). Em cảm ơn anh


  • 0

#40 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 22 April 2014 - 02:18 PM

Rất mong các anh vào giúp đỡ mình sửa cái lisp FTEXT trên của bác gia_bach cho phù hợp với công việc của mình với.

Theo như anh phamthanhbinh nói là cái lisp này chỉ lọc được các text cho trường hợp các text có căn lề là baseline left. Mình cần lọc text có căn lề là baseline center. Nhờ mọi người chỉnh sửa giúp để thực hiện được.Xin cảm ơn tất cả anh em.


  • 0