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  
NDBNGO

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

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

thanhduan2407    227
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

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
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 (       (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 (              (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)
)

  • 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
thanhduan2407    227
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.

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
Tue_NV    3.841
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"))

  • Vote tăng 2

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
gia_bach    1.442
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!

  • 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
thanhduan2407    227
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 ạ.

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
NDBNGO    20

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.

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
VUVUZELA    98

Ẹ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

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
NDBNGO    20

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

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

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.

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
thanhduan2407    227
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))

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.

2_17.jpg

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:

1_33.jpg

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.

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

 

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.mediafire.com/?7ruw4u4trd3ddm2

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

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.mediafire.com/?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. 

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

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

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

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.

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

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

Hề hề hề,

Hãy dùng thử cái này. Việc sửa lisp của bác Gia_bach không phải là không thể nhưng có nhẽ hơi lâu vì phải đọc kỹ mới được. Nếu lisp này chưa thỏa mãn yêu cầu của bạn thì mình sẽ sửa líp của bác gia_bach sau vậy.

http://www.mediafire.com/download/l1570yn56tf26wl/Xoatexttrung.lsp

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

File của bạn không chạy được là do đang xài UCS chứ không phải WCS.

Bạn có thể thêm dòng  (command "ucs" "w") ở đầu file lsp và

 (command "ucs" "p") ở cuối file lsp.

 

Các giá trị xuất ra file csv cũng ở toạ độ WCS, đó có phải là cái bạn muốn 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
phamthanhbinh    3.123

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.

Hề hề hề,

Đây là cái mình sửa từ líp của bác gia_bach

http://www.mediafire.com/download/qu4uyujpqe5e81y/Filtertext.lsp

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

Hề hề hề,

Đây là cái mình sửa từ líp của bác gia_bach

http://www.mediafire.com/download/qu4uyujpqe5e81y/Filtertext.lsp

Dạ em xin cảm ơn anh phamthanhbinh va anh Tot77 đã giúp đỡ. Của em ko cần xuất toạ độ. Chỉ cần lọc các text gần nhau với khoảng cách tuỳ chọn tạo thành layer khác. Có lẽ do ko chuyển trục nên ko dùng được lisp này của bác giabach. Nhờ anh chỉnh sửa giúp lisp sau của bác giabach cho trường hợp mọi ucs.

Xin cảm ơn anh

Đây là lisp của bác giabach. Nhờ anh sửa lisp này giúp

https://www.mediafire.com/?qgz1bdslly908x1

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

Gửi lại bạn. Có điều là tôi bỏ luôn việc nhập khoảng cách đường viền vì thấy nó không cần thiết, text nào chồng lên nhau thì tự động 1 cái chuyển qua layer khác.

 

http://www.mediafire.com/download/i6ziwpms7p4o16u/Xoa_text_gan_nhau_tren_binh_do_-_LTT.lsp

Khi chạy lisp bạn phải tắt hết các layer có  text khác không liên quan, vì lisp không phân biệt  text thuộc layer 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
gia_bach    1.442

Dạ em xin cảm ơn anh phamthanhbinh va anh Tot77 đã giúp đỡ. Của em ko cần xuất toạ độ. Chỉ cần lọc các text gần nhau với khoảng cách tuỳ chọn tạo thành layer khác. Có lẽ do ko chuyển trục nên ko dùng được lisp này của bác giabach. Nhờ anh chỉnh sửa giúp lisp sau của bác giabach cho trường hợp mọi ucs.

Xin cảm ơn anh

Đây là lisp của bác giabach. Nhờ anh sửa lisp này giúp

https://www.mediafire.com/?qgz1bdslly908x1

Bạn sửa như gợi ý của Tot7 : 

- thêm  dòng  (command "ucs" "w") sau dòng   (command "_.undo" "be) 

- thêm  dòng (command "ucs" "p") trước dòng  (command "_.undo" "e") 

 

@Tot7 : dùng hàm getBoundingBox sẽ không đúng khi Text nghiê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
Doan Van Ha    2.676

Dạ em xin cảm ơn các anh. E làm được rồi. Ko tìm thấy nút thank ở chỗ nào cả

Post 63 bài mà chưa biết nút Thanks? Hình như chưa thank ai cả? Vậy thì bấm vào cái mũi tên màu xanh ở bên phải để thank Tot77 đi!

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  

×