[Nhờ giúp đỡ] lisp tìm trắc ngang

Tháng 7 31, 2014

Mình đang tập tành viết mấy ứng dụng nhỏ giúp cho công việc của mình là chủ yếu. Đang viết lisp tìm trắc ngang nhưng không chạy được nhờ mọi người giúp đỡ.

Nội dung lisp như sau

A. chọn đối tượng để làm lớp chuẩn, sau đó chương trình tự lọc được 2 tập hợp (cái này mình đã làm được)

1. tập tên cọc

2. tập lý trình

Sau đó sẽ ghép tập "tên cọc" và tập "lý trình" lại với nhau (cái này mình cũng làm được rồi)

vấn đề đang vướng mắc là tạo 1 danh sách để đưa vào 1 popup_list (cái này viết đang bị lỗi ở đâu đó không hiểu)

đây là lisp đang viết:

(defun C:timc (/ datalist)
(defun sosanh (e1 e2 / p1 p2)
	(setq p1 (car e1)
		p2 (car e2)
	)
	(if (equal (cadr p1) (cadr p2) 1e-8)
		(< (car p1) (car p2))
		(> (cadr p1) (cadr p2))
	)
	)
(prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
(setq dtltc (car (entsel)))
(setq lop1 (cdr (assoc 8 (entget dtltc))))
(setq danhsachc (acet-ss-to-list (ssget "X" (list (cons 8 lop1) (cons 1 "C*")))))
(setq danhsachkm (acet-ss-to-list (ssget "X" (list (cons 8 lop1) (cons 1 "K*")))))
(setq coc (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) danhsachc))
(setq km (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
(setq coc (vl-sort coc 'sosanh))
(setq km (vl-sort km 'sosanh))
(if (/= (length coc) (length km))
  (alert "Yeu cau so luong 'coc' & 'Ly trinh' phai bang nhau!")
  (progn
   (foreach ent1 coc
	(setq pt1 (car ent1))
	(setq dis (* 2 (distance pt1 (car (nth 0 km)))))
	(foreach ent2 km
	(setq pt2 (car ent2))
	(if (< (distance pt1 pt2) dis)
  	(setq dis (distance pt1 pt2) ent3 ent2)))
	(if (null datalist)
	(setq datalist (strcat (cdr ent1) "-" (cdr ent3)))
	(setq datalist (cons datalist (strcat (cdr ent1) "-" (cdr ent3))))
	)
	)
   )
   )
(setq DCL_ID (load_dialog (strcat odiachay "\\tlkt\\dcl\\Xuat_bang_tinh2.DCL")))
(new_dialog "Ha1" DCL_ID)
(start_list "tn")
(mapcar 'add_list datalist)
(end_list)
(set_tile "tn" (itoa (vl-position numside datalist)))
(action_tile "tn" "(setq numside (nth (atoi $value) datalist))")
(action_tile "btn_tim" "(done_dialog 1)")
(action_tile "btn_thoat" "(done_dialog 14)")
(setq phepchon (start_dialog))
(cond 
      ((= phepchon 1) (thoi))
      ((= phepchon 14) (thoi))
 )
 	(princ)
  )

đây là file DCL

//-----
Ha1 : dialog {
	label = "TIM TRAC NGANG - TRAC DOC";
 : column {
  	  fixed_width = true;
        alignment = centered;
 	  width = 0;
 	: boxed_column {
	  label = "TRAC_NGANG";
	  fixed_width = true;
	: popup_list {key = "tn";label = "Ten coc - Ly trinh";width = 20;fixed_width_font = false;}
}
: boxed_column {
	  label = "TRAC_DOC";
	  fixed_width = true;
	: popup_list {key = "td";label = "Ten coc - Ly trinh";width = 20;fixed_width_font = false;}
}
}
   : row {
        fixed_width = true;
        alignment = centered;
        : default_button {
       is_cancel  = true;
            label = "Tim";
            key = "btn_tim";
            width = 8;
        }
    : row {
        fixed_width = true;
        alignment = centered;
        : button {
       is_cancel  = true;
            label = "Thoat";
            key = "btn_thoat";
            width = 8;
        }
}


    }
}

đây là file thử nghiệm

http://www.cadviet.com/upfiles/3/66960_tdt_ok.rar

Tháng 7 31, 2014

Có 3 chỗ cần sửa:

1. Đoạn có datalist phải viết là

(if (null datalist)
 (setq datalist (list (strcat (cdr ent1) "-" (cdr ent3))))
 (setq datalist (append datalist (list (strcat (cdr ent1) "-" (cdr ent3)))  ))
)

2. Cái biến numside ở đâu ra mà không khai báo nên đoạn này bị lỗi

(set_tile "tn" (itoa (vl-position numside datalist)))

Bạn phải "thòng" thêm 1 cái if : (if numside (set_tile "tn" (itoa (vl-position numside datalist))))

3. Phải có (if (< 0 DCL_ID) (unload_dialog DCL_ID))

(if (null datalist)

(setq datalist (list (strcat (cdr ent1) "-" (cdr ent3))))

(setq datalist (append datalist (list (strcat (cdr ent1) "-" (cdr ent3))) ))

Tháng 7 31, 2014

Cám ơn ban Tot77 nhiều, để tôi sửa lại có chi sai nhờ bạn giúp tiếp nhé

Chúc 1 buổi tối vui vẽ

Tháng 7 31, 2014

Cám ơn ban Tot77 nhiều, để tôi sửa lại có chi sai nhờ bạn giúp tiếp nhé

Chúc 1 buổi tối vui vẽ

bạn sửa xong check thấy oke thì up lisp hoàn chỉnh lên nhé, mình cũng đang cần lisp như này, thanks :)

Tháng 8 1, 2014

bạn sửa xong check thấy oke thì up lisp hoàn chỉnh lên nhé, mình cũng đang cần lisp như này, thanks :)

Mình đã làm xong rồi (chỉ tìm trắc ngang) nhưng có mấy hàm chạy trong bộ lisp và còn muốn viết thêm mấy cái nữa

Nếu bạn biết 1 tí về lisp thì sửa để chạy nhé

đây là lisp mới sửa tối qua

(defun C:timc (/ datalist)
(defun sosanh (e1 e2 / p1 p2)
	(setq p1 (car e1)
		p2 (car e2)
	)
	(if (equal (cadr p1) (cadr p2) 1e-8)
		(< (car p1) (car p2))
		(> (cadr p1) (cadr p2))
	)
	)
(prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
(setq dtltc (car (entsel)))
(setq lop1 (cdr (assoc 8 (entget dtltc))))
(setq danhsachc (acet-ss-to-list (ssget "X" (list (cons 8 lop1) (cons 1 "C*")))))
(setq danhsachkm (acet-ss-to-list (ssget "X" (list (cons 8 lop1) (cons 1 "K*")))))
(setq coc (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) danhsachc))
(setq km (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
(setq coc (vl-sort coc 'sosanh))
(setq km (vl-sort km 'sosanh))
(if (/= (length coc) (length km))
  (alert "Yeu cau so luong 'coc' & 'Ly trinh' phai bang nhau!")
  (progn
   (foreach ent1 coc
	(setq pt1 (car ent1))
	(setq dis (* 2 (distance pt1 (car (nth 0 km)))))
	(foreach ent2 km
	(setq pt2 (car ent2))
	(if (< (distance pt1 pt2) dis)
  	(setq dis (distance pt1 pt2) ent3 ent2)))
	(if (null datalist)
	(setq datalist (list (strcat (cdr ent1) "-" (cdr ent3))))
	(setq datalist (append datalist (list (strcat (cdr ent1) "-" (cdr ent3)))))
	))))
(setq numside (nth 0 datalist))
(setq DCL_ID (load_dialog (strcat odiachay "\\tlkt\\dcl\\Xuat_bang_tinh2.DCL")))
(new_dialog "Ha1" DCL_ID)
(start_list "tn")
(mapcar 'add_list datalist)
(end_list)
(set_tile "tn" (itoa (vl-position numside datalist)))
(action_tile "tn" "(setq numside (nth (atoi $value) datalist))")
(action_tile "btn_tim" "(done_dialog 1)")
(action_tile "btn_thoat" "(done_dialog 14)")
(setq phepchon (start_dialog))
(cond 
      ((= phepchon 1) (tim))
      ((= phepchon 14) (thoi))
 )
 (if (< 0 DCL_ID) (unload_dialog DCL_ID))
 	(princ)
  )
(defun tim ()
(vl-load-com)
(setq vitri (VL-STRING-POSITION 75 numside))
(setq kmtim (SUBSTR numside (+ vitri 1)))
(foreach ent2 km
(if (= (cdr ent2) kmtim)
(setq point (car ent2))
))
(command "ZOOM" "c" point 25)
)

đây là DCL

//-----
Ha1 : dialog {
	label = "TIM TRAC NGANG - TRAC DOC";
 : column {
  	  fixed_width = true;
        alignment = centered;
 	  width = 0;
 	: boxed_column {
	  label = "TRAC_NGANG";
	  fixed_width = true;
	: popup_list {key = "tn";label = "Ten coc - Ly trinh";width = 45;fixed_width_font = false;}
}
: boxed_column {
	  label = "TRAC_DOC";
	  fixed_width = true;
	: popup_list {key = "td";label = "Ten coc - Ly trinh";width = 45;fixed_width_font = false;}
}
}
   : row {
        fixed_width = true;
        alignment = centered;
        : default_button {
       is_cancel  = true;
            label = "Tim";
            key = "btn_tim";
            width = 8;
        }
    : row {
        fixed_width = true;
        alignment = centered;
        : button {
       is_cancel  = true;
            label = "Thoat";
            key = "btn_thoat";
            width = 8;
        }
}


    }
}

Bạn dùng thử cho ý kiếm

Tháng 8 1, 2014

Có 3 chỗ cần sửa:

1. Đoạn có datalist phải viết là
(if (null datalist)
 (setq datalist (list (strcat (cdr ent1) "-" (cdr ent3))))
 (setq datalist (append datalist (list (strcat (cdr ent1) "-" (cdr ent3)))  ))
)
2. Cái biến numside ở đâu ra mà không khai báo nên đoạn này bị lỗi

(set_tile "tn" (itoa (vl-position numside datalist)))

Bạn phải "thòng" thêm 1 cái if : (if numside (set_tile "tn" (itoa (vl-position numside datalist))))

3. Phải có (if (< 0 DCL_ID) (unload_dialog DCL_ID))

(if (null datalist)

(setq datalist (list (strcat (cdr ent1) "-" (cdr ent3))))

(setq datalist (append datalist (list (strcat (cdr ent1) "-" (cdr ent3))) ))

Đã sửa chạy được rồi bạn, nhưng có 1 vướng mắc nữa nhờ bạn giúp đở

bây giờ datalist có dạng như sau:

"Cäc:66-Km:23+247.94" "Cäc:98-Km:23+840.78" "Cäc:23A-Km20+936.33" "Cäc:47-Km22+975.64" "Cäc:H8-Km21+800" "Cäc:67-Km:23+256.21" "Cäc:99-Km:23+846.72" "Cäc:24-Km20+940.61" "Cäc:48-Km22+988.92" "Cäc:76-Km21+812.77" "Cäc:68-Km:23+266.01" "Cäc:99A-Km:23+855.51" "Cäc:24A-Km20+946.27" "Cäc:KM23-Km23+00" "Cäc:TD58-Km21+824.25" "Cäc:69-Km:23+278.90" "Cäc:200-Km:23+862" "Cäc:25-Km20+955.49" "Cäc:76A-Km21+832.97" "Cäc:TC62-Km:23+284.18" "Cäc:1-Km:23+870" "Cäc:26-Km20+966.14" "Cäc:77-Km21+838.87" "Cäc:69A-Km:23+292.90" "Cäc:1A-Km:23+877.60" "Cäc:TD55-Km20+975.76" "Cäc:78-Km21+851.31" "Cäc:H3-Km:23+300" "Cäc:2-Km:23+885" "Cäc:27-Km20+985.28" "Cäc:P58-Km21+858.73"

Bây giờ muốn sắp xếp theo lý trình tăng dần nhờ bạn người trợ giúp

"Cäc:66-Km:23+247.94" "Cäc:98-Km:23+840.78" "Cäc:23A-Km20+936.33"

"Cäc:47-Km22+975.64" "Cäc:H8-Km21+800" "Cäc:67-Km:23+256.21"

"Cäc:99-Km:23+846.72" "Cäc:24-Km20+940.61" "Cäc:48-Km22+988.92"

"Cäc:76-Km21+812.77" "Cäc:68-Km:23+266.01" "Cäc:99A-Km:23+855.51"

"Cäc:24A-Km20+946.27" "Cäc:KM23-Km23+00" "Cäc:TD58-Km21+824.25"

"Cäc:69-Km:23+278.90" "Cäc:200-Km:23+862" "Cäc:25-Km20+955.49"

"Cäc:76A-Km21+832.97" "Cäc:TC62-Km:23+284.18" "Cäc:1-Km:23+870"

"Cäc:26-Km20+966.14" "Cäc:77-Km21+838.87" "Cäc:69A-Km:23+292.90"

"Cäc:1A-Km:23+877.60" "Cäc:TD55-Km20+975.76" "Cäc:78-Km21+851.31"