Chuyển đến nội dung
Diễn đàn CADViet
huunhantvxdts

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

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

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

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ó 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)))  ))
  • 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 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 :)

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

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

  • 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ó 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" 
 
"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: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: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" 
"Cäc:75-Km:23+384.12" "Cäc:6-Km:23+947.15" 
"Cäc:29A-Km21+46.30" "Cäc:83-Km21+933.26" "Cäc:75A-Km:23+390.12" 
"Cäc:7-Km:23+949.85" "Cäc:NC58-Km21+943.21" "Cäc:TC55-Km21+54.66" 
"Cäc:H4-Km:23+400" "Cäc:84-Km21+953.25" "Cäc:TD65-Km:23+953.45" 
"Cäc:85-Km21+961.86" "Cäc:30-Km21+59.50" "Cäc:ND63-Km:23+411.17" 
"Cäc:86-Km21+964.37" "Cäc:8-Km:23+960.45" "Cäc:87-Km21+976.54" 
"Cäc:31-Km21+72.44" "Cäc:75B-Km:23+417.63" "Cäc:ND59-Km21+983.38" 
"Cäc:9-Km:23+973.46" "Cäc:32-Km21+87.40" "Cäc:87A-Km21+991.98" 
"Cäc:76-Km:23+426.43" "Cäc:KM22-Km22+00" "Cäc:10-Km:23+982.47" 
"Cäc:H1-Km21+100" "Cäc:77-Km:23+439.89" "Cäc:11-Km:23+984.98" 
"Cäc:88-Km22+13.02" "Cäc:33-Km21+113.88" "Cäc:78-Km:23+449.53" 
"Cäc:88A-Km22+23.43" "Cäc:P65-Km:23+987.65" "Cäc:89-Km22+28.23" 
"Cäc:NC55-Km21+124.66" "Cäc:TD63-Km:23+461.17" "Cäc:89A-Km22+38.31" 
"Cäc:KM24-Km:24+00" "Cäc:TD59-Km22+43.38" "Cäc:33A-Km21+131.06" 
"Cäc:78A-Km:23+472.54" "Cäc:89B-Km22+50.43" "Cäc:12-Km:24+13.96" 
"Cäc:90-Km22+58.50" "Cäc:34-Km21+139.24" "Cäc:P63-Km:23+478.34" 
"Cäc:75-Km:23+384.12" "Cäc:6-Km:23+947.15" 
"Cäc:29A-Km21+46.30" "Cäc:83-Km21+933.26" "Cäc:75A-Km:23+390.12" 
"Cäc:7-Km:23+949.85" "Cäc:NC58-Km21+943.21" "Cäc:TC55-Km21+54.66" 
"Cäc:H4-Km:23+400" "Cäc:84-Km21+953.25" "Cäc:TD65-Km:23+953.45" 
"Cäc:85-Km21+961.86" "Cäc:30-Km21+59.50" "Cäc:ND63-Km:23+411.17" 
"Cäc:86-Km21+964.37" "Cäc:8-Km:23+960.45" "Cäc:87-Km21+976.54" 
"Cäc:31-Km21+72.44" "Cäc:75B-Km:23+417.63" "Cäc:ND59-Km21+983.38" 
"Cäc:9-Km:23+973.46" "Cäc:32-Km21+87.40" "Cäc:87A-Km21+991.98" 
"Cäc:76-Km:23+426.43" "Cäc:KM22-Km22+00" "Cäc:10-Km:23+982.47" 
"Cäc:H1-Km21+100" "Cäc:77-Km:23+439.89" "Cäc:11-Km:23+984.98" 
"Cäc:88-Km22+13.02" "Cäc:33-Km21+113.88" "Cäc:78-Km:23+449.53" 
"Cäc:88A-Km22+23.43" "Cäc:P65-Km:23+987.65" "Cäc:89-Km22+28.23" 
"Cäc:NC55-Km21+124.66" "Cäc:TD63-Km:23+461.17" "Cäc:89A-Km22+38.31" 
"Cäc:KM24-Km:24+00" "Cäc:TD59-Km22+43.38" "Cäc:33A-Km21+131.06" 
"Cäc:78A-Km:23+472.54" "Cäc:89B-Km22+50.43" "Cäc:12-Km:24+13.96" 
"Cäc:90-Km22+58.50" "Cäc:34-Km21+139.24" "Cäc:P63-Km:23+478.34" 

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

Nếu lý trình là cái số sau km thì bạn làm như sau (có thêm 1 hàm tìm lý trình)

 

(defun timlt(st / tm)
  (setq tm (vl-string->list (substr (strcase st) (+ 4 (vl-string-search "-KM" (strcase st))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(vl-sort datalist '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy))))))
 
  • Vote tăng 3

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ì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

sao mình load lisp, gõ lệnh timc, lisp yêu cầu kích chọn đối tượng, mình kích vào Km hoặc tên cọc thì lisp gi là "yêu cầu số lượng cọc & lý trình phải bằng nhau"

và cái file DCL dùng để làm gì thế bạn, mình không hiểu về lisp nên còn gà mờ lắm

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

 

Nếu lý trình là cái số sau km thì bạn làm như sau (có thêm 1 hàm tìm lý trình)

 

(defun timlt(st / tm)
  (setq tm (vl-string->list (substr (strcase st) (+ 4 (vl-string-search "-KM" (strcase st))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(vl-sort datalist '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy))))))

sao em load lisp và gõ lệnh timlt thì lisp chẳng hiện ra gì hết anh ạ

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

Nếu số lương cọc và số km khác nhau thì nó báo lỗi như trên.

Còn file dcl bạn chép về save thành file tên "Xuat_bang_tinh2.DCL" và đặt trong cùng thư mục file cad (hoặc trong support) và sửa cái lisp chỗ

(load_dialog (strcat odiachay "\\tlkt\\dcl\\Xuat_bang_tinh2.DCL")))

thành (load_dialog "Xuat_bang_tinh2.DCL")

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

Nhìn vào bản vẽ thì thấy các trắc ngang đã sắp xếp theo lý trình vì vậy trong hàm sapxep thay 1e-8 = 1 thì coc và km đã được sắp xếp.

Như vậy

1- Chỉ cần ghép lần lượt từng phần tử của coc và km  thì datalist đã được sắp xếp.

2- Trong hàm tim không cần phải tìm từng phần tử mà chỉ cần:

(setq point (car (nth (vl-position numside datalist) km)))

  • 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

Nếu lý trình là cái số sau km thì bạn làm như sau (có thêm 1 hàm tìm lý trình)

 

(defun timlt(st / tm)
  (setq tm (vl-string->list (substr (strcase st) (+ 4 (vl-string-search "-KM" (strcase st))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(vl-sort datalist '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy))))))
 

Quá đúng như yêu cầu của mình

cám ơn Bạn nhiều lắm

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

Nhìn vào bản vẽ thì thấy các trắc ngang đã sắp xếp theo lý trình vì vậy trong hàm sapxep thay 1e-8 = 1 thì coc và km đã được sắp xếp.

Như vậy

1- Chỉ cần ghép lần lượt từng phần tử của coc và km  thì datalist đã được sắp xếp.

2- Trong hàm tim không cần phải tìm từng phần tử mà chỉ cần:

(setq point (car (nth (vl-position numside datalist) km)))

Mình sửa lại theo ý bạn sao không tim đúng nhỉ

sửa lại như sau

(defun tim ()
(vl-load-com)
(setq vitri (VL-STRING-POSITION 75 numside))
(setq kmtim (SUBSTR numside (+ vitri 1)))
(setq point1 (car (nth (vl-position numside datalist) km)))
(command "ZOOM" "c" point1 25)
)

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

Bạn sửa trong hàm sosanh thay 1e-8 = 1

Trong hàm tim chỉ cần :

(defun tim ()
(setq point1 (car (nth (vl-position numside datalist) km)))
(command "ZOOM" "c" point1 25)
)

Hay ghép lại

(defun tim ()
(command "ZOOM" "c" (car (nth (vl-position numside datalist) km)) 25)
)

Tôi đã test OK trên máy tôi. Bạn post lại code hay bản vẽ chạy chưa đúng xem

  • 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

Bạn sửa trong hàm sosanh thay 1e-8 = 1

Trong hàm tim chỉ cần :

(defun tim ()

(setq point1 (car (nth (vl-position numside datalist) km)))

(command "ZOOM" "c" point1 25)

)

Hay ghép lại

(defun tim ()

(command "ZOOM" "c" (car (nth (vl-position numside datalist) km)) 25)

)

Tôi đã test OK trên máy tôi. Bạn post lại code hay bản vẽ chạy chưa đúng xem

Chạy đúng rồi bạn ơi 

Cám ơn bạn nhiều

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

Bây giờ muốn cải tiến thêm 1 tí nữa những không biết viết những trình điều kiển chúng nhờ mọi người giúp đỡ 

1. thêm 2 nút radio_button để chọn tìm trắc dọc hay trắc ngang

2. thêm 2 edit_box để nhập tên cọc hoặc lý trình để tìm (với mong muốn khi nhập tên cọc vào đây thì trên popup_list tự nhảy đến 

và đây là DCL mình đã tạo

//-----
Ha1 : dialog {
	label = "TIM TRAC NGANG - TRAC DOC";
 : row {
  	  fixed_width = true;
        alignment = centered;
 	  width = 0;
 	: boxed_column {
	  label = "TRAC_NGANG";
	  fixed_width = true;
	: radio_button { label = "Tim trac ngang"; key = "timtn"; }
	: popup_list {key = "tn";label = "Ten coc - Ly trinh";width = 45;fixed_width_font = false;}
	: edit_box { label = "Tim coc:" ; key = "TCTN" ; edit_width = 23; }
}
: boxed_column {
	  label = "TRAC_DOC";
	  fixed_width = true;
	: radio_button { label = "Tim trac ngang"; key = "timtd"; }
	: popup_list {key = "td";label = "Ten coc - Ly trinh";width = 45;fixed_width_font = false;}
	: edit_box { label = "Tim coc:" ; key = "TCTD" ; edit_width = 23; }
}
}
   : 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;
        }
}


    }
}

còn đầy là lisp mình viết

 

(defun C:timc (/ datalist)
(vl-load-com)
(defun sosanh (e1 e2 / p1 p2)
	(setq p1 (car e1)
		p2 (car e2)
	)
	(if (equal (cadr p1) (cadr p2) 1)
		(< (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 datalist (vl-sort datalist '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq numside (nth 0 datalist))
(setq numsidetd (nth 0 datalist))
(setq DCL_ID (load_dialog (strcat odiachay "\\tlkt\\dcl\\timcoc.DCL")))
(new_dialog "Ha1" DCL_ID)
(action_tile "timtn" "(setq timtn $value timtd \"0\")")
(action_tile "timtd" "(setq timtd $value timtn \"0\")")
(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))")
(start_list "td")
(mapcar 'add_list datalist)
(end_list)
(set_tile "td" (itoa (vl-position numsidetd datalist)))
(action_tile "td" "(setq numsidetd (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 point (car (nth (vl-position numside datalist) km)))
(command "ZOOM" "c" point 25)
)
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase st) (+ 4 (vl-string-search "-KM" (strcase st))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)

Do chưa biết viết mấy cái điều khiển trên nhờ mọi người giú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

Đã viết xong phần tìm trắc ngang

nhờ mọi người viết tiếp cho lựa chọn nút 

radio_button để làm sao chọn 1 trong 2 lựa chọn 

đây là lisp đã viết

(defun C:timc (/ datalist)
(vl-load-com)
(defun sosanh (e1 e2 / p1 p2)
	(setq p1 (car e1)
		p2 (car e2)
	)
	(if (equal (cadr p1) (cadr p2) 1)
		(< (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 datalist (vl-sort datalist '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
               (or (< (car tmx) (car tmy))
   (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq numside (nth 0 datalist))
(setq numsidetd (nth 0 datalist))
(setq DCL_ID (load_dialog (strcat odiachay "\\tlkt\\dcl\\timcoc.DCL")))
(new_dialog "Ha1" DCL_ID)
(HA:SetVal (setq lstkey '("timtn" "timtd"))
            (setq lstvar '(timtn timtd)) '("1" "0"))
(mode_tile "td" 1)
(mode_tile "TCTD" 1)
(mode_tile "TCTN" 2)
(action_tile "timtn" "(mode_tile \"td\"1)(mode_tile \"TCTD\"1)")
(action_tile "timtd" "(mode_tile \"tn\"1)(mode_tile \"TCTN\"1)")
(action_tile "TCTN" "(Setgt $reason)")
(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))")
(start_list "td")
(mapcar 'add_list datalist)
(end_list)
(set_tile "td" (itoa (vl-position numsidetd datalist)))
(action_tile "td" "(setq numsidetd (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 ( / vitri kmtim)
(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)
)
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase st) (+ 4 (vl-string-search "-KM" (strcase st))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(defun HA:SetVal (lstkey lstvar lstval) 
  (mapcar '(lambda (var val) (if (not (eval var)) (set var val))) lstvar lstval)
  (mapcar '(lambda (key val) (set_tile key (set (read key) val))) lstkey (mapcar 'eval lstvar))
)
(defun Setgt (chon1 / vitri coctim datalist1)
(if (= chon1 1)
(progn
(set_tile "TCTN" (strcat "Cäc:" (get_tile "TCTN")))
(setq numside1 (strcase (get_tile "TCTN")))
(foreach ent datalist
(setq vitri (VL-STRING-POSITION 75 ent))
(setq coctim (strcase (SUBSTR ent 1 (- vitri 1))))
(if (= coctim numside1)
(progn
(if (null datalist1)
(setq datalist1 (list ent))
(setq datalist1 (append datalist1 (list ent)))
) 
)
))
(if (null datalist1)
(alert "Khong tim thay coc")
(progn
(setq datalist datalist1)
(setq numside (nth 0 datalist))
(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))")
))
(mode_tile "btn_tim" 2)
)))

còn DCL như ở trê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

Chỗ action_tile bạn sửa như sau:

 

  (action_tile "timtn" "(set_tile \"timtd\" \"0\")  (mode_tile \"tn\" 0) (mode_tile \"TCTN\" 0)
                  (mode_tile \"td\" 1) (mode_tile \"TCTD\" 1)"  )
  (action_tile "timtd" "(set_tile \"timtn\" \"0\")  (mode_tile \"td\" 0) (mode_tile \"TCTD\" 0)
                  (mode_tile \"tn\" 1) (mode_tile \"TCTN\" 1)"  )
  • 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

Hàm tự viết cũng ngắn thôi.

(vl-list->string (vl-remove 32 (vl-string->list "  fskvll   fmsm      mlmbd   ")))

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


×