nhờ viết lisp hoặc sửa chương trình chuyển số liệu đo bình đồ từ máy thủy binh

[HOAILINHLINH 23]

Nhờ các anh giúp công việc của em là đo một cái cống nhỏ thôi nên em đo bằng máy thủy bình.

Số liệu em đo được bao gồm có số đọc chỉ giữa, số đọc chỉ dưới, góc quay(đọc được tới phút xem file kèm theo),

lúc trước để chuyển số liệu này lênh cad em sử dụng một chương trình" VE-AUTO.EXE" nhưng khổ nổi nó chạy trên Win7 còn đa số máy hiejne nay sử dụng win cao nên không chạy được chương trình này.

Nên em nhờ các anh em trên diễn đàn có thể giúp em viết một lisp có chức năng tương tự hoặc nân cao hơn chút cho tiện.

Công việc là như thê này:

+ thứ nhất: lisp sử lấy số liệu từ file ".TXT"

+ Thứ hai: lisp tự động tính chuyển số liệu góc cạnh ra số liệu tọa độ

+ Thứ ba : số liệu được phun lênh cad gồm có điểm point có z = cao độ, số thứ tự điểm, cao độ, ba thông số này phải có điểm đặt trùng với nhau

Về công việc tính chuyển số liệu từ góc cạnh có thể vận dụng bài toán thuận nghịc trong trắc địa tính xem link ( http://www.mediafire.com/file/y3gctinv38maykj/1.xlsx/file )

Về việc sử dụng chương trình" VE-AUTO.EXE" này thì cũng có file hướng đẫn xem link  ( http://www.mediafire.com/file/ovzbrdqofd1jb7z/xu_ly_BD_cong.docx/file )

Đây là link tải phần mềm đó : http://www.mediafire.com/file/465cbpv6h5y7g8c/VE-AUTO.zip/file

Nói thêm về chương trình này thì nó sử dụng file txt có dạng như file kèm rồi nhập các thông số theo hướng dẫn nó sẽ xin ra một file lisp sau khi load file lisp đó lênh thì ta được các điểm đo vẽ file lisp được sinh ra từ chương trình mình có post lênh tên là BD.lsp ệnh là (ve).

Kèm theo có hình ảnh diễn giải file số liệu các bác xem giúp bởi diễn giải nó dài dòng.

PS: xin lỗi nếu các diễn dải có gây cho các bạn sự khó hiểu xin nhận ý kiến đóng góp để hoàn thiện mình hơn cảm ơn các bác đã ghé quá

BD.txt

BD.LSP

Chỉnh sửa Tháng 7 10, 2019 theo HOAILINHLINH
Do diễn giải chưa rỏ ràng và câu từ chưa chuẩn xác

[Doan Van Ha 3.201]

Xém đi cấp cứu vì đọc các câu văn hà tiện dấu chấm và phẩy, nên tỉnh lại không hiểu gì hết. 

[HOAILINHLINH 23]

1 giờ trước, Doan Van Ha đã nói:

Xém đi cấp cứu vì đọc các câu văn hà tiện dấu chấm và phẩy, nên tỉnh lại không hiểu gì hết. 

xin lỗi bác Hà khi nảy viết gấp quá chưa chú ý em có sửa rồi nếu còn vướng mắt mong bác thông cảm góp ý

[duy782006 1.551]

-Cái chuyển từ góc cạnh sang toạ độ có thể lưu xuống óp pít nhỏ hơn hông (tui hông mở được).

-Số thứ tự điểm lấy ở đâu.

-Kết quả xuất ra có thể là block att gồm point, att thứ tự, att cao độ được không hay nhất thiết phải là 3 đối tượng rời rạc.

-Nếu rời rạc có yêy cầu gì về layer hay không (chung, riêng layer cho từng đối tượng.

Vầy đi: dòng đầu không quan tâm. Từ dòng 2 và dòng 3 làm sao cho ra thành xd yd zd. Bạn đánh công thức ra nhé.

 

 

 

Nói thiệt tui đang muốn hoàn thiện cái tiện ích về xuất toạ độ của mình nên cần tham khảo nhu cầu thực tế của mấy anh trắc đạc chút.

 

[HOAILINHLINH 23]

21 giờ trước, duy782006 đã nói:

-Cái chuyển từ góc cạnh sang toạ độ có thể lưu xuống óp pít nhỏ hơn hông (tui hông mở được).

-Số thứ tự điểm lấy ở đâu.

-Kết quả xuất ra có thể là block att gồm point, att thứ tự, att cao độ được không hay nhất thiết phải là 3 đối tượng rời rạc.

-Nếu rời rạc có yêy cầu gì về layer hay không (chung, riêng layer cho từng đối tượng.

Vầy đi: dòng đầu không quan tâm. Từ dòng 2 và dòng 3 làm sao cho ra thành xd yd zd. Bạn đánh công thức ra nhé.

 

 

 

Nói thiệt tui đang muốn hoàn thiện cái tiện ích về xuất toạ độ của mình nên cần tham khảo nhu cầu thực tế của mấy anh trắc đạc chút.

 

Số thứ tự thì đánh theo thứ tự tăng dân số đầu tiên là 1 nếu trạm một đo thì sẽ là 1.1, 1.2, 1.3..., nếu trạm 2 đo sẽ la 2.1, 2.2, 2.3...

Còn về kết quả xuất ra thì phải có ba đối tượng đó và nằm trong ba laser khác nhau

Còn công thức mình có post lênh một file excel phiên bản 2016 để mình lưu lại 2010 rồi post lênh sau nhé hiện đi công tác k đem máy theo

[duy782006 1.551]

Cuối cùng cũng mở được file bài toán thuận nghịc trong trắc địa. Xem xong thì chỉ có công thức xác định được x và y còn z thì chắc là đoán nhỉ?

Đó là chưa nói tôi chưa có dòm kỹ nên ko biết với dử liệu trên thì có áp dô đủ tính hay không

Đến khi nào bạn chưa dạy tôi từ 2 cái dòng trên cùng làm cách nào tính các dóng dưới thành x y z thì tôi sẽ không làm gì cả nhé.

[HOAILINHLINH 23]

17 giờ trước, duy782006 đã nói:

Cuối cùng cũng mở được file bài toán thuận nghịc trong trắc địa. Xem xong thì chỉ có công thức xác định được x và y còn z thì chắc là đoán nhỉ?

Đó là chưa nói tôi chưa có dòm kỹ nên ko biết với dử liệu trên thì có áp dô đủ tính hay không

Đến khi nào bạn chưa dạy tôi từ 2 cái dòng trên cùng làm cách nào tính các dóng dưới thành x y z thì tôi sẽ không làm gì cả nhé.

Về cao độ được tính bằng cao độ óng kính ngắm trừ cho số đọc chỉ giữa của điểm chi tiết sẽ cho ta cao độ tại chân mia, cao độ óng kính ngắm hay còn gọi cách khác là cao độ đường ngắm, trong tám ảnh của mình là cái ô màu đỏ đó là cao độ óng kính ngắm cái đo thì dân đo đạc tự tính ra được nên bạn mặc định nó có đi nhé cho khỏi tìm hiểu sâu xa

còn số thứ tự thì có hai hướng giải quyết

một là bạn có thể cho nó đánh số thứ tự theo kiểu tăng dần điểm đầu tiên là 1

hai là bạn có thể thêm cào file text dữ liệu một cột là số thứ tự chẳng hạn

cảm ơn bạn duy đã quan tâm mong phản hồi từ bạn

[duy782006 1.551]

Sau khi xin các bác trên cadviet 1 số hàm thì mình đã làm được việc đọc cái file số liệu và đọc ra từng giá trị trong từng dòng. Mặc dù đọc cái file công thức tuận nghịch rồi nhưng cái đầu đất của mình cũng hông hiểu. Nhờ bạn như này:

-Từ độ, phút, chỉ giữa, chỉ dưới.

-Thêm x, y của trạm máy.

-Gỏ giúp mình công thức cho ra x điểm, y điểm từ cái đống dữ liệu trên được hông. năn nỉ đó!

[nhoclangbat 392]

- nhoc hiểu sơ sơ nhưng số liệu thô có vấn đề or v...v, không tính ra được cạnh ^^, điểm A tương ứng trạm tọa độ (0,0)

-vd: góc của điểm đầu tiên cho là điễm B : 33 độ 30 phút => radian

       => xB= xA + S[ab]cosB ; yB= yA + S[ab]sinB : cái chưa hiểu S[ab] tính thế nào ^^, zB = 3067-1473(chỉ dưới B)=159, công thức nhoc biết: chỉ trên - dưới = khoảng cách mà thiếu chỉ trên điểm B, các điểm sau C,...,F cũng lấy gốc là điểm A tính ra theo cú pháp đó

p/s: không biết có dịch sai số liệu không ^^

[HOAILINHLINH 23]

15 giờ trước, duy782006 đã nói:

Sau khi xin các bác trên cadviet 1 số hàm thì mình đã làm được việc đọc cái file số liệu và đọc ra từng giá trị trong từng dòng. Mặc dù đọc cái file công thức tuận nghịch rồi nhưng cái đầu đất của mình cũng hông hiểu. Nhờ bạn như này:

-Từ độ, phút, chỉ giữa, chỉ dưới.

-Thêm x, y của trạm máy.

-Gỏ giúp mình công thức cho ra x điểm, y điểm từ cái đống dữ liệu trên được hông. năn nỉ đó!

Inbox mình nhé mình sẽ liên hệ nói rõ hơn cũng như là cung cấp công thức trên excel cho bạn nhé còn hàm lisp thì thua luôn https://m.facebook.com/TruongHoaiLinh26021994?ref=bookmarks

[duy782006 1.551]

Ai có đòi hàm lisp chi đâu. Việc tôi muốn bạn làm là từ xmáy ymáy ạnpha độ phút chỉ giữa chỉ dưới. Làm sao tính ra xđiểm yđỉêm. Tôi nghĩ mình hỏi đủ rỏ rồi mà.

Lần này mà bạn ko hiểu câu hỏi nửa thì tôi xin phép từ bỏ. Tôi ko có thói quen inbox. Mặc dù tôi cũng muốn có lisp chuyển từ góc cạnh sang xy nhưng ko cấp thiết lắm tôi sẽ từ từ mò trên nét từ những người biết hỏi và biết trả lời.

Chào thân ái!

[nhoclangbat 392]

* em nghiệm ra rồi anh @duy782006 ^^

- Trạm máy A (xA=0, yA=0)

- điểm B: góc 30đô 30 phút, chỉ trên :1473; dưới 1410.

       + góc B chuyển sang radian hàm này chắc anh  viết được, ở đây góc bằng : 0.5236 (rad)

       + cạnh A-B = (1473-1410)* hằng số máy : theo file hướng dẫn là 200, em so sánh với file cad gửi lên tương đối khớp 

       + cao độ = 3067-1410

       + => xB= xA + S[ab]cosB <=> xB= 0 + (12600x(cos B)) ; yB tương tự mà là sin(B)

- điểm C, D, ... tương tự

[duy782006 1.551]

Chúng ta (những người muốn viết lisp theo yêu cầu) không cần phải đoán bạn nhoclangbat à. Đoán sai người ta bắt đền hoặc chê thì nhục.

[nhoclangbat 392]

- hihi em cũng làm bên trắc địa bài toán đó em biết mà ^^, em chỉ lăn tăn vụ cạnh, mò lại sách nghiệm ra rồi

[duy782006 1.551]

Trong đề chỉ có chỉ giữa và chỉ dưới, không có chỉ trên. Cái hằng số máy sao nghe có vẽ bốc thuốc quá vậy.

Thực tế chỉ cần chính xác toạ độ A, góc AB, dài AB là trong lisp mình tìm ra B bằng hàm polar rồi nhưng vấn đế là Góc AB và dài AB tính kiểu gì đó.

[nhoclangbat 392]

 

- chỗ này nè anh, có lý do phần mềm mới kêu nhập hằng số máy, αAB = góc B đó anh = 30độ 30', vì góc định hướng mặc định là 0, từ A mở góc ra B là theo file số liệu, anh thử chạy rồi so sánh file cad mẫu xem ^^

[HOAILINHLINH 23]

9 giờ trước, duy782006 đã nói:

Trong đề chỉ có chỉ giữa và chỉ dưới, không có chỉ trên. Cái hằng số máy sao nghe có vẽ bốc thuốc quá vậy.

Thực tế chỉ cần chính xác toạ độ A, góc AB, dài AB là trong lisp mình tìm ra B bằng hàm polar rồi nhưng vấn đế là Góc AB và dài AB tính kiểu gì đó.

bạn duy có vẽ khó tính nhể nếu bạn chiệu khó xem dữ liệu của mình post lênh thì ắc cũng nhình ra,  thôi vậy mình sẽ thử tính tọa độ một điểm đầu tiên trong cái file txt mình post cho bạn xem bạn chiệu khó bấm vào và xem cách tính nhé.

một điều nửa là cái chiều dài được tính bằng số đọc chỉ giữa trừ số đọc chỉ dưới sau đó nhân cho hằng số là 200 sẽ ra được khoảng cách đây là link tải: http://www.mediafire.com/file/he1g5g3abkp1156/11.xlsx/file

còn việt muốn bạn inbox là mục đích để hiểu hơn về cái việc này mình nghĩ nó chả có gì để bạn khó chiệu cả mình đi làm xuốt nên chỉ nhờ face báo thì mình mới hay mà trả lời chứ bài này mình có khi vào khi không nên k trả lời trực tiếp được mình không hiểu sau lại gây cho bạn sự khó chiệu này mình thoải mái hơn phả tốt hơn không 

[duy782006 1.551]

1.Tôi ko khó chịu và cũng ko chịu khó. Vấn đề là bạn vẩn ko biết cách trả lời câu hỏi của tôi.

2.tôi ko cần bạn tính tọa độ mà cần bạn bày tôi cách tính tọa độ. Giờ tôi tổng hợp từ trả lời của bạn nhoclangbat xem đúng ko mhé:

a.Góc ab= góc điểm b - anpha

b. Dài ab= (chỉ giữa- chỉ dưới)x 200

c.cao b= cao độ đường ngắm- chỉ dưới.

3. Giờ bạn nói xem tôi hiểu vậy đúng hay sai. Sai thì sai chổ nào gỏ lại theo kiểu tôi trình bày a b c đó. Tôi mong muốn từ bửa nay 3 dòng đó đó.

[duy782006 1.551]

22 giờ trước, nhoclangbat đã nói:

- hihi em cũng làm bên trắc địa bài toán đó em biết mà ^^, em chỉ lăn tăn vụ cạnh, mò lại sách nghiệm ra rồi

Mình thấy cao đường ngắm và chỉ dưới đều là 4 chử số không có phẩy. Khi trừ ra thì nó cũng là 4 chử số. @nhoclangbat đoán xem có chia cho 100 hay 1000 gì không cho nó ra số có dấu phẩy mới đúng chứ nhỉ!

(defun STR-NUMBER (str / LST LST1 LST2)
(setq lst (vl-string->list str))
(SETQ LST1 (LIST))
(while (setq X (car LST))
(setq LST (CDR LST))
(SETQ LST2 (LIST))
(IF (AND (>= X 48) (<= x 57)) (PROGN (SETQ LST2 (APPEND LST2 (LIST X)))
(WHILE (AND (>= (car LST) 48) (<= (car LST) 57))
(SETQ LST2 (APPEND LST2 (LIST (car LST))))
(SETQ LST (CDR LST))
)
(SETQ LST1 (APPEND LST1 (LIST LST2)))
))
)
(MAPCAR '(LAMBDA (X) (vl-list->string X)) LST1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao file chua noi dung list  
;;;Cu phap su dung (duy:taotxt<list filename listtc) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taotxt<list (filename listtc / filename tapchon dtc)
(setq ndd (open filename "w"))
(foreach dtc listtc
(write-line dtc ndd)
)
(close ndd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao list chua noi dung file
;;;Cu phap su dung (duy:taolist<f tenfile) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taolist<f (filename / filename)
(setq lkq nil)
(setq ndd (open filename "r"))
(while 
(/= nil (setq ddd (read-line ndd)))
(setq lkq (append lkq (list ddd)))
)
(close ndd)
lkq)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ftp ()
(cond
((= toadomay nil) (setq toadomay (list 0 0 0)) )
)

(setq filedo (getfiled "Chon file so lieu" "" "txt" 0))
(setq ndfiledo (duy:taolist<f filedo))

(foreach nddongdo ndfiledo
(setq tachnd (STR-NUMBER nddongdo))
(setq soluong (length tachnd))

(cond
((= soluong 6) (gandiemgoc))
((= soluong 4) (gandiemle))
)

)

(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemgoc ()
(setq ttd 0)
(setq tm (nth 0 tachnd))
(setq sd (atof(nth 1 tachnd)))
(setq xg (atof(nth 2 tachnd)))
(setq yg (atof(nth 3 tachnd)))
(setq ag (atof(nth 4 tachnd)))
(setq zg (atof (nth 5 tachnd)))
(setq ddm (list xg yg))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemle ()
(setq ttd (+ ttd 1))
(setq do (nth 0 tachnd))
(setq phut (nth 1 tachnd))
(setq chigiua (atof (nth 2 tachnd)))
(setq chiduoi (atof (nth 3 tachnd)))
(setq gocb (strcat do "d" phut "'" "00" "\""))
(setq gocb (angtof gocb 1))
(setq daib (* (- chigiua chiduoi) 200))
(setq caob (- zg chigiua))
(setq db (polar ddm gocb daib)) 
(setq dbz (list (car db) (cadr db) caob))
(setq tendiem (strcat "tr" tm "d" (rtos ttd 2 0)))
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 150)(cons 50 0)(cons 72 0)(cons 1 (rtos caob 2 2))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_text")(cons 62 256))) 
(entmake (list (cons 0 "POINT")(cons 10 dbz)(cons 8 "layrekhac_point")(cons 62 256))) 
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 150)(cons 50 0)(cons 72 2)(cons 1 tendiem)(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_stt")(cons 62 256))) 
)

Hòm hòm rồi. Không biết đúng sai thế nào. Tên lệnh FTP.

Gỏ lệnh, enter, chọn file số liệu là nó bắn point và text lên cad luôn. đaing để cao text là 150.

[nhoclangbat 392]

-mảng cao độ  em chỉ làm đc đơn giản ah, dẫn chuyền từ cao độ góc tới điểm cần gửi, em ko rành lắm các loại máy và kiểu mia,  mia bên em số đọc 4 số là tính theo (mm) thấp nhất là 0, cái 3067 em hiểu là 3.067 m; chỉ trên và dưới cũng vậy; nếu mia cơ bản khoảng cách = ( trên - dưới)/10 (m) , còn vì sao số liệu anh trên đưa mẫu và file mẫu xuất ra toàn lấy số nguyên thì em chịu, theo file cad thì khoảng cách trạm đầu tới diem đầu tiên là 12600 units, bên địa chính bên em quy ước thì 1 unit trong cad = 1 m ngoài thực địa, ở đây tới 12600 = 12km => máy này đo xa dữ ^^, còn nếu hiểu theo xây dựng thì chỉ 1 unit=1mm => 12.6 m (có vẽ hợp lý hơn)

[duy782006 1.551]

Bởi vậy thông thường bản địa hình thì cao text là 1 hoặc 2 nhưng bắn lên nó có chút xí nên mình mới định cao text thành 150 đó.

[nhoclangbat 392]

- Ấy quên angbase, angdir trong cad anh @duy782006 nó khác quy ước đo đạc ^^, phải qua trái, goc đầu là 0, cad là 90 nên mình phải lấy góc đo + 90, nhóc quỡn cũng viết thử, hàm thì mót chủ yếu, bỏ nghề lâu rùi nên tư duy giải thuật yếu rùi ^^

(defun LM:roundto ( n p )
    (LM:roundm n (expt 10.0 (- p)))
)
(defun LM:roundm ( n m )
    (* m (atoi (rtos (/ n (float m)) 2 0)))
)
;;ham tao text 3
(defun K_text (pt height string justify layer textstyle mau ang xdata / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 (if layer layer (getvar 'clayer)))
							  (cons 7 (if textstyle textstyle (getvar 'textstyle)))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
			(if xdata (setq lst (append lst xdata)))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  )	;end K:text
;;-------------------------
;-----------------------------------------------------------------
(defun s2d (str / ret)

  (setq ret

  (vl-list->string

	(vl-remove-if

  	'(lambda (x) (or (< x 48) (> x 57)))

  	(reverse (vl-string->list str))

	)

  )

  )

  (angtof

	(vl-list->string

			(reverse

					(vl-string->list

						(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))

					)

			)

	)

  )

)
;=======================================================================
(defun K_readtxt ( txt del / des lst str )
    (if (setq des (open txt "r"))
        (progn
             (while (setq str (read-line des))
                (setq lst (cons (LM:txt->lst str del 0) lst))
            )
            (close des)
        )
    )
    (reverse lst)
)
;====================
(defun LM:txt->lst ( str sep pos / s )
    (cond
        (   (not (setq pos (vl-string-search sep str pos)))
            (if (wcmatch str "\"*\"")
                (list (LM:txt-replacequotes (substr str 2 (- (strlen str) 2))))
                (list str)
            )
        )
        (   (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
                (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
            )
            (LM:txt->lst str sep (+ pos 2))
        )
        (   (wcmatch s "\"*\"")
            (cons
                (LM:txt-replacequotes (substr str 2 (- pos 2)))
                (LM:txt->lst (substr str (+ pos 2)) sep 0)
            )
        )
        (   (cons s (LM:txt->lst (substr str (+ pos 2)) sep 0)))
    )
)

(defun LM:txt-replacequotes ( str / pos )
    (setq pos 0)
    (while (setq pos (vl-string-search  "\"\"" str pos))
        (setq str (vl-string-subst "\"" "\"\"" str pos)
              pos (1+ pos)
        )
    )
    str
)
;---------------
(defun MakePoint (point layer color)
(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")
								(cons 8 (if Layer Layer (getvar "Clayer")))
								(cons 62 (if Color Color 256))
								'(100 . "AcDbPoint")(cons 10 point))))
;=======================================================================================================
(defun c:k5 (/ base dir xdau ydau file S_data cdo_ngam ds_chitiet leng_chitiet phut k_phut canh goc x_k y_k cdo i)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq dir (getvar 'angdir))
(setvar 'angdir 1)
(setq xdau 0 ydau 0)
(if (setq file (getfiled "Select TXT File" "" "txt" 16))
	(progn
		(setq S_data (cdr (K_readtxt file "\t")))
		(setq cdo_ngam  (atoi (nth 5 (nth 0 S_data))))
		(setq ds_chitiet (cdr S_data))
		(setq leng_chitiet (length ds_chitiet))
		(setq i 1)
		(foreach k ds_chitiet
			(setq phut (nth 1 k))
			(if (= (strlen phut) 1)
				(setq k_phut (strcat "0" phut))
				(setq k_phut phut)
			)	
			(setq goc (+ (/ pi 2) (s2d (strcat (nth 0 k) "." k_phut "00"))))
			(setq canh (* 200 (- (atoi (nth 2 k)) (atoi (nth 3 k)))))
			(setq cdo (LM:roundto (/ (- cdo_ngam (atoi (nth 2 k))) 10.0) 0))	
			(setq x_k (+ xdau (* canh (cos goc))))
			(setq y_k (+ ydau (* canh (sin goc))))
			
			(MakePoint (list x_k y_k cdo) "point" 2)
			(K_text (list x_k y_k) 200 (itoa i) "L" "stt" nil 3 nil nil)
			(K_text (mapcar '+ (list x_k y_k) '(0 -250.0 0)) 200 (rtos cdo 2 0) "L" "cdo" nil 4 nil nil)
			(setq i (1+ i))
		)
		(MakePoint (list xdau ydau 3067) "point" 2)
		(K_text (list xdau ydau) 200 "Tram" "L" "tram" nil 1 nil nil)
	)
)
(setvar 'angdir dir)
(setvar 'cmdecho 1)
(princ)
)

 

[duy782006 1.551]

ờ đúng rồi. Góc trong porla tính so với đường nằm ngang.

[duy782006 1.551]

Nếu cái lisp tạo từ cái txt của thớt vẽ ra bản cad là đúng thì lisp này của tôi đã coi là đúng rối đây vì dùng lisp của tôi nó vẻ ra được y chang vây rồi. Đáp ứng được yêu cầu của chủ thớt. 

Tiếc là tôi không dám lấy nó cho vào lisp của tôi vì tôi thấy hơi không có niềm tin. Dừng ở đây nhé thớt đả được cái đúng theo yêu cầu rồi đó.

(defun STR-NUMBER (str / LST LST1 LST2)
(setq lst (vl-string->list str))
(SETQ LST1 (LIST))
(while (setq X (car LST))
(setq LST (CDR LST))
(SETQ LST2 (LIST))
(IF (AND (>= X 48) (<= x 57)) (PROGN (SETQ LST2 (APPEND LST2 (LIST X)))
(WHILE (AND (>= (car LST) 48) (<= (car LST) 57))
(SETQ LST2 (APPEND LST2 (LIST (car LST))))
(SETQ LST (CDR LST))
)
(SETQ LST1 (APPEND LST1 (LIST LST2)))
))
)
(MAPCAR '(LAMBDA (X) (vl-list->string X)) LST1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao file chua noi dung list  
;;;Cu phap su dung (duy:taotxt<list filename listtc) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taotxt<list (filename listtc / filename tapchon dtc)
(setq ndd (open filename "w"))
(foreach dtc listtc
(write-line dtc ndd)
)
(close ndd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao list chua noi dung file
;;;Cu phap su dung (duy:taolist<f tenfile) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taolist<f (filename / filename)
(setq lkq nil)
(setq ndd (open filename "r"))
(while 
(/= nil (setq ddd (read-line ndd)))
(setq lkq (append lkq (list ddd)))
)
(close ndd)
lkq)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ftp ()
(cond
((= toadomay nil) (setq toadomay (list 0 0 0)) )
)

(setq filedo (getfiled "Chon file so lieu" "" "txt" 0))
(setq ndfiledo (duy:taolist<f filedo))

(foreach nddongdo ndfiledo
(setq tachnd (STR-NUMBER nddongdo))
(setq soluong (length tachnd))

(cond
((= soluong 6) (gandiemgoc))
((= soluong 4) (gandiemle))
)

)

(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemgoc ()
(setq ttd 0)
(setq tm (nth 0 tachnd))
(setq sd (nth 1 tachnd))
(setq xg (atof(nth 2 tachnd)))
(setq yg (atof(nth 3 tachnd)))
(setq ag (atof(nth 4 tachnd)))
(setq zg (/ (atof (nth 5 tachnd)) 1))
(setq ddm (list xg yg))
(setq ddmz (list xg yg zg))
(entmake (list (cons 0 "TEXT")(cons 10 ddm)(cons 11 ddm)(cons 40 500)(cons 50 0)(cons 72 0)(cons 1 (rtos zg 2 0))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_text")(cons 62 256))) 
(entmake (list (cons 0 "POINT")(cons 10 ddmz)(cons 8 "layrekhac_point")(cons 62 256))) 
(entmake (list (cons 0 "TEXT")(cons 10 ddm)(cons 11 ddm)(cons 40 500)(cons 50 0)(cons 72 2)(cons 1 (strcat "tram may" tm))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_stt")(cons 62 256))) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemle ()
(setq ttd (+ ttd 1))
(setq do (nth 0 tachnd))
(setq phut (nth 1 tachnd))
(setq chigiua (/ (atof (nth 2 tachnd)) 1))
(setq chiduoi (/ (atof (nth 3 tachnd)) 1))
(setq gocb (strcat do "d" phut "'" "00" "\""))
(setq gocb (- (/ PI 2) (angtof gocb 1) ))
(setq daib (* (- chigiua chiduoi) 200))
(setq caob (- zg chigiua))
(setq db (polar ddm gocb daib)) 
(setq dbz (list (car db) (cadr db) caob))
(setq tendiem (strcat tm "-" (rtos ttd 2 0)))
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 500)(cons 50 0)(cons 72 0)(cons 1 (rtos caob 2 0))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_text")(cons 62 256))) 
(entmake (list (cons 0 "POINT")(cons 10 dbz)(cons 8 "layrekhac_point")(cons 62 256))) 
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 500)(cons 50 0)(cons 72 2)(cons 1 tendiem)(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_stt")(cons 62 256))) 
)

Lệnh là FTP.

[HOAILINHLINH 23]

2 giờ trước, duy782006 đã nói:

Nếu cái lisp tạo từ cái txt của thớt vẽ ra bản cad là đúng thì lisp này của tôi đã coi là đúng rối đây vì dùng lisp của tôi nó vẻ ra được y chang vây rồi. Đáp ứng được yêu cầu của chủ thớt. 

Tiếc là tôi không dám lấy nó cho vào lisp của tôi vì tôi thấy hơi không có niềm tin. Dừng ở đây nhé thớt đả được cái đúng theo yêu cầu rồi đó.

• ftp.lsp
  
• [✎]
   

(defun STR-NUMBER (str / LST LST1 LST2)
(setq lst (vl-string->list str))
(SETQ LST1 (LIST))
(while (setq X (car LST))
(setq LST (CDR LST))
(SETQ LST2 (LIST))
(IF (AND (>= X 48) (<= x 57)) (PROGN (SETQ LST2 (APPEND LST2 (LIST X)))
(WHILE (AND (>= (car LST) 48) (<= (car LST) 57))
(SETQ LST2 (APPEND LST2 (LIST (car LST))))
(SETQ LST (CDR LST))
)
(SETQ LST1 (APPEND LST1 (LIST LST2)))
))
)
(MAPCAR '(LAMBDA (X) (vl-list->string X)) LST1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Tao file chua noi dung list  
;;Cu phap su dung (duy:taotxt<list filename listtc) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taotxt<list (filename listtc / filename tapchon dtc)
(setq ndd (open filename "w"))
(foreach dtc listtc
(write-line dtc ndd)
)
(close ndd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Tao list chua noi dung file
;;Cu phap su dung (duy:taolist<f tenfile) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:taolist<f (filename / filename)
(setq lkq nil)
(setq ndd (open filename "r"))
(while 
(/= nil (setq ddd (read-line ndd)))
(setq lkq (append lkq (list ddd)))
)
(close ndd)
lkq)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ftp ()
(cond
((= toadomay nil) (setq toadomay (list 0 0 0)) )
)

(setq filedo (getfiled "Chon file so lieu" "" "txt" 0))
(setq ndfiledo (duy:taolist<f filedo))

(foreach nddongdo ndfiledo
(setq tachnd (STR-NUMBER nddongdo))
(setq soluong (length tachnd))

(cond
((= soluong 6) (gandiemgoc))
((= soluong 4) (gandiemle))
)

)

(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemgoc ()
(setq ttd 0)
(setq tm (nth 0 tachnd))
(setq sd (nth 1 tachnd))
(setq xg (atof(nth 2 tachnd)))
(setq yg (atof(nth 3 tachnd)))
(setq ag (atof(nth 4 tachnd)))
(setq zg (/ (atof (nth 5 tachnd)) 1))
(setq ddm (list xg yg))
(setq ddmz (list xg yg zg))
(entmake (list (cons 0 "TEXT")(cons 10 ddm)(cons 11 ddm)(cons 40 500)(cons 50 0)(cons 72 0)(cons 1 (rtos zg 2 0))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_text")(cons 62 256))) 
(entmake (list (cons 0 "POINT")(cons 10 ddmz)(cons 8 "layrekhac_point")(cons 62 256))) 
(entmake (list (cons 0 "TEXT")(cons 10 ddm)(cons 11 ddm)(cons 40 500)(cons 50 0)(cons 72 2)(cons 1 (strcat "tram may" tm))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_stt")(cons 62 256))) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gandiemle ()
(setq ttd (+ ttd 1))
(setq do (nth 0 tachnd))
(setq phut (nth 1 tachnd))
(setq chigiua (/ (atof (nth 2 tachnd)) 1))
(setq chiduoi (/ (atof (nth 3 tachnd)) 1))
(setq gocb (strcat do "d" phut "'" "00" "\""))
(setq gocb (- (/ PI 2) (angtof gocb 1) ))
(setq daib (* (- chigiua chiduoi) 200))
(setq caob (- zg chigiua))
(setq db (polar ddm gocb daib)) 
(setq dbz (list (car db) (cadr db) caob))
(setq tendiem (strcat tm "-" (rtos ttd 2 0)))
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 500)(cons 50 0)(cons 72 0)(cons 1 (rtos caob 2 0))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_text")(cons 62 256))) 
(entmake (list (cons 0 "POINT")(cons 10 dbz)(cons 8 "layrekhac_point")(cons 62 256))) 
(entmake (list (cons 0 "TEXT")(cons 10 db)(cons 11 db)(cons 40 500)(cons 50 0)(cons 72 2)(cons 1 tendiem)(cons 7 (getvar "TEXTSTYLE"))(cons 8 "layrekhac_stt")(cons 62 256))) 
)

Lệnh là FTP.

Mới gọi đèn đo xong nên chưa test cảm ơn bác duy  và các bác khác đã nhiệt tình cảm ơn tất cả