Đến nội dung


Hình ảnh
- - - - -

[ Yêu Cầu ] Lisp lọc text số nguyên và text có số thập phân.


  • Please log in to reply
35 replies to this topic

#21 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 01 August 2013 - 04:08 PM

Lý do là không có text "2 abc" và không có text "." nên không cần thay. Còn khi có cả 2 hoặc nhiều hơn nữa thì có thay read cũng không thể giải quyết triệt để những bài toán kiểu này.

Tôi hiểu tất cả những điều mà mọi người đã comment ở trên.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#22 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 11:21 AM

Bác Hạ thay hàm read bằng distof và dùng thêm hàm if nữa là giải quyết xong bài toán

Anh KangKung hoặc các bác có thể hoàn thiện lisp này được không nhỉ?

Em cũng mày mò chút nữa. :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







#23 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 11:27 AM

Em đã dùng cách này để tách

(defun C:TTD (/ ss ss1 ss2 e1 e2 txt);;;;;TACH THUA DAT
(MakeLayer_ "LOAIDAT" 1)
(MakeLayer_ "SOTHUA" 2)
(MakeLayer_ "DIENTICH" 3)
(setq ss (ssget (list (cons 0 "TEXT"))))
(setq ss2 (ChonTextSo ss))
(setq sstemp (LM:ListDifference (acet-ss-to-list ss) (acet-ss-to-list ss2)))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if (or (= (strlen (acet-dxf 1 (entget x))) 2) (= (strlen (acet-dxf 1 (entget x))) 3)) x nil)) sstemp)))
(foreach e1 ss1
	(vla-put-Layer (vlax-ename->vla-object e1) "LOAIDAT")
)

(foreach e2 (acet-ss-to-list ss2)
	(setq txt (type (read (cdr (assoc 1 (entget e2))))))
  	(if (= txt 'INT)
	    (vla-put-Layer (vlax-ename->vla-object e2) "SOTHUA")
	    (vla-put-Layer (vlax-ename->vla-object e2) "DIENTICH")
	 )
)
(princ)  
)

(defun ChonTextSo (ss / i ent str ss1) 
    (progn
      (setq i	0
	    ss1	(ssadd)
      )
      (repeat (sslength ss)
	(setq ent (ssname ss i)
	      str (cdr(assoc 1 (entget ent)))
	      i	  (+ 1 i)
	)
	(if (distof str 2)
	  (ssadd ent ss1)
	)
      )
      (if (> (sslength ss1) 0)
	ss1
      )      
    )
)

(defun MakeLayer_ ( name colour /)
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

(defun LM:ListDifference ( l1 l2 )
  (if l1
    (if (member (car l1) l2)
      (LM:ListDifference (cdr l1) l2)
      (cons (car l1) (LM:ListDifference (cdr l1) l2))
    )
  )
)

Các bác cho em lời nhận xét nhé


  • 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 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 22 September 2014 - 01:59 PM

hihi ko pit anh Thanhduan2407 còn nhớ cái y/c viết lsp của nhoc hồi mới tham gia 4rum ko nhỉ, anh chê nhoc trình bày ko trong sáng đó ^^, nhìn qua y/c của bạn này thấy cũng hao hao giống y/c của nhoc hồi đó. anh Ket với anh HHVD có giúp nhoc hoàn thiện ^^.

- lsp a nhoc thử nếu loai đất có số hình như nó ko hiểu nên ko chuyển được layer

- lsp a Ket với HHVD giúp nhoc nó chuyễn đc lun, nhưng điểm yếu của lsp là phải xác định trước layer cần chuyển trong lsp, nên nhoc có set thêm user nhập tên layer, anh xem thử có thể  kết hợp sao đó để ko cần xác định trước layer chỉ cần quyét phát hết chuyển đc lun tì tốt quá ạ :)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...hac-nhau/page-2
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
)
(defun CreatLayer(MyLayer / MyColor)
(if (not (tblsearch "LAYER" MyLayer))
(progn
  (entmakex
   (list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 70 0)
(cons 2 MyLayer)
   )
  )
)
)
)
(defun ChangeLayer(kq / i dt type_dt)
(repeat (setq i (sslength kq))
  (setq dt (ssname kq (setq i (1- i))))
  (setq type_dt (type (read (dxf 1 dt))))
  (cond
   ((= type_dt 'INT) (PUT-GC "SOTHUA" 8 dt))
   ((= type_dt 'REAL) (PUT-GC "DIENTICH" 8 dt))
   ((= type_dt 'SYM) (PUT-GC "LOAIRUONGDAT" 8 dt))
  )
)
)
(defun c:tachthua (/ ss el qa kq i as)
(vl-load-com)
(CreatLayer "SOTHUA")
(CreatLayer "DIENTICH")
(CreatLayer "LOAIRUONGDAT")
(setq as (getstring "\nnhap ten layer can tach:"))
(setq ss  (ssget (list (cons 8 as))) kq (ssadd))
(setq qa (getvar 'QAFLAGS))
(setvar 'QAFLAGS 1)
(repeat (setq i (sslength ss))
  (setq e (ssname ss (setq i (1- i))))
  (setq dxf0 (dxf 0 e))
  (cond
   ((= dxf0 "TEXT") (ssadd e kq))
   (
    (= dxf0 "INSERT")
    (progn
	(setq el (entlast))    
	(command "explode" ss "")
    
	(while (setq en (entnext el))
      (if (= (dxf 0 en) "TEXT") (ssadd en kq))
      (setq el en)
	)
    )
   )  
  )
)
(setvar 'QAFLAGS qa)
(ChangeLayer kq)
(princ "\nHochoaivandot - Cadviet.com")
(princ)
)


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#25 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 02:38 PM

hihi ko pit anh Thanhduan2407 còn nhớ cái y/c viết lsp của nhoc hồi mới tham gia 4rum ko nhỉ, anh chê nhoc trình bày ko trong sáng đó ^^

Không biết ngày xưa mình nói gì để bạn  nhoclangbat giận mình nhỉ? Chắc là làm điều gì mang tính tiêu cực nên mình mới nói là ko trong sáng. ^^ (có thể là bịa số liệu. Hehehehe)

Lisp của mình gửi lên đã làm được rồi mà, không cần chọn layer trước.

Tuy nhiên thì lisp của mình và lisp của nhoclangbat đều không giải thích được vì sao quét với số lượng nhiều lại không thực hiện được.

Gửi Lisp của mình và file test để bạn thử nhé!

(defun C:TTD (/ ss ss1 ss2 e1 e2 txt);;;;;TACH THUA DAT
(MakeLayer_ "LOAIDAT" 1)
(MakeLayer_ "SOTHUA" 2)
(MakeLayer_ "DIENTICH" 3)
(setq ss (ssget (list (cons 0 "TEXT"))))
(setq ss2 (ChonTextSo ss))
(setq sstemp (LM:ListDifference (acet-ss-to-list ss) (acet-ss-to-list ss2)))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if (or (= (strlen (acet-dxf 1 (entget x))) 2) (= (strlen (acet-dxf 1 (entget x))) 3)) x nil)) sstemp)))
(foreach e1 ss1
	(vla-put-Layer (vlax-ename->vla-object e1) "LOAIDAT")
)
(foreach e2 (acet-ss-to-list ss2)
	(setq txt (type (read (cdr (assoc 1 (entget e2))))))
  	(cond
	   ((= txt 'INT)
	    (vla-put-Layer (vlax-ename->vla-object e2) "SOTHUA")
	   )
	   ((= txt 'REAL)
	    (vla-put-Layer (vlax-ename->vla-object e2) "DIENTICH")
	   )
	 )
)
(princ)  
)



(defun ChonTextSo (ss / i ent str ss1) 
    (progn
      (setq i	0
	    ss1	(ssadd)
      )
      (repeat (sslength ss)
	(setq ent (ssname ss i)
	      str (cdr(assoc 1 (entget ent)))
	      i	  (+ 1 i)
	)
	(if (distof str 2)
	  (ssadd ent ss1)
	)
      )
      (if (> (sslength ss1) 0)
	ss1
      )      
    )
)

(defun MakeLayer_ ( name colour /)
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

(defun LM:ListDifference ( l1 l2 )
  (if l1
    (if (member (car l1) l2)
      (LM:ListDifference (cdr l1) l2)
      (cons (car l1) (LM:ListDifference (cdr l1) l2))
    )
  )
)

http://www.cadviet.c...5_file_test.dwg


  • 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







#26 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2014 - 03:23 PM

(type (read ".0")) => Lỗi. Lỗi này chắc tự a xử được :)


  • 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


#27 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 05:02 PM

(type (read ".0")) => Lỗi. Lỗi này chắc tự a xử được

Đúng là lỗi tại nó. Anh cố tình cho "0" vào đằng sau những số đó để phân biệt diện tích.

Em khắc phục cho anh cái này nhé. Cảm ơn em


  • 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







#28 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 05:07 PM

Vấn đề là khi anh zoom to thì được còn khi zoom nhỏ toàn màn hình thì không được. Rất lạ lỗi này


  • 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 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2014 - 05:19 PM

A viết cả cái code dài vậy mà chỉ thêm điều kiện char đầu tiên là dấu "." k xử lý được á a ?


  • 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


#30 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 06:40 PM

Hii, anh tưởng em có cách hay. hé hé.

Thực ra, anh cứ viết nó ra kết quả là dc. Dài hay ngắn thì tối ưu sau. Hé hé


  • 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







#31 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 22 September 2014 - 06:41 PM

đúng là nhiều quá ko chạy đc ^^, file a đưa nó loạn xạ @@, chứ bình thường nhoc chạy cho 1 tờ bản đồ hơn trăm thửa vẫn chạy tốt ngộ thiệt


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#32 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 06:48 PM

Bạn nhoclangbat zoom in 1 khu vực nhỏ và sử dụng lệnh thì được đó. Hoặc quét từng vùng nhỏ thì dc. :D

Còn nhiều nhiều 1 tí là....hổng có đc. :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







#33 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 22 September 2014 - 06:58 PM

uh đúng rùi, nhưng khi nhoc làm khoảng 200 thửa đỗ lại nhoc cũng zoom toàn màn hình, để quét toàn tờ bản đồ thì vẫn ok, chắc là có 1 sự hên xui ở đây ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#34 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 22 September 2014 - 07:14 PM

Bạn có thể viết như vầy cho gọn và không bị lỗi.

(defun C:TTD (/ ss ss1 ss2 e1 e2 txt);;;;;TACH THUA DAT
(MakeLayer_ "LOAIDAT" 1)
(MakeLayer_ "SOTHUA" 2)
(MakeLayer_ "DIENTICH" 3)
(setq ss (ssget (list (cons 0 "TEXT"))))
(foreach e2 (acet-ss-to-list ss)
  (setq txt (cdr (assoc 1 (entget e2))))
  (cond ((not (distof txt))
 (vla-put-Layer (vlax-ename->vla-object e2) "LOAIDAT"))
((vl-string-search "." txt)
(vla-put-Layer (vlax-ename->vla-object e2) "DIENTICH"))
   (t (vla-put-Layer (vlax-ename->vla-object e2) "SOTHUA"))
)
)
(princ)  
)
 
(defun MakeLayer_ ( name colour /)
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
 
 
 

  • 2

#35 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 22 September 2014 - 07:26 PM

- anh Tot77 ac thật ngắn gọn xúc tích, file a Duan đưa lên xử phát 1 ^^


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#36 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 22 September 2014 - 08:17 PM

Cách giải quyết của anh Tot77 lúc nào cũng rất OK. Cảm ơn anh


  • 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