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.
Jin Yong

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

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

[Hỏi]

Các bác cho hỏi, trong Dialog của AutoLisp, thì có thể thay đổi cỡ chữ (Size) và Font chữ của các Label, danh sách, danh sách thả xuống, edit_box,... được không? nếu được thì cách làm như thế nào,

Hiện trong việc xử lý đối tượng: List_box, hoặc Popup_list chữ và Font hiện tại hơi nhỏ, mắt lại kém,. Mở rộng hơn, liệu có thể đổi màu chữ trong các đối tượng trên không?

xin 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

1- Lấy list các đỉnh thì chắc là bạn biết rồi.

2- Sort list theo Y trên 4R cũng nhiều.

3- Kết quả "Anh ở đầu sông, Em cuối sông".

  • 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

Chào các bác!

Em có viết một lisp để tạo nhiều Viewport hiển thị nội dung bên Model. Với số lượng Viewport ít thì OK không sao nhưng khi  số lượng Viewport lớn (50 chẳng hạn) thì các Viewport đầu bị mất và chỉ còn mấy Viewport cuối. Em không biết nguyên nhân tại sao nữa. Mong các bác giải thích và cho phương thức với ạ!

Cảm ơn các bác rất nhiều!

(defun C:99 (/	       CHCAO	 CHNGANG   I	     N
	     PNTDONGNAM		 PNTTAYBAC PNT_CHEN  PNT_I
	     PNT_I+1
	    )
  (vl-load-com)
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar 'TILEMODE 0)
  (setq	Pnt_Chen
	 (getpoint
	   "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n khung: "
	 )
  )
  (setq n (getint "\nNhap so Viewport: "))
  (setq ChCao 400.0)
  (setq ChNgang 350.0)
  (setq i 0)
  (vl-cmdf "Zoom" "E")
  (while (< i n)
    (setq Pnt_i (polar Pnt_Chen 0 (* i 800.0)))
    (setq Pnt_i+1 (polar Pnt_Chen 0 (* (+ i 1) 400.0)))
    (setq PntTayBac (polar Pnt_i (/ pi 2) 400.0))
    (setq PntDongNam (polar Pnt_i 0 350.0))
    (vl-cmdf "Zoom" "W" PntTayBac PntDongNam)
    (vl-cmdf "Mview" PntTayBac PntDongNam)
    (vl-cmdf "MSpace")
    (vl-cmdf "Zoom" "E")
    (vl-cmdf "PSpace")
    (vl-cmdf "PAN" Pnt_i Pnt_i+1)
    (setq i (1+ i))
  )
  (vl-cmdf "Zoom" "E")
  (setvar "OSMODE" Olmode)
  (Princ)
)

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

Khả năng lỗi là do hiện tượng "nuốt lệnh". Đây là căn bệnh nghe lạ như virut Zika, nhưng bản chất là: trong quá trình lặp, nhiều khi một lệnh nào đó bị "nuốt" - tức là chưa kịp thực hiện lệnh thì đã bị lệnh kế tiếp nhảy vào.

Hàm (command "zoom"...) khi dùng trong vòng lặp hay gặp bệnh này.

Thử thay tất cả (cômand "zoom"...) bằng các (vla-Zoom...) xem sao.

Dự là xử được!

P/S: máy bác chạy ngọt, thử 500 đếm đủ 501.

  • 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

Khả năng lỗi là do hiện tượng "nuốt lệnh". Đây là căn bệnh nghe lạ như virut Zika, nhưng bản chất là: trong quá trình lặp, nhiều khi một lệnh nào đó bị "nuốt" - tức là chưa kịp thực hiện lệnh thì đã bị lệnh kế tiếp nhảy vào.

Hàm (command "zoom"...) khi dùng trong vòng lặp hay gặp bệnh này.

Thử thay tất cả (cômand "zoom"...) bằng các (vla-Zoom...) xem sao.

Dự là xử được!

P/S: máy bác chạy ngọt, thử 500 đếm đủ 501.

Cháu đã thử nhưng vẫn bị mất bác ạ! Bác cho cháu xin chút code tham khảo được không ạ?

Cháu cảm ơn bác!

 

Cháu sửa.

(defun C:99 (/	       CHCAO	 CHNGANG   I	     N
	     PNTDONGNAM		 PNTTAYBAC PNT_CHEN  PNT_I
	     PNT_I+1
	    )
  (vl-load-com)
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar 'TILEMODE 0)
  (setq	Pnt_Chen
	 (getpoint
	   "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n khung: "
	 )
  )
  (setq n 50);;; (getint "\nNhap so Viewport: "))
  (setq ChCao 400.0)
  (setq ChNgang 350.0)
  (setq i 0)
  (vla-ZoomExtents (vlax-get-acad-object))
  (while (< i n)
    (setq Pnt_i (polar Pnt_Chen 0 (* i 800.0)))
    (setq Pnt_i+1 (polar Pnt_Chen 0 (* (+ i 1) 400.0)))
    (setq PntTayBac (polar Pnt_i (/ pi 2) 400.0))
    (setq PntDongNam (polar Pnt_i 0 350.0))
    (vla-ZoomWindow (vlax-get-acad-object) (vlax-3d-point PntTayBac) (vlax-3d-point PntDongNam))
    (vl-cmdf "Mview" PntTayBac PntDongNam)
    (vl-cmdf "MSpace")
    (vla-ZoomExtents (vlax-get-acad-object))
    (vl-cmdf "PSpace")
    (vl-cmdf "PAN" Pnt_i Pnt_i+1)
    (setq i (1+ i))
  )
  (vla-ZoomExtents (vlax-get-acad-object))
  (setvar "OSMODE" Olmode)
  (Princ)
)

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

Hình như tối đa view được 64 VP, biến hệ thống => MAXACTVP

Cảm ơn bác nhiều!

Em đã giải quyết xong vấn đề.

(setvar "MAXACTVP" 64)

Của em lúc đầu bằng 16 nên toàn bị mất khi tạo Mview.

Nếu nhiều Mview hơn 64 em tạo ra các Layout và chia đều Mview vào trong đó.

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

Mặc dù đã set biến MAXACTVP là 64 nhưng đôi khi vẫn bị mất view khi kết thúc lệnh

Vì vậy thêm câu lệnh này để hiện tất cả các viewport nhé

"setq drawing (vla-get-activedocument (vlax-get-acad-object)))

(vla-Regen drawing acAllViewports)

 

:D

  • 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

Cảm ơn bác nhiều!

Em đã giải quyết xong vấn đề.

(setvar "MAXACTVP" 64)

Của em lúc đầu bằng 16 nên toàn bị mất khi tạo Mview.

Nếu nhiều Mview hơn 64 em tạo ra các Layout và chia đều Mview vào trong đó.

Set 64 vẫn tạo 500 cái ngon ơ nhé!

  • 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

Mặc dù đã set biến MAXACTVP là 64 nhưng đôi khi vẫn bị mất view khi kết thúc lệnh

Vì vậy thêm câu lệnh này để hiện tất cả các viewport nhé

"setq drawing (vla-get-activedocument (vlax-get-acad-object)))

(vla-Regen drawing acAllViewports)

 

:D

 

Dạ không được bác ạ! Chỉ tối đa 64 Viewport.

 

 

Set 64 vẫn tạo 500 cái ngon ơ nhé!

Ơ thế ạ! Cháu chỉ tạo dc 64 cái. Các viewport mất. @@

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

Dạ không được bác ạ! Chỉ tối đa 64 Viewport.

 

Đúng là chỉ tạo được 64 view nhưng khi bác tạo từng view một theo câu lệnh lisp, nếu không dùng lệnh regen theo câu lệnh như trên thì kết thúc lệnh autolisp thì sẽ mất 1 số view không thấy nhé

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

Các bác cho em hỏi chút ạ!

Em có 1 tập điểm Point (gọi là LtsAll), sau khi em Sort tọa độ Y giảm dần thì em thao tác như sau:

Lấy tọa độ Y thằng có tọa độ Y lớn nhất cộng trừ với 1 gia số a chẳng hạn, tất cả thằng tọa độ nào có Y nằm trong (Ymax-a; Ymax+a) thì lấy nó ra cho vào 1 list (gọi là lts1).

Sau đó loại bỏ lts1 ra khỏi LtsAll (ta được lts2).

Lại Sort lts2 lấy ra dc Ymax và lại tiếp tục vòng lặp cho đến khi không con phần tử nào nữa. Em đã làm được điều này nhưng chưa biết cách chặn điểm dừng của vòng lặp. Mong các bác chỉ dùng em cách thức với ạ.

Cảm ơn các bác nhiều!

(defun C:90 (/ ENDYP I K LSTOBJ	LTS1 LTS2 LTSPOINT LTS_SORTY_REDUCE P
	     POINTFINAL	STARTYP	STEP Flag
	    )
  (setq	i      0
	Step   10.0
	LstObj (LM:ss->ent (ssget (list (cons 0 "POINT"))))
  )
  (repeat (length LstObj)
    (setq LtsPoint
	   (cons (cdr (assoc 10 (entget (nth i LstObj))))
		 LtsPoint
	   )
	  i (1+ i)
    )
  )
  (setq
    Lts_sortY_Reduce
     (vl-sort
       LtsPoint
       (function
	 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
       )
     )
  )
  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
  (setq EndYP (cadr (last Lts_sortY_Reduce)))
  (setq Lts2 (list))
  (setq Lts_sortY_Reduce (TD:LM:RemoveItems Lts1 Lts_sortY_Reduce))
  (setq Flag T)
  (while Flag
    (progn
      (if (>= StartYP EndYP)
	(progn
	  (setq
	    Lts_sortY_Reduce
	     (vl-sort
	       Lts_sortY_Reduce
	       (function
		 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
	       )
	     )
	  )
	  (setq k 0)
	  (setq Lts1 (list))
	  (while (< k (- (length Lts_sortY_Reduce) 1))
	    (if
	      (and
		(<= (cadr (nth k Lts_sortY_Reduce))
		    (+ StartYP (* Step 0.5))
		)
		(> (cadr (nth k Lts_sortY_Reduce))
		   (- StartYP (* Step 0.5))
		)
	      )
	       (progn
		 (setq p
			(list (car (nth k Lts_sortY_Reduce))
			      (cadr (nth k Lts_sortY_Reduce))
			)
		 )
		 (setq Lts1 (append Lts1 (list p)))
	       )
	    )
	    (setq k (1+ k))
	  )
	  (setq
	    Lts1
	     (vl-sort
	       Lts1
	       (function (lambda (e1 e2) (< (car e1) (car e2))))
	     )
	  )
	  (setq	Lts_sortY_Reduce
		 (TD:LM:RemoveItems
		   Lts1
		   Lts_sortY_Reduce
		 )
	  )
	  (setq Lts2 (append Lts2 Lts1))
	)
	(Progn
	  (setq Flag nil)
	  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
	)
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
;;;;;;(TD:LM:RemoveItems  '(2 4 6) '(1 2 3 4 5 6 7 8))
(defun TD:LM:RemoveItems (items lst / i items1)
  (setq i -1)
  (setq items1 (mapcar '(lambda (x) (vl-position x lst)) items))
  (vl-remove-if '(lambda (x) (member (setq i (1+ i)) items1)) lst)
)

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

 

Các bác cho em hỏi chút ạ!

Em có 1 tập điểm Point (gọi là LtsAll), sau khi em Sort tọa độ Y giảm dần thì em thao tác như sau:

Lấy tọa độ Y thằng có tọa độ Y lớn nhất cộng trừ với 1 gia số a chẳng hạn, tất cả thằng tọa độ nào có Y nằm trong (Ymax-a; Ymax+a) thì lấy nó ra cho vào 1 list (gọi là lts1).

Sau đó loại bỏ lts1 ra khỏi LtsAll (ta được lts2).

Lại Sort lts2 lấy ra dc Ymax và lại tiếp tục vòng lặp cho đến khi không con phần tử nào nữa. Em đã làm được điều này nhưng chưa biết cách chặn điểm dừng của vòng lặp. Mong các bác chỉ dùng em cách thức với ạ.

Cảm ơn các bác nhiều!

(defun C:90 (/ ENDYP I K LSTOBJ	LTS1 LTS2 LTSPOINT LTS_SORTY_REDUCE P
	     POINTFINAL	STARTYP	STEP Flag
	    )
  (setq	i      0
	Step   10.0
	LstObj (LM:ss->ent (ssget (list (cons 0 "POINT"))))
  )
  (repeat (length LstObj)
    (setq LtsPoint
	   (cons (cdr (assoc 10 (entget (nth i LstObj))))
		 LtsPoint
	   )
	  i (1+ i)
    )
  )
  (setq
    Lts_sortY_Reduce
     (vl-sort
       LtsPoint
       (function
	 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
       )
     )
  )
  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
  (setq EndYP (cadr (last Lts_sortY_Reduce)))
  (setq Lts2 (list))
  (setq Lts_sortY_Reduce (TD:LM:RemoveItems Lts1 Lts_sortY_Reduce))
  (setq Flag T)
  (while Flag
    (progn
      (if (>= StartYP EndYP)
	(progn
	  (setq
	    Lts_sortY_Reduce
	     (vl-sort
	       Lts_sortY_Reduce
	       (function
		 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
	       )
	     )
	  )
	  (setq k 0)
	  (setq Lts1 (list))
	  (while (< k (- (length Lts_sortY_Reduce) 1))
	    (if
	      (and
		(<= (cadr (nth k Lts_sortY_Reduce))
		    (+ StartYP (* Step 0.5))
		)
		(> (cadr (nth k Lts_sortY_Reduce))
		   (- StartYP (* Step 0.5))
		)
	      )
	       (progn
		 (setq p
			(list (car (nth k Lts_sortY_Reduce))
			      (cadr (nth k Lts_sortY_Reduce))
			)
		 )
		 (setq Lts1 (append Lts1 (list p)))
	       )
	    )
	    (setq k (1+ k))
	  )
	  (setq
	    Lts1
	     (vl-sort
	       Lts1
	       (function (lambda (e1 e2) (< (car e1) (car e2))))
	     )
	  )
	  (setq	Lts_sortY_Reduce
		 (TD:LM:RemoveItems
		   Lts1
		   Lts_sortY_Reduce
		 )
	  )
	  (setq Lts2 (append Lts2 Lts1))
	)
	(Progn
	  (setq Flag nil)
	  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
	)
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
;;;;;;(TD:LM:RemoveItems  '(2 4 6) '(1 2 3 4 5 6 7 8))
(defun TD:LM:RemoveItems (items lst / i items1)
  (setq i -1)
  (setq items1 (mapcar '(lambda (x) (vl-position x lst)) items))
  (vl-remove-if '(lambda (x) (member (setq i (1+ i)) items1)) lst)
)

Thử thay (while Flag ....

bằng (while (>(length Lts_sortY_Reduce) 0) 

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

Thử thay (while Flag ....

bằng (while (>(length Lts_sortY_Reduce) 0) 

Em đã thử rất nhiều kiểu rồi nhưng máy vẫn đơ do ko kiểm soát dc vòng lặp

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

Em đã thử rất nhiều kiểu rồi nhưng máy vẫn đơ do ko kiểm soát dc vòng lặp

Sao lisp phức tạp thế nhỉ??? Thử cái này xem sao:

(defun loai_lst  (/ lst)

  (setq lst (list '(5 6) '(1 2) '(2 3) '(8 10) '(6 7) '(3 4) '(4 5))

           a  2)

  (while lst

    (setq lst (vl-sort lst '(lambda (p1 p2) (> (cadr p1) (cadr p2)))))

    (princ lst)

    (princ "\n........................\n")

    (setq lst (vl-remove-if '(lambda (x) (<= (- (cadar lst) a) (cadr x))) lst))))

  • 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

Thanhduan đặt câu hỏi tối nghĩa dễ sợ. Nếu cứ duyệt cho đến khi lstAll nil thì chỉ cần 1 dòng (setq lstAll nil) !!!!!!

Chắc là muốn lisp trả về (list lst1 lst2 ... lstn) ????? Nếu đúng vậy thì chỉ cần vài dòng thô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

Thanhduan đặt câu hỏi tối nghĩa dễ sợ. Nếu cứ duyệt cho đến khi lstAll nil thì chỉ cần 1 dòng (setq lstAll nil) !!!!!!

Chắc là muốn lisp trả về (list lst1 lst2 ... lstn) ????? Nếu đúng vậy thì chỉ cần vài dòng thôi.

Cảm ơn bác Quocmanh04tt đã gợi ý.

Cảm ơn bác Hạ.

Thực ra cháu chỉ hỏi 1 cách thức trong bài toán của cháu, các hàm "thừa" ko phải thừa đâu ạ, nó có tác dụng về sau nữa nên cháu để như vậy.

Cháu đã gần xong bài toán sau gợi ý rồi. Hii

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

 

Các bác cho em hỏi chút ạ!

Em có 1 tập điểm Point (gọi là LtsAll), sau khi em Sort tọa độ Y giảm dần thì em thao tác như sau:

Lấy tọa độ Y thằng có tọa độ Y lớn nhất cộng trừ với 1 gia số a chẳng hạn, tất cả thằng tọa độ nào có Y nằm trong (Ymax-a; Ymax+a) thì lấy nó ra cho vào 1 list (gọi là lts1).

Sau đó loại bỏ lts1 ra khỏi LtsAll (ta được lts2).

Lại Sort lts2 lấy ra dc Ymax và lại tiếp tục vòng lặp cho đến khi không con phần tử nào nữa. Em đã làm được điều này nhưng chưa biết cách chặn điểm dừng của vòng lặp. Mong các bác chỉ dùng em cách thức với ạ.

Cảm ơn các bác nhiều!

(defun C:90 (/ ENDYP I K LSTOBJ	LTS1 LTS2 LTSPOINT LTS_SORTY_REDUCE P
	     POINTFINAL	STARTYP	STEP Flag
	    )
  (setq	i      0
	Step   10.0
	LstObj (LM:ss->ent (ssget (list (cons 0 "POINT"))))
  )
  (repeat (length LstObj)
    (setq LtsPoint
	   (cons (cdr (assoc 10 (entget (nth i LstObj))))
		 LtsPoint
	   )
	  i (1+ i)
    )
  )
  (setq
    Lts_sortY_Reduce
     (vl-sort
       LtsPoint
       (function
	 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
       )
     )
  )
  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
  (setq EndYP (cadr (last Lts_sortY_Reduce)))
  (setq Lts2 (list))
  (setq Lts_sortY_Reduce (TD:LM:RemoveItems Lts1 Lts_sortY_Reduce))
  (setq Flag T)
  (while Flag
    (progn
      (if (>= StartYP EndYP)
	(progn
	  (setq
	    Lts_sortY_Reduce
	     (vl-sort
	       Lts_sortY_Reduce
	       (function
		 (lambda (e1 e2) (> (cadr e1) (cadr e2)))
	       )
	     )
	  )
	  (setq k 0)
	  (setq Lts1 (list))
	  (while (< k (- (length Lts_sortY_Reduce) 1))
	    (if
	      (and
		(<= (cadr (nth k Lts_sortY_Reduce))
		    (+ StartYP (* Step 0.5))
		)
		(> (cadr (nth k Lts_sortY_Reduce))
		   (- StartYP (* Step 0.5))
		)
	      )
	       (progn
		 (setq p
			(list (car (nth k Lts_sortY_Reduce))
			      (cadr (nth k Lts_sortY_Reduce))
			)
		 )
		 (setq Lts1 (append Lts1 (list p)))
	       )
	    )
	    (setq k (1+ k))
	  )
	  (setq
	    Lts1
	     (vl-sort
	       Lts1
	       (function (lambda (e1 e2) (< (car e1) (car e2))))
	     )
	  )
	  (setq	Lts_sortY_Reduce
		 (TD:LM:RemoveItems
		   Lts1
		   Lts_sortY_Reduce
		 )
	  )
	  (setq Lts2 (append Lts2 Lts1))
	)
	(Progn
	  (setq Flag nil)
	  (setq StartYP (cadr (nth 0 Lts_sortY_Reduce)))
	)
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
;;;;;;(TD:LM:RemoveItems  '(2 4 6) '(1 2 3 4 5 6 7 8))
(defun TD:LM:RemoveItems (items lst / i items1)
  (setq i -1)
  (setq items1 (mapcar '(lambda (x) (vl-position x lst)) items))
  (vl-remove-if '(lambda (x) (member (setq i (1+ i)) items1)) lst)
)
(defun f (l / r y)
  (setq l (vl-sort l (function (lambda (a b) (>= (cadr a) (cadr b))))))
  (while l
     (setq y (apply (function max) (mapcar (function cadr) l)))
     (setq r (cons (vl-remove-if-not (function (lambda (a) (equal (cadr a) y 1.))) l) r))
     (foreach a (car r) (setq l (vl-remove a l)))
  )
  (reverse r)
)

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


(defun f (l / r y)
(setq l (vl-sort l (function (lambda (a b) (>= (cadr a) (cadr b))))))
(while l
(setq y (apply (function max) (mapcar (function cadr) l)))
(setq r (cons (vl-remove-if-not (function (lambda (a) (equal (cadr a) y 1.))) l) r))
(foreach a (car r) (setq l (vl-remove a l)))
)
(reverse r)
)


(defun f1 (l / r y)
(setq l (vl-sort l (function (lambda (a b) (>= (cadr a) (cadr b))))))
(while l
(setq y (cadar l))
(setq r (cons (vl-remove-if-not (function (lambda (a) (equal (cadr a) y 1.))) l) r))
(foreach a (car r) (setq l (vl-remove a l)))
)
(reverse r)
)
  • 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

 

(defun f1 (l / r y)
  (setq l (vl-sort l (function (lambda (a b) (>= (cadr a) (cadr b))))))
  (while l
     (setq y (cadar l))
     (setq r (cons (vl-remove-if-not (function (lambda (a) (equal (cadr a) y 1.))) l) r))
     (foreach a (car r) (setq l (vl-remove a l)))
  )
  (reverse r)
)

Cảm ơn bác. Em đã làm xong rồi. Hàm của bác rất hay.

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

(defun f2 (l / r r1 y)
(setq l (vl-sort l (function (lambda (a b) (>= (cadr a) (cadr b))))))
(while (setq y (cadar l))
(while (equal y (cadar l) 1.)
(setq r1 (cons (car l) r1)
l (cdr l))
)
(setq r (cons (reverse r1) r)
r1 nil)
)
(reverse r)
)

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

Chào mọi người. Em có 1 yêu cầu cần giúp đỡ như sau:

- Em có list ban đầu ((5 (a1 a2 a4) ) (10 (b1 b3 b4))  (5 (a3)))

- Và e cần kết quả như sau: ((5 (a1 a2 a4 a3)) (10 (b1 b3 b4))).

Cho hỏi là có hàm nào thực hiện đc như trên ko a?

Thank.

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


×