Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2854 replies to this topic

#2321 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 December 2014 - 04:38 PM

Em hỏi nhờ một chút ạ!

 

Em viết chương trình thống kê layer theo màu sắc được chọn. Tuy nhiên tốc độ hơi chậm.

 

Vậy các bác có thể góp ý để nâng cấp tốc độ nó lên được không ạ?

 

Vì dụ trong việc lọc để lấy đối tượng đó ạ.

 

Nó chấp nhận Bylayer và Truecolor (bỏ qua Byblock)

 

 

(defun C:SCL(/ ColorObj  ClorChuan  ss L3 L2 e   ColorTest mau  Lts_Clor_Layer           )
(setvar "CMDECHO" 0)
(setq Ent (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng l\U+1EA5y m\U+00E0u s?c \U+0111\U+1EC3 th\U+1ED1ng k\U+00EA: ")))
(setq ColorObj (vla-get-ColorIndex (vla-get-truecolor (vlax-ename->vla-object Ent ))))
(if (= ColorObj 256)
    (setq ClorChuan (_getentitycolour Ent))
    (setq ClorChuan ColorObj)
)

(setq ss (acet-ss-to-list (ssget)))
(setq L2 (list))
(setq L3 (list))
(Foreach e ss
	(setq ColorTest  (vla-get-ColorIndex (vla-get-truecolor (vlax-ename->vla-object e))))
  	(if (= ColorTest 256)
	    (setq mau (_getentitycolour e))
	    (setq mau ColorTest)
	)
  	(setq Layer (cdr (assoc 8 (entget e))))
  	(setq L2 (list mau Layer))
  	(setq L3 (append L3 (list L2)))
)

(setq Lts_Clor_Layer (FILTEROBJ1 (vl-remove nil (mapcar '(lambda(x) (if ( = (car x) ClorChuan) (cadr x) nil)) L3))))
(princ Lts_Clor_Layer)
(princ )
)


(defun FILTEROBJ1 ( l  /)
    (if l
      (cons (car l)
        (FILTEROBJ1
          (vl-remove-if '(lambda ( x ) (= x (car l))) (cdr l))
        )
      )
    )
)



(defun _getentitycolour ( ent / )
    (abs
        (cond
            (   (cdr (assoc 62 (entget ent))))
            (   (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget ent)))))))
        )
    )
)

 

Trong vòng lặp Foreach em có thể xử lý ra kết quả luôn, không cần phải lặp bằng đệ quy (hàm  FILTEROBJ1 và mapcar nữa

Còn xử lý như thế nào là nghệ thuật của em. Chúc em thành công!


  • 0

#2322 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 29 December 2014 - 05:10 PM

Trong vòng lặp Foreach em có thể xử lý ra kết quả luôn, không cần phải lặp bằng đệ quy (hàm  FILTEROBJ1 và mapcar nữa

Còn xử lý như thế nào là nghệ thuật của em. Chúc em thành công!

Dạ vâng ạ!

Em sẽ bỏ 2 hàm đó đi.

Em cảm ơn anh Tue_NV


  • 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







#2323 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

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

Đã gửi 29 December 2014 - 08:26 PM

Chào các bác. Em có một vấn đề nhỏ mong các bác tư vấn giúp. Em dùng hàm tblsearch trong bản vẽ block có tên là "A". Sau khi tìm được rồi em muốn đổi tên block này sang "B" thì làm thế nào để được kết quả như ý muốn. Block của em là block bình thường các bác ạ. Thanks các bác.
  • 0

#2324 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 29 December 2014 - 09:31 PM

Lisp đổi tên Block dường như có roi sao ấy nhỉ... -_-  search tim thử. Không thì gỏ -rename vào dòng lệnh ra cái gì thì viết theo cái đó vậy :)


  • 1

#2325 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

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

Đã gửi 30 December 2014 - 09:09 AM

Thanks pphung183 nhé. :D


  • 0

#2326 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 03:56 PM

Các bác cho em hỏi 1 chút.

Em viết một hàm tọa độ của Text khi biết tên của Text đó trong 1 tập hợp Text. Vậy mà kết quả vẫn trả về nil mặc dù em tìm đúng.

Sau khi quét chọn Text em có 1 danh sách (LtsNPoint)   dạng: ("B44" (442758.0 1.39677e+006 0.0)) ("B43" (442622.0 1.39673e+006 0.0)) ("B42" (442522.0 1.39671e+006 0.0)) …….

Gõ một tên và tìm trong danh sách đó, nếu tìm được tên thì lấy ra tọa độ của phần tử đó.

Các bác xem em lỗi chỗ nào?

Cảm ơn các bác!

(defun GetName (Tenss LtsNPoint / i e Loop)
(setq i 0)
(setq Loop nil)
(setq Pnt (list))
(while (< i (length LtsNPoint))
	(setq e (nth i LtsNPoint))
	(if (= (car e)  Tenss)
	    (progn
		(setq Pnt (cadr e))
		(setq Loop T)
	    )
	    (setq Pnt nil)
	)
  	(setq i (1+ i))
)
Pnt
)

  • 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







#2327 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 04:01 PM

Em nên viết cái list đó thành dạng mỗi item là 1 cặp assoc, VD ("B44" . (x y z)).

Khi đó em tìm rất dễ: (cdr (assoc "B44")) >> (x y z)

 

P/S: srr, vội quá nhầm, sửa lại:

lst = ( ... ("B44" . (x y z)) ... )

Thì:

(cdr (assoc "B44" lst) >> (x y z)


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


#2328 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 04:10 PM

Em nên viết cái list đó thành dạng mỗi item là 1 cặp assoc, VD ("B44" . (x y z)).

Khi đó em tìm rất dễ: (cdr (assoc "B44")) >> (x y z)

Dạ vâng! Để em thử xem. Cảm ơn bác Hạ nhiều ạ! Lúc nào bác cũng là người đầu tiên giúp.


  • 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







#2329 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 31 December 2014 - 04:13 PM

- hi nếu lst anh để như cũ có thể sữa lại thế này, nhoc thấy cũng đc ^^

(defun GetName (Tenss LtsNPoint / i e Loop Pnt)
(setq i 0)
(setq Loop nil)
(while (< i (length LtsNPoint))
	(setq e (nth i LtsNPoint))
	(if (= (car e)  Tenss)
	    (progn
		(setq Pnt(nth 1 e))
		(setq Loop T)
	    )
	   ; (setq Pnt nil)
	)
  	(setq i (1+ i))
)
Pnt
)

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

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








#2330 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 December 2014 - 04:42 PM

Em nên viết cái list đó thành dạng mỗi item là 1 cặp assoc, VD ("B44" . (x y z)).

Khi đó em tìm rất dễ: (cdr (assoc "B44")) >> (x y z)

 

P/S: srr, vội quá nhầm, sửa lại:

lst = ( ... ("B44" . (x y z)) ... )

Thì:

(cdr (assoc "B44" lst) >> (x y z)

 

Làm gì có dạng list ("B44" . (x y z)) bác nhỉ?

 

Với list (LtsNPoint)   dạng: ("B44" (442758.0 1.39677e+006 0.0)) ("B43" (442622.0 1.39673e+006 0.0)) ("B42" (442522.0 1.39671e+006 0.0))

thì cũng hoàn toàn có thể dùng : (cdr (assoc "B44" LtsNPoint)) -> (442758.0 1.39677e+006 0.0)


  • 0

#2331 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 04:51 PM

Hic hic. Bác Tue_NV nói đúng kiểu em hỏi ạ. Em làm mãi không được. Cơ mà bác ấy sửa lại rùi, phù.

Cảm ơn nhoklangbat nhé! ANh ktra xem đã

Cảm ơn anh Tue_NV


  • 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







#2332 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 04:57 PM

Cảm ơn nhoclangbat  anh cứ nghĩ hàm phải trả về cơ. Chợt sực nhớ là nếu ko tìm được thì nó cũng trả về giá trị nil rồi.

Chương trình đã chạy ngon


  • 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







#2333 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

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

Đã gửi 31 December 2014 - 09:45 PM

Bác Tue_NV ơi cho em nhiều chuyện chút, em làm giống như bác kết quả vẫn trả về list trong list ạ:

Làm gì có dạng list ("B44" . (x y z)) bác nhỉ?

 

Với list (LtsNPoint)   dạng: ("B44" (442758.0 1.39677e+006 0.0)) ("B43" (442622.0 1.39673e+006 0.0)) ("B42" (442522.0 1.39671e+006 0.0))

thì cũng hoàn toàn có thể dùng : (cdr (assoc "B44" LtsNPoint)) -> (442758.0 1.39677e+006 0.0)

Command: (setq lst '(("A" (1 2 3)) ("B" (4 5 6))))
(("A" (1 2 3)) ("B" (4 5 6)))

Command: (cdr (assoc "A" lst))
((1 2 3))

 

Em thấy trong cad mã dxf của đối tượng hoặc để là dạng (1  . "0") hoặc dạng ( 10 1.0 0.0 0.0). Theo em nghĩ thì list của bác thanhduan247 để dạng

("B44" 442758.0 1.39677e+006 0.0 ) ... khi dùng (cdr (assoc "B44" lst)) sẽ vẫn trả ra kết quả list toạ độ ngon lành. :D


  • 0

#2334 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 09:50 PM

@090: bạn sửa cdr thành cadr

@Tue_NV: thông cảm, sơ suất.


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


#2335 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 02 January 2015 - 09:03 AM

-mấy anh cho nhoc hỏi cách tạo ra file .scr để có thể tự chạy các file cad trong thư mục với lsp chỉ định với, nhoc đang viết 1 lệnh từ 1 file có nhiều layout sau đó xuất các layout qua model mỗi layout thành 1 file mới, sau đó  tự mở các file vừa chuyển chạy lệnh lsp tiếp theo save rùi close = cách dùng file scrip


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

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








#2336 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 02 January 2015 - 10:06 AM

-mấy anh cho nhoc hỏi cách tạo ra file .scr để có thể tự chạy các file cad trong thư mục với lsp chỉ định với, nhoc đang viết 1 lệnh từ 1 file có nhiều layout sau đó xuất các layout qua model mỗi layout thành 1 file mới, sau đó  tự mở các file vừa chuyển chạy lệnh lsp tiếp theo save rùi close = cách dùng file scrip

 

Cách tạo, ghi file scr bằng lisp tương tự như cách tạo, ghi file txt


  • 1

#2337 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 02 January 2015 - 11:27 AM

Anh Tue có thể viết code mẫu cho nhoc xem với ^^ đó giờ nhoc chưa nghiên cứu đến phần ghi ra file nên còn hơi lờ mờ, nhoc xem trên mạng thấy ghi tên file làm cách nào để lấy đc tên file khi file đc tạo ra, mình có thể gọi lun file .scr trong lsp ko anh
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#2338 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 02 January 2015 - 11:48 AM

Anh Tue có thể viết code mẫu cho nhoc xem với ^^ đó giờ nhoc chưa nghiên cứu đến phần ghi ra file nên còn hơi lờ mờ, nhoc xem trên mạng thấy ghi tên file làm cách nào để lấy đc tên file khi file đc tạo ra, mình có thể gọi lun file .scr trong lsp ko anh

 

1./ "Cách tạo, ghi file scr bằng lisp tương tự như cách tạo, ghi file txt"

File *.scr chỉ khác file *.txt cái đuôi "scr" thôi mà nhóc.

Nhóc đã tạo file txt được thì đương nhiên tạo file scr được

 

2./ Command: (setq fn (getfiled "Ten file: " "" "txt" 1))

"D:\\q.txt"

-> Với chuỗi  "D:\\q.txt" nhóc hoàn toàn có thể lấy được tên file tạo ra 

 

3./ "Gọi" file *.scr -> Từ "Gọi" của Nhóc là "Load" file scr lên hay là "open" file scr?.

Cả 2 : "Load" file scr lên hay là "open" file scr -> Lisp đều có thể làm được

Command: (setq fn (getfiled "Ten file: " "" "txt" 1))

  • 0

#2339 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 03 January 2015 - 09:32 AM

Cho em hỏi một chút ạ

Em muốn làm 1 thao tác chọn đối tượng phải là Text, chọn sai hoặc chưa chọn được thì phải chọn lại cho đến khi Enter thì kết thúc thì viết phương thức như nào ạ?

Em viết như này rồi! Mong các anh xem dùm. Em chưa tách được không chọn được đối tượng với key Enter (or space) nên chưa thực hiện dc.

(setq loop T)
(while loop
	(setq EntObj  (entsel "\nCh\U+1ECDn Text cho \U+0111\U+1EBFn khi Enter th\U+00EC k\U+1EBFt th\U+00FAc : "))
  	(while
		(or (null EntObj) (/= "TEXT"  (cdr (assoc 0 (entget (car EntObj))))))
		(setq EntObj (entsel "\n\U+0110\U+00E2y kh\U+00F4ng ph\U+1EA3i TEXT! B\U+1EA1n ch\U+1ECDn l\U+1EA1i! "))
	)
  	(cond
	  (T
		(if (or (null EntObj)(/= "TEXT"  (cdr (assoc 0 (entget (car EntObj))))))
		  (progn
		  	(setq Tendiem (list (cdr (assoc 1 (entget (car EntObj))))))
		    	(setq LtsTendiem (append LtsTendiem (list Tendiem)))
		    	
		  )
		  (setq loop nil)
		)
	  )
	)
)

Em cảm ơn các anh!


  • 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







#2340 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 03 January 2015 - 09:44 AM

@thanhduan: Em nghiên cứu thêm về hàm grread!


  • 0