Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
22 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 31 July 2014 - 05:52 PM

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.c...6960_tdt_ok.rar


  • 0

#2 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 31 July 2014 - 06:52 PM

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

  • 1

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 31 July 2014 - 08:35 PM

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ẽ


  • 0

#4 genius111

genius111

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 31 July 2014 - 10:54 PM

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


  • 0

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 01 August 2014 - 07:44 AM

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


  • 1

#6 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 01 August 2014 - 09:33 AM

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" 

  • 0

#7 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 01 August 2014 - 10:37 AM

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

  • 3

#8 genius111

genius111

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 01 August 2014 - 11:01 AM

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


  • 0

#9 genius111

genius111

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 01 August 2014 - 11:03 AM

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 ạ


  • 0

#10 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 01 August 2014 - 11:47 AM

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

Bạn chưa biết dùng LISP


  • 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







#11 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 01 August 2014 - 12:11 PM

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


  • 0

#12 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 01 August 2014 - 01:58 PM

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


  • 1

#13 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 01 August 2014 - 01:58 PM

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


  • 0

#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 01 August 2014 - 02:05 PM

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

  • 0

#15 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 01 August 2014 - 02:24 PM

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


  • 1

#16 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 01 August 2014 - 02:49 PM

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


  • 0

#17 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 05 August 2014 - 10:50 AM

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 đỡ


  • 0

#18 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 07 August 2014 - 03:22 PM

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


  • 0

#19 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 07 August 2014 - 04:28 PM

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

  • 1

#20 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 07 August 2014 - 04:42 PM

Cám ơn bạn nhiều lắm, bạn cho mình hỏi tí nữa là có hàm nào cắt bỏ khoảng trống (space) trong chuổi không 


  • 0