Đế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

#2001 Namvanvo

Namvanvo

    Edu level: li5

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

Đã gửi 17 October 2014 - 11:02 AM

Mình mò được rồi,  bỏ dòng 
(*error* msg), không biết khi bỏ đi thì có ảnh hưởng gì tới hàm không? 

Bác có thể diễn giải thêm về cái hàm này được không?

vẫn câu hỏi cũ, muốn hỏi rõ để có thể áp dụng vào những trường hợp tương tự  :D


  • 0

#2002 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 17 October 2014 - 11:14 AM

Thật ra muốn dùng hàm *error* để xử lý lỗi thì bạn phải viết nguyên cụm như thế này.

 

(setq temperr *error*)
(setq *error* errorTrap)
(defun errorTrap (msg)
  ;;; muon lam gi thi viet o day ;;;
  (setq *error* temperr)
)

Tức là lưu hàm  *error* gốc vào 1 biến nào đó, định nghỉa lại hàm , và sau khi bắt lỗi xong, làm những việc cần làm xong thì trả lại cái hàm gốc cho nó.


  • 1

#2003 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 17 October 2014 - 01:55 PM

- có hàm này bãy lỗi tốt thật nhưng nhoc vẫn chưa hiểu nó ^^, có xem vài box nói về nó nhưng thấy nó cứ vòng vòng lẫn quẫn,như a Tot77 gợi ý viết vậy đc ko hỉ ^^

(defun bayloi (nhacloi)	
(setvar "osmode" oldos)	
(setvar "clayer" oldlay)
(setvar "cmdecho" oldcmd)
(setq *error* luuham)	
(prompt "\nxin tra lai e tat ca ^^!!!")	
(princ)
)
(defun c:test()
(setq luuham *error*)
(setq *error* bayloi)
(......)
(setq *error* luuham)
)

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

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








#2004 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 17 October 2014 - 02:44 PM

Nên để hàm bayloi vao trong lệnh test, để chỉ khi lỗi trong lệnh này nó xử lý thôi. Còn lệnh khác bãy cái khác, Riêng cái câu (setq luuham *error*) thì có thể để bên ngoài (để phòng xa xem như đã lưu hàm gốc ở nơi an toàn vậy mà).

(setq luuham *error*)
(defun c:test()  
  (defun bayloi (nhacloi) 
    (setvar "osmode" oldos) 
    (setvar "clayer" oldlay)
    (setvar "cmdecho" oldcmd)
    (setq *error* luuham) 
    (prompt "\nxin tra lai e tat ca ^^!!!") 
    (princ)
  )
  (setq *error* bayloi)
  (......)
)

  • 1

#2005 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 17 October 2014 - 03:57 PM

- ^^ theo gợi ý của Hiep nhoc đã viết đc hàm tạo block, mấy a xem nó có chỗ nào ko ổn ko góp ý nhoc với ^^

(defun taoblock ()
(if (null (tblsearch "layer" "diem_cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem_cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem_cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem_cam")))
(vl-cmdf "pselect" "p" "" "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)

- sẳn anh Tott gợi ý nhóc viết lệnh để rải block các đỉnh line và pline (gồm mã 10 và 11 lun) = cách quét chọn ^^, nhoc nhớ a có viết lsp rãi block cống xã gì đó mà nhoc kím chưa ra để mót thử ^^


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

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








#2006 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 17 October 2014 - 04:05 PM

Hình như với entmake thì ko cần tao trước layer !


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#2007 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 17 October 2014 - 04:10 PM

lsp cống xả đây, nhưng có liên quan gì tới cái của nhoc?

http://www.cadviet.c.../127168_che.rar


  • 0

#2008 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 17 October 2014 - 04:19 PM

- Nhoc tính mót thử để xem, ý tưởng của nhoc là tính viết 1 lsp chèn block lên các điểm của line và pline như lsp che.lsp của anh vậy đó, mà lsp anh nó rải đầu cuối, ko rãi đc các toàn bộ các điểm của pline với line, lsp anh viết cao qua nhoc cũng chưa dịch nổi để sữa hihi


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

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








#2009 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 17 October 2014 - 09:26 PM

Lấy toàn bộ các điểm của LWPOLYLINE thì nhoc dùng 

(mapcar 'cdr (vl-remove-if-not '(lambda(x) (= 10 (car x))) (entget pl)))

với pl là pline.

Cái khó khi insert block ko phải là điểm mà là góc xoay của block.


  • 0

#2010 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 17 October 2014 - 11:20 PM

- anh Tott ơi nhoc mót của anh viết thử gần đc mà hình như trục trặc chỗ nào nhoc ko mò ra nỗi ^^, giúp nhoc với

;================================================================================================
(defun getp(v / l1 l2 lst)
(setvar "cmdecho" 0)
    ;(if (or (= "LINE" (cdr (assoc 0 (entget v)))) (= "LINE" (cdr (assoc 0 (entget v)))))
     ;(progn
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       (setq lst (append l1 l2))
      ;)    
    ;)
    (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) lst)
  )
;==================================================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;========================================================================================
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;====================================================================================
(defun c:raib()
(setvar "osmode" 0)
;==================================================================
(defun taoblock ()
(vl-load-com)
(setvar "osmode" 0) (setvar "cmdecho" 0)
(if (null (tblsearch "layer" "diem-cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem-cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem-cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem-cam")))
(vl-cmdf "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)
(if (null (tblsearch "BLOCK" "diem_cam"))
(taoblock)
)
;==========================================================================
(prompt "chon doi tuong:")
(mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
)

- nhoc test nó cứ sót điểm cuối với line, line đơn thì ko insert đc điểm 11, còn nối tiếp thì ko đc điểm cuối cùng, pline ok

- chạy xong nó cứ báo lỗi này

Command: RAIB hcon doi tuong:
Select objects: Specify opposite corner: 3 found
Select objects:  Application ERROR: Invalid entity/point list.
Application ERROR: Invalid entity/point list.
Application ERROR: Invalid entity/point list.
((nil T) (nil T) (nil T))
 

- hàm getp nhoc mượn của anh nhưng nhoc chưa hiểu lắm, có thể là do hàm này nhoc chỉnh lại sai ^^

 


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

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








#2011 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 18 October 2014 - 08:28 AM

Nhoc:

L1: nếu găp Pline thì không có dxf 11 >> nil.

L2: nếu gặp Line thì thiếu dxf 10.


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


#2012 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 October 2014 - 09:05 AM

- thanks a Ha, nãy giờ nhoc mò chỉnh lại cũng tạm đc rùi, nhưng con 1 vấn đề nhoc chưa pit làm thế nào, nếu là các line đơn lẽ thì ok, nhưng với các line nối liền nhau thì nó lại trả ra 2 điểm trùng nhau giữa mấu nối, nhoc hiểu là 11 của thằng này nhưng là 10 của thằng tiếp theo nên nó trả về 2 điểm giống nhau có cách nào loại bớt 1 thằng ko nhỉ

(defun getp(v / l1 l2 lst)
(setvar "cmdecho" 0)
    (if (= "LINE" (cdr (assoc 0 (entget v))))
     (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
	 )
	 (if (= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       )    
    (setq lst (append l1 l2))
    ;(mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) lst)

  )

- - tạm thời nhoc đóng thằng insert lại để kt lst cuối cùng trả về


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

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








#2013 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 18 October 2014 - 09:15 AM

Tạm thời chưa biết có hàm nào sẵn có làm việc này thì viết hàm con đi Nhóc !

Duyệt qua từng thằng (từ đầu đến cuối) >>> chuyển qua list mới nếu thằng này chưa có trong list mới , OK !


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#2014 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 October 2014 - 10:20 AM

- ý Hiep là dùng foreach hay mapcar + lambda nhỉ, duyệt từng thằng thằng nào = nhau thì loại ra ko add vào lst mới nữa phải ko Hiep,chiều về mò thử xem sao, giờ nhoc đi kím vài xị uống cafe ăn cơm ^^
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#2015 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 18 October 2014 - 10:28 AM

Ko phải là bằng nhau, mà gần như vậy:

Ta có lst1

Set lst2 = nil

Duyệt qua từng thằng trong lst1, thằng nào ko có: (not (member x lst2)) => (setq lst2 (cons x lst2))

==> đc lst2 là cái ta cần !


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#2016 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 October 2014 - 05:35 PM

ứ hự nhoc bí rùi @@, do lst trả về phức của phức nên lọc ra ko đc Hiep ơi   ^^

'( '((23 45) (34 23) (23 23) (34 45) (23 45)) )

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

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








#2017 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 October 2014 - 10:32 PM

- nhoc mò mẫn lại, làm đc tới đây rùi làm theo ý bạn Hiep gợi ý nhưng sao khi là line nối tiếp nhau nó vẫn bị dư 1 block ngay chỗ nối, vẫn ko loại đc phần tử giống nhau hix

- còn pline nếu nó ko khép bằng close mà khép = bắt điểm thì cũng bị dư 1 điểm, đặt thêm đk thế nào mấy anh nhỉ

- còn 2 e này nữa thui là tốt rùi mà ko ko biết xử sao, mấy anh vớt giúp nhoc ^^

(defun getp(v / l1 l2 l3)
(setvar "cmdecho" 0)
(cond 
    ((= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v)))))
	  (setq l3 nil)
	  (foreach x l1
	        (if (not (member x l3)) (setq l3 (cons x l3)))
		)
	  (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l3)
	)
	  
	((= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l2)
      )    
  )
    
)
;===============
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;========================================================================================
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;====================================================================================
(defun c:raib()
(setvar "osmode" 0)
;==================================================================
(defun taoblock ()
(vl-load-com)
(setvar "osmode" 0) (setvar "cmdecho" 0)
(if (null (tblsearch "layer" "diem-cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem-cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem-cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem-cam")))
(vl-cmdf "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)
(if (null (tblsearch "BLOCK" "diem_cam"))
(taoblock)
)
;==========================================================================
(prompt "chon doi tuong:")
(mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
(princ "\n")
(princ)
)
;============================


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

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








#2018 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 18 October 2014 - 11:22 PM

- nhoc mò mẫn lại, làm đc tới đây rùi làm theo ý bạn Hiep gợi ý nhưng sao khi là line nối tiếp nhau nó vẫn bị dư 1 block ngay chỗ nối, vẫn ko loại đc phần tử giống nhau hix

- còn pline nếu nó ko khép bằng close mà khép = bắt điểm thì cũng bị dư 1 điểm, đặt thêm đk thế nào mấy anh nhỉ

- còn 2 e này nữa thui là tốt rùi mà ko ko biết xử sao, mấy anh vớt giúp nhoc ^^

(defun getp(v / l1 l2 l3)
(setvar "cmdecho" 0)
(cond 
    ((= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v)))))
	  (setq l3 nil)
	  (foreach x l1
	        (if (not (member x l3)) (setq l3 (cons x l3)))
		)
	  (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l3)
	)
	  
	((= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l2)
      )    
  )
    
)
;===============
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;========================================================================================
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;====================================================================================
(defun c:raib()
(setvar "osmode" 0)
;==================================================================
(defun taoblock ()
(vl-load-com)
(setvar "osmode" 0) (setvar "cmdecho" 0)
(if (null (tblsearch "layer" "diem-cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem-cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem-cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem-cam")))
(vl-cmdf "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)
(if (null (tblsearch "BLOCK" "diem_cam"))
(taoblock)
)
;==========================================================================
(prompt "chon doi tuong:")
(mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
(princ "\n")
(princ)
)
;============================

Hề hề hề,

Nhóc hiểu sai gợi ý của bác hieptr rùi.

Việc loại bỏ các điểm trùng nhau phải thực hiện xong hoàn toàn mới tiến hành insert chứ. Nhóc làm như vầy thì cứ mỗi lần chọn line lại insert thì việc insert trùng là đương nhiên.

Nên tạo list l1 gồm đầy đủ các điểm đầu và cuối các line, sau đó tạo list l3 để loại trừ các điểm trùng nhau. Cuối cùng mới tạo một vòng lặp để insert theo các point thuộc l3

Với các lwpolyline, cũng nên có list l4 để loại các điểm trùng trong list l2 bởi với trường hợp vẽ lwpolyline kín bằng truy bắt điểm thì trong list l2 sẽ có thêm một điểm cuối trùng với điểm đầu tiên. Nhóc hãy thử vẽ các polyline như vậy và enget nó sẽ thấy điều này. Và cũng như với l3 việc iinsert chỉ nên thực hiện khi đã hoàn tất l4 của nhóc.

Chúc thành công.


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

#2019 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 19 October 2014 - 07:29 AM

Nhoclangbat nghiên cứu 3 hàm này của Lee Mac nhé!

(defun LM:_UniqueFuzz ( l fz )
    (if l
      (cons (car l)
        (LM:_UniqueFuzz
          (vl-remove-if '(lambda ( x ) (equal (acet-dxf 10 (entget x)) (acet-dxf 10 (entget (car l)))  fz)) (cdr l)) fz
        )
      )
    )
)


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


(defun LM:RemoveOnce ( l1 l2 )
  (if l1
    (if (equal (car l1) l2)
      (LM:RemoveOnce (cdr l1) l2)
      (cons (car l1) (LM:RemoveOnce (cdr l1) l2))
    )
  )
)





Sau khi có 3 hàm trên ta gộp lại

 

(defun TD:Remove-Point-duplicates (ss_list fz /  Lts1 Lts2 )
(vl-load-com)
(setq Lts1  (LM:_UniqueFuzz ss_list fz))
(setq Lts2 (LM:ListDifference ss_list Lts1))
(setq Lts3 (LM:RemoveOnce Lts1 ss_list))
(mapcar '(lambda (x) (entdel x)) Lts2)
Lts3
)

  • 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







#2020 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 19 October 2014 - 08:28 AM

- hi thanks a Duan với a Binh ^^, hnay thử ngồi dịch của ông leemac xem, chắc phê đây, dịch của a Tot không nhoc cũng trày trượt với nó rùi kaka


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

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