Sửa lisp xuất tọa độ Pline

[bienda 4]

Hiện tại mình có lisp xuất tọa độ các đỉnh Pline

Sau đó mình đưa vào excel để xử lí theo mục đích riêng

ể tiện lợi hơn mình muốn sửa lisp đó cho ra kết quả luôn nên nhờ các bác sửa dùm:

 

Lisp của mình khi xuất ra text có kết quả như sau (cách giữa các cột là 1tab):

 

X0  Y0  Z0

X1  Y1  Z1

................

X8  Y8  Z8

X9  Y9  Z9

 

Mình muốn sửa lại khi xuất kết quả nó sẽ như sau:

 

X0        Y0       Z0

X1-X0  Y1-Y0  Z1

................

X8-X7  Y8-Y7  Z8

X9-X8  Y9-Y8  Z9

 

Cột Z là không quan trọng

Mình gửi file lisp đính kèm

http://www.cadviet.com/upfiles/3/66051_pline.lsp

 

13723.9899 7807.7405 0.0000

14736.4067 7807.7405 0.0000

14736.4067 6891.0324 0.0000

13723.9899 6891.0324 0.0000

 

13723.9899 7807.7405 0.0000

14736.4067 7807.7405 0.0000

14736.4067 6891.0324 0.0000

13723.9899 6891.0324 0.0000

 

[quansla 259]

(defun c:111111 (/ ELV ENT FH FN HND ITM ITM2 NUM OBJ PNT SSET X0 Y0)
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                      (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
            (setq hnd (ssname sset itm))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond
              ((= obj "POINT")
                (setq pnt (cdr (assoc 10 ent)))
                (princ (strcat (rtos (car pnt) 2 2) " "
                               (rtos (cadr pnt) 2 2) " "
                               (rtos (caddr pnt) 2 2)) fh)
                (princ "\n" fh)
              )
              ((= obj "LWPOLYLINE")
                (if (= (cdr (assoc 38 ent)) nil)
                  (setq elv 0.0)
                  (setq elv (cdr (assoc 38 ent)))
                )
      (setq itm2 0)
                (foreach rec ent
                  (if (= (car rec) 10)    
                    (progn
     (setq pnt (cdr rec))
     (if (= (setq itm2 (1+ itm2)) 1)
(progn
 (setq x0 (car pnt) y0 (cadr pnt))
 (princ(strcat (rtos x0 2 4) " " (rtos y0 2 4) " " (rtos elv 2 4)) fh)
 (princ "\n" fh))
(progn
 (princ (strcat (rtos (- (car pnt) x0) 2 4) " "
(rtos (- (cadr pnt) y0) 2 4) " "
(rtos elv 2 4)) fh)
 (princ "\n" fh)
 )
                    )
                  )
                )
              ))
              (t nil)
            )
            (setq itm (1+ itm))
          )
          (close fh)
        )
      )
    )
  )
  (princ)
)

mình đã đổi tên lệnh thành 111111 (6 số 1) bạn đổi lại cho phù hợp với công việc của mình.
Và vấn đề nữa là code của bạn khi dùng chẳng phải sẽ không phân biệt được list point10 của các đối tượng khác nhau sao.
Vậy khi làm chỉ có cách quét từng đối tượng để xử lý àh,?

[bienda 4]

Cảm ơn bạn nhiều

Nhưng khi mình dùng lisp bạn vẫn bị lỗi

 

Cụ thể là X0 & X1 thì ok X2 trở lên là bị sai

Y0 & Y1 sai, Y2 đúng, Y3 lại sai

 

Bạn có thể bỏ cho mình tọa độ Z được không

 

Mình chỉ cần xử lí cho 1 đối tượng thôi 

[bienda 4]

Xin lỗi của bạn bị lỗi ở chỗ

 

X2-X0 và Y2-Y0

 

Mình cần là X2-X1 và Y2-Y1; X3-X2 và Y3-Y2,........

[quansla 259]

Xin lỗi của bạn bị lỗi ở chỗ

 

X2-X0 và Y2-Y0

 

Mình cần là X2-X1 và Y2-Y1; X3-X2 và Y3-Y2,........

Xin lỗi bạn, mình k0 đọc kỹ yêu cầu của bài bạn. Nhung mà bài của bạn thực chất yêu cầu là gì vậy.

1. Quét chọn cả Point và Polyline

2. Xử lý tiếp theo như thế nào; lấy (x0 y0 z0) là điểm nào, điểm của Point/ (dxf 10) của Polylilien đầu tiên; hay là nếu là Point thì giữ nguyên, nếu là Polyline thì tuỳ từng Polyline mà lấy điểm (x0 y0 z0) theo (dxf 10) của Polyline đó. Hay xử lý riêng Polyline với (x0 y0 z0) nào đó cố định.

3. Kết quả trả về muốn như thế nào. Có muốn có một ký hiệu ngăn cách các đối tượng Point / Polyline được chọn không. chẳng hạn

 

 

***************** Đối tượng 1 : Point

(x1 y1 z1)

***************** Đối tượng 2 : Point

(x2 y2 z2)

***************** Đối tượng 3 : Polyline

(x0-dt3  y0-dt3 z0-dt3)

(x1-x0-dt3    y2-y0-dt3 z0-y0-dt3)

(......)

***************** Đối tượng 4 : Polyline

(x0-dt4 y0-dt4 z0-dt4)

......

[bienda 4]

Mình gửi mail cho bạn file excel có gì giúp mình với nhé

[xuanb3 0]

mình có 1 doạn mã vba dùng để xuất tọa độ từ cad sang excel,nhưng mỗi lần khi kích hoạt nó tự đông bắt đầu bằng stt là 1.nhờ mọi người trong diễn đàn sửa giúp mình là có thể nhập sô thứ tự vào cho nó được ko,file mình đính kèm bên dưới,cảm ơn mọi ng trước nhé .http://www.cadviet.com/upfiles/3/52714_module.rar

[bienda 4]

VBa thì bác sang topic VBA mà hỏi chứ

sao lại hỏi ở đây ta?

[quansla 259]

Tên lệnh là Thunghiem
Ban có thể đối lại tên tuỳ ý
có gì cần sửa PM lại mình nhé
sử dụng: Gọi lệnh "THUNGHIEM"
Quét chọn đối tượng Polyline (quét thi quét thoải mái) nhưng lisp chỉ xử lý cho 1 đối tượng đầu tiên của tập chọn thôi.

Nhập tên file cần ghi data, líp cho phép xem trước KQ, chọn Yes để ghi kết quả , No để không ghi kết quả
Nếu quá lằng nhằng, luôn kiểm soát được việc quét đối tượng là chính xác, PM lại mình bỏ luôn đoạn hỏi

Yes/No đi

 

(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)
(if (and (setq ten (getfiled"\nchon file" "" "txt;*" 7))
(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))
(progn
(setq f (open ten "w"))
(setq i -1 en (entget dt) N (length en) lst '())
(while (<(setq i (1+ i)) N)
(if (= (car( nth i en)) 10)
(setq lst (append lst (list (cdr(nth i en)))))))
(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))
(setq ls(mapcar '(lambda (x y)
(list
(- (car x) (car y))
(- (cadr x) (cadr y))))
lst lst2))
(prompt "\nInthu\n")(princ)
(foreach i ls
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))
(princ)
)
(textscr)
(initget 1 "Yes No")
(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? [Yes,No]")))
(if (= k "YES")
(foreach i ls
(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)
)
(prompt "\nKhong ghi ket qua ra file nua"))
(close f)))
(princ)
)

[bienda 4]

Cảm ơn bạn rất nhiều

Hàm của bạn ngắn hơn file gốc rất nhiều rồi

 

Bạn sửa lại hộ mình:

1-Lưu file sau khi chọn đối tượng giống lisp gốc

2-Không cần xem trước kết quả

3-Bỏ lựa chọn yes or no đi

[bienda 4]

Xuất tọa độ hình tròn mình nhờ bạn đấy
Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi
Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn
bạn lược bớt cho đơn giản hộ mình nhé

 

1-Quét được nhiều đường tròn cùng 1 lúc

2-Chỉ xuất tọa độ X Y và đường kính sắp xếp giống lisp Pline bên trên thôi nhưng cho vào file "csv" theo 3 cột được không?

 

http://www.cadviet.com/upfiles/3/66051_ptdef2csv.lsp

 

Cảm ơn rất nhiều

Mình ngồi vọc để hiểu mà mãi k bỏ được các thứ đó đi =))

[quansla 259]

Xuất tọa độ hình tròn mình nhờ bạn đấy

Mình có 1 lisp xuất tọa độ và đường kính hình tròn rồi

Nhưng nó lại xuất cho rất nhiều đối tượng và có rất nhiều sự lựa chọn

bạn lược bớt cho đơn giản hộ mình nhé

1-Quét được nhiều đường tròn cùng 1 lúc

2-Chỉ xuất tọa độ X Y và đường kính sắp xếp giống lisp Pline bên trên thôi nhưng cho vào file "csv" theo 3 cột được không?

Cảm ơn rất nhiều

Mình ngồi vọc để hiểu mà mãi k bỏ được các thứ đó đi =))

P/s Mình xin lỗi vì không pm bài bạn sớm hơn, dạo này hơi bận chút, trước mắt mình sửa lại thế này, phần về đường tròn, trong Code mình có sử dụng hàm của Ẽxpress Tools (quen rồi) nếu trên máy bạn chưa cài , líp sẽ không chạy , bạn PM lại mình sửa lại sau. chúc vui. Gợi ý thêm: phần quét chọn hình tròn bạn có yêu cầu gì thêm không( ví dụ xắp xếp theo tăng giảm Radius, xắp xếp theo X,Y của đường tròn, ...) Rất mừng khi bạn cũng quan tâm đến Líp, mình chỉ mới biết líp thôi, bạn có cùng sở thích, cùng học nhé.

 

http://www.cadviet.com/upfiles/3/101306_thunghiemtron.lsp

Đây là lisp thực hiện với đường tròn (bạn có thể đổi lại tên lệnh, tên hiện tại là thunghiemTron; bạn có thể bỏ đi dòng mà trong code mình đánh dấu có thể bỏ đi, để phù hợp với công việc)

 

Mình đã sửa lại yêu cầu của bạn , mình post lại dưới đây nhé.

http://www.cadviet.com/upfiles/3/101306_thunghiem_1.lsp

;;;; THUNGHIEM --- Lam viec voi Poly

(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)

 

(if (and (setq ten (getfiled "\nchon file" "" "txt;*" 7))

 

(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))

 

(progn

 

(setq f (open ten "w"))

 

(setq i -1 en (entget dt) N (length en) lst '())

 

(while (<(setq i (1+ i)) N)

 

(if (= (car( nth i en)) 10)

 

(setq lst (append lst (list (cdr(nth i en)))))))

 

(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))

 

(setq ls(mapcar '(lambda (x y)

 

(list

 

(- (car x) (car y))

 

(- (cadr x) (cadr y))))

 

lst lst2))

 

(prompt "\nInthu\n")(princ)

 

(foreach i ls

 

(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))

 

(princ)

 

)

 

;(textscr)

 

;(initget 1 "Yes No")

 

;(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? [Yes,No]")))

 

(foreach i ls

 

(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)

 

)

 

(close f)))

 

(princ)

 

)

 

 

 

(defun c:thunghiemTron (/ ls dt ent i f ten)

(vl-load-com)

(if (and (setq ten (getfiled "\nchon file" "" "csv;txt;*" 7))

(setq ss (acet-ss-to-list(ssget '(( 0 . "Circle"))))))

(progn

(setq ls '())

(setq f (open ten "w"))

(princ "X\tY\tRadius\n" f) ;;;; co the bo dong nay di

(foreach dt ss

(setq ls (append ls (list(list

(car(acet-dxf 10 (setq ent (entget dt))))

(cadr (acet-dxf 10 ent))

(acet-dxf 40 ent))))))

(foreach i ls

(princ (strcat (rtos (car i) 2 4)"\t"(rtos (cadr i) 2 4)"\t"(rtos (caddr i) 2 4) "\n") f)

)

(close f)))

(princ)

)

Chỉnh sửa Tháng 11 29, 2013 theo Nguyen Hoanh

[bienda 4]

Cảm ơn sự nhiệt tình của bạn rất nhiều

Bạn có thể sửa lisp thêm chút nữa hộ mình nhé

 

1-Chọn lưu file text sau khi đã thực hiện lệnh

2-Lisp hình tròn khi xuất sang excel không thành 3 cột (cái này mình có thể chuyển sang text rồi copy vào excel cũng được)

3-Lisp Pline, mình muốn add thêm text mặc định vào dòng đầu được không?giả sử dòng 1 add thêm A từ dòng 2-n add thêm là B? vì khi mình sửa thì nó add từ 1-n :D

[loc2210 0]

lisp lấy tọa độ của bạn đây.

(defun c:l2d1 ()
  
  	(setq tenk (getstring "Nhap ten Suon ; Duong Nuoc ; Cat Doc : "))
	(setq rong t)
	(setq tdx (list)
	      tdy (list) 
		tdxy (list )
	      dulieu (list))
  	  		
		(while rong
		  
			(progn
				(setq p1 (getpoint "\nChon mot diem:"))
					(if p1
						(progn
							(setq tdx (append (list (rtos (car p1) 2 2)) tdx )
)
						  (setq tdy (append (list (rtos (cadr p1) 2 2)) tdy )
							tdxy (append (list(rtos (/ (car p1) 1000) 2 2)","(rtos (/ (cadr p1) 1000) 2 2)) tdxy)
							dulieu (append (list (strcat (rtos (/ (car p1) 1000) 2 2)","(rtos (/ (cadr p1) 1000) 2 2))) dulieu))
						  
(setq rong t)
)
(setq rong nil)
)
)
)
  
(setq tdx (reverse tdx)
      tdy (reverse tdy))
  (princ tenk)
  (princ "\n")
(princ "Toa do X")
  (princ "\n")
  
  (princ tdx)
  (princ "\n")
  
  (princ "Toa do Y")
  
  (princ "\n")
  (princ tdy)
  
  (princ "\n")
   (princ "\n")
  (princ dulieu)
  
  (alert "Chuong trinh duoc viet boi  - Bui Cong Loc ")


)

[bienda 4]

Lisp của bạn không dùng được

Cảm ơn sự quan tâm

[quansla 259]

Cảm ơn sự nhiệt tình của bạn rất nhiều

Bạn có thể sửa lisp thêm chút nữa hộ mình nhé

 

1-Chọn lưu file text sau khi đã thực hiện lệnh

2-Lisp hình tròn khi xuất sang excel không thành 3 cột (cái này mình có thể chuyển sang text rồi copy vào excel cũng được)

3-Lisp Pline, mình muốn add thêm text mặc định vào dòng đầu được không?giả sử dòng 1 add thêm A từ dòng 2-n add thêm là B? vì khi mình sửa thì nó add từ 1-n :D

1. Lỗi không lưu file ở file lisp nào vậy bạn.
2. mình không hay nghịch "csv" ai biết rõ xin chỉ gíúp mình và sửa lại code( hoặc viết mới), lại giúp mình, mình cũng đã thử khi lưu file với đuôi là ".csv" thì nó không lưu ra là 3 cột thật, vậy @bienda có thể sửa bằng cách đổi chỗ thứ tự "csv" và "txt" trong code, hoặc bỏ hẳn "csv" đi và làm thêm một bước là copy từ txt sang Ễxcel nhé.
3. Bạn hãy gửi file mẫu nhé. mình chưa thực sự hiểu

[Doan Van Ha 3.191]

mình không hay nghịch "csv" ai biết rõ xin chỉ gíúp mình và sửa lại code( hoặc viết mới), lại giúp mình, mình cũng đã thử khi lưu file với đuôi là ".csv" thì nó không lưu ra là 3 cột thật, vậy @bienda có thể sửa bằng cách đổi chỗ thứ tự "csv" và "txt" trong code, hoặc bỏ hẳn "csv" đi và làm thêm một bước là copy từ txt sang Ễxcel nhé.

Lưu CSV thì thay "\t" bằng ",". Không lưu chung csv và txt bằng "\t" như thế.

[quansla 259]

[ok] bạn, mình đã sửa lại lisp Pline nhé, "CSV" để mình nghiên cứu thêm, hay bác Hà có thể sửa lại ngay trong Code được không ah, Thanks bác

 

List Pline

(tên lệnh bienda1)

(defun c:bienda1 (/ dt tenfile f lst lst2 i ls )

(vl-load-com)

(while (and(setq dt (ssget '((0 . "LWPOLYLINE"))))

(setq tenfile (getfiled "\nChon ten file" "" "csv" 1)))

 

(setq dt (ssname dt 0))

(setq f (open tenfile "w"))

(setq lst (acet-geom-vertex-list dt)

lst2 (append '((0 0 0)) (reverse (cdr (reverse lst)))))

(setq ls (mapcar '(lambda(x y)

(list

(- (car x) (car y))

(- (cadr x) (cadr y))

))

lst

lst2

))

(princ

(strcat "A" (rtos (car (car ls)) 2 4) "," (rtos (cadr (car ls)) 2 4) "\n")

f

)

(foreach i (cdr ls)

(princ

(strcat "B" (rtos (car i) 2 4) "," (rtos (cadr i) 2 4) "\n")

f

))

(close f)

)

(princ)

)

 

 

 

Lisp đường tròn

(defun c:bienda2 (/ dt tenfile f ls i ent ss )

  (vl-load-com)

  (if (and (setq ss (acet-ss-to-list(ssget '((0 . "circle")))))

  (setq tenfile (getfiled "\nChon ten file" "" "csv" 1)))

    (progn      

      (setq f (open tenfile "w"))

      (setq ls '())      

      (princ "X,Y,Radius\n" f)      ;;;; co the bo dong nay di

      (foreach dt ss

(setq ls

      (append ls

      (list (list

      (car (acet-dxf 10 (setq ent (entget dt))))

      (cadr (acet-dxf 10 ent))

      (acet-dxf 40 ent)

      )))))

      (foreach i ls

(princ (strcat (rtos (car i) 2 4)

      ","

      (rtos (cadr i) 2 4)

      ","

      (rtos (caddr i) 2 4)

      "\n"

      )

      f

      ))

      (close f)

    )

    (prompt "\nChua lam gi")

    )

  (princ)

  )

 

 

 

P/s Về giáo trình AutoLisp, bạn tham khảo trên mạng nhé, mình trước cũng tìm vậy thôi, tìm với google.com từ khoá "giáo trình AutoLisp" . Hình như có cuốn thầy Lộc khá hay và dễ hiểu, mình không nhớ rõ nữa

[chuyenqh 1]

P/s Mình xin lỗi vì không pm bài bạn sớm hơn, dạo này hơi bận chút, trước mắt mình sửa lại thế này, phần về đường tròn, trong Code mình có sử dụng hàm của Ẽxpress Tools (quen rồi) nếu trên máy bạn chưa cài , líp sẽ không chạy , bạn PM lại mình sửa lại sau. chúc vui. Gợi ý thêm: phần quét chọn hình tròn bạn có yêu cầu gì thêm không( ví dụ xắp xếp theo tăng giảm Radius, xắp xếp theo X,Y của đường tròn, ...) Rất mừng khi bạn cũng quan tâm đến Líp, mình chỉ mới biết líp thôi, bạn có cùng sở thích, cùng học nhé.

 

http://www.cadviet.com/upfiles/3/101306_thunghiemtron.lsp

Đây là lisp thực hiện với đường tròn (bạn có thể đổi lại tên lệnh, tên hiện tại là thunghiemTron; bạn có thể bỏ đi dòng mà trong code mình đánh dấu có thể bỏ đi, để phù hợp với công việc)

 

Mình đã sửa lại yêu cầu của bạn , mình post lại dưới đây nhé.

http://www.cadviet.com/upfiles/3/101306_thunghiem_1.lsp

;;;; THUNGHIEM --- Lam viec voi Poly

(defun c:thunghiem (/ dt en i ls lst N x xy0 lst2 f k ten x y)

 

(if (and (setq ten (getfiled "\nchon file" "" "txt;*" 7))

 

(setq dt (ssname (ssget '((0 . "LWPOLYLINE"))) 0)))

 

(progn

 

(setq f (open ten "w"))

 

(setq i -1 en (entget dt) N (length en) lst '())

 

(while (<(setq i (1+ i)) N)

 

(if (= (car( nth i en)) 10)

 

(setq lst (append lst (list (cdr(nth i en)))))))

 

(setq lst2 (append '((0 0 0)) (reverse(cdr(reverse lst)))))

 

(setq ls(mapcar '(lambda (x y)

 

(list

 

(- (car x) (car y))

 

(- (cadr x) (cadr y))))

 

lst lst2))

 

(prompt "\nInthu\n")(princ)

 

(foreach i ls

 

(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n"))

 

(princ)

 

)

 

;(textscr)

 

;(initget 1 "Yes No")

 

;(setq k (strcase(getkword "\nBan co muon ghi ra file ketqua tren? [Yes,No]")))

 

(foreach i ls

 

(princ (strcat (rtos (car i) 2 4) "\t" (rtos (cadr i) 2 4) "\n") f)

 

)

 

(close f)))

 

(princ)

 

)

 

 

 

(defun c:thunghiemTron (/ ls dt ent i f ten)

(vl-load-com)

(if (and (setq ten (getfiled "\nchon file" "" "csv;txt;*" 7))

(setq ss (acet-ss-to-list(ssget '(( 0 . "Circle"))))))

(progn

(setq ls '())

(setq f (open ten "w"))

(princ "X\tY\tRadius\n" f) ;;;; co the bo dong nay di

(foreach dt ss

(setq ls (append ls (list(list

(car(acet-dxf 10 (setq ent (entget dt))))

(cadr (acet-dxf 10 ent))

(acet-dxf 40 ent))))))

(foreach i ls

(princ (strcat (rtos (car i) 2 4)"\t"(rtos (cadr i) 2 4)"\t"(rtos (caddr i) 2 4) "\n") f)

)

(close f)))

(princ)

)

mình muốn lấy tọa độ theo tọa độ tương đối. (với mặt cắt ngang đường thi thường hay lấy tim đường  làm điểm so sánh)

[levanthanh9999 1]

http://www.cadviet.com/upfiles/7/162289_xylay_toa_do_xy.lsp

ai có thể chỉnh sủa lsp lấy tọa độ x,y thành Clipboard nội dung để em paste sang excel được không ah?.lsp này hiện tại bắt mình xuất ra file txt. nên mơi lòng vòng cho công việc của em.Mong các anh giúp