Bảng toạ độ các đỉnh thửa đất

[vinataba 3]

Dùng phương án 1, vẽ thêm pline làm gì cho lằng nhằng! Tuy nhiên, có mấy điều cần làm rõ:

1) Điểm là đối tượng point đúng không?

2) Tên điểm lấy ở đâu? Hay là phải pick từng điểm và lấy theo số thứ tự khi pick?

3) Có ghi text biểu diễn số thứ tự cho point hay không? Nếu có thì vị trí tương đối của điểm insert text so với point như thế nào?

4) Quy cách bảng (chiều rộng các row và column) theo như chương trình vừa rồi đuợc không?

 

hi bác SSG.

1) Điểm là đối tượng point.

2) Một điểm bao giờ cũng có ( tên điểm, X, Y, Z), tên điểm là thứ tự lần lượt từ 1-->n

3) không cần ghi text biểu diễn số thứ tự cho point vì nó có tên điểm rồi

4) quy cách bảng như của bác là Ok rồi.

thanks SSG

[thanhgam2003 1]

I'm sorry! DTR là function rất thông dụng của dân lisp để đổi độ sang radian. Vì quá thông dụng nên mình quên mất! Khi lập xong chương trình bao giờ mình cũng disable toàn bộ các lisp mình hay dùng (luôn ở chế độ autoload) trước khi test. Lần này sơ suất thế nào đã bị "lọt lưới", và tất nhiên là trên máy mình nó không báo lỗi.

Bạn chỉ thêm vào function DTR là OK (đã sửa lại trong code post ở trên):

 

(defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL

 

Mình không hiểu lắm về cái món làm bản đồ. Bạn thanhgam yêu cầu mỗi thửa là 1 table ghi tọa độ. Nếu làm hàng loạt thửa thì các tables sắp xếp như thế nào? Tóm lại là mình chỉ làm đúng như thanhgam đã yêu cầu, còn hay dở thế nào thì các bạn trong nghề góp ý thêm.

Về lệnh boundary (giống như lệnh hatch) đã có nhiều người than phiền. Tuy nhiên, mình thấy nếu cho vùng cần boundary hiển thị đầy đủ trên màn hình thì hầu như không gặp lỗi gì. Dùng boundary chẳng qua là một thủ thuật để AutoCAD tự động lấy biên giúp mình, bất kể các đối tượng để tạo nên nó là kiểu gì, nó đều tạo ra 1 pline kín. Mục đích: chương trình sẽ mang tính tổng quát hơn, có thể áp dụng cho nhiều ngành khác có nhu cầu tương tự, không riêng gì đo đạc, bản đồ.

Cũng nhờ cái closed pline này mà việc coding sẽ đơn giản hơn (mình đã có sẵn khá nhiều public functions để xử lý pline). Trong khi đó, rất khó truy cập database của region bằng lisp. Chính cái boundary tạo thành cũng mang tính chất temporary. Sau khi xong việc mình cũng del nó luôn, trả lại nguyên trạng bản vẽ. Mà mình cũng không hiểu tại sao cứ phải là region? Nếu file bản vẽ đã chuyển toàn bộ các thửa đất từ region sang pline thì sẽ thuận lợi hơn cho người lập trình rất nhiều.

Chờ thanhgam phản hồi, cũng như các bạn quan tâm đến chủ đề này góp ý thêm, mình sẽ sửa luôn thể.

cảm on tất cả các bạn đã quan tâm đến đề tài mà minh đưa ra.

ngay từ đầu mình đã nói rồi đó. minh là dân xã hội nên không hiểu nhiều lắm về lập trình, thâm chí các câu từ mà minh dùng nhiều khi còn "địa phương " quá!!!

Mình thấy các bạn đưa ra khá nhiều khác phương pháp khác nhau để giải quyết và mình cũng biết được thêm nhiều các tiện dụng khác mà cad mang lại.

Bạn có hòi mình là sao đối tựơng mình quan tâm không đưa sang dạng khác mà lúc nào cũng là ReGion? Mình cũng xin nói thêm: Khi minh xử lý HS hầu hết các file cad đều ở dạng region, như thế khi minh copyy hay modify (tạo hatch, đo đạc....)đối tựơng đó mình cảm tâhý rất dễ dàng. Đo đó đối tựơng mà mình quan tâm chính là region. Thứ 2 là: khi mình thụ lý 1HS thì 90% HS tương ứng 1 HS với 1 thửa. Do đó, mình chưa thấy ưu và khuyết điểm khi chạy tọa độ 1 thửa và nhiều thửa

Minh nghĩ, không chỉ các pác bên nhà đất quan tâm đến đề tài này đâu!!! Nếu pa kon nào có y tưởng gì, hỹa tiếp tục đưa vào để mình tìm ra phương pháp giải quyết tối ưu nhé

[ssg 1.102]

cảm on tất cả các bạn đã quan tâm đến đề tài mà minh đưa ra.

ngay từ đầu mình đã nói rồi đó. minh là dân xã hội nên không hiểu nhiều lắm về lập trình, thâm chí các câu từ mà minh dùng nhiều khi còn "địa phương " quá!!!

Mình thấy các bạn đưa ra khá nhiều khác phương pháp khác nhau để giải quyết và mình cũng biết được thêm nhiều các tiện dụng khác mà cad mang lại.

Bạn có hòi mình là sao đối tựơng mình quan tâm không đưa sang dạng khác mà lúc nào cũng là ReGion? Mình cũng xin nói thêm: Khi minh xử lý HS hầu hết các file cad đều ở dạng region, như thế khi minh copyy hay modify (tạo hatch, đo đạc....)đối tựơng đó mình cảm tâhý rất dễ dàng. Đo đó đối tựơng mà mình quan tâm chính là region. Thứ 2 là: khi mình thụ lý 1HS thì 90% HS tương ứng 1 HS với 1 thửa. Do đó, mình chưa thấy ưu và khuyết điểm khi chạy tọa độ 1 thửa và nhiều thửa

Minh nghĩ, không chỉ các pác bên nhà đất quan tâm đến đề tài này đâu!!! Nếu pa kon nào có y tưởng gì, hỹa tiếp tục đưa vào để mình tìm ra phương pháp giải quyết tối ưu nhé

Tham khảo ý kiến nhiều người là điều nên làm. Nhưng bạn là người đưa ra topic này thì cũng chính bạn là người chốt lại vấn đề. Cụ thể, chương trình lisp mình đã post cần sửa đổi, bổ sung những gì?

Ngoài ra, mình cũng xem xét cả yêu cầu của bạn vinataba và có thể gộp cả 2 yêu cầu trong cùng 1 chương trình, tùy trường hợp mà sử dụng.

Có 1 điểm khá quan trọng, ảnh hưởng đến "đường lối" lập trình là đối tượng text ghi số thứ tự của các đỉnh pline, region hoặc point. Thứ tự ghi như thế nào: điểm bắt đầu, thuận hay ngược kim đồng hồ, hay là người dùng tự ghi sẵn? Về chỗ này, yêu cầu của bạn và vinataba khác nhau, cần phải có sự thống nhất.

Tóm lại, mình sẽ không làm gì thêm nếu chưa có bản tổng hợp các yêu cầu cuối cùng.

[thanhgam2003 1]

Tham khảo ý kiến nhiều người là điều nên làm. Nhưng bạn là người đưa ra topic này thì cũng chính bạn là người chốt lại vấn đề. Cụ thể, chương trình lisp mình đã post cần sửa đổi, bổ sung những gì?

Ngoài ra, mình cũng xem xét cả yêu cầu của bạn vinataba và có thể gộp cả 2 yêu cầu trong cùng 1 chương trình, tùy trường hợp mà sử dụng.

Có 1 điểm khá quan trọng, ảnh hưởng đến "đường lối" lập trình là đối tượng text ghi số thứ tự của các đỉnh pline, region hoặc point. Thứ tự ghi như thế nào: điểm bắt đầu, thuận hay ngược kim đồng hồ, hay là người dùng tự ghi sẵn? Về chỗ này, yêu cầu của bạn và vinataba khác nhau, cần phải có sự thống nhất.

Tóm lại, mình sẽ không làm gì thêm nếu chưa có bản tổng hợp các yêu cầu cuối cùng.

hi, chào bạn

Mình cảm thấy hình như bạn hơi nóng tính.

Không biết bạn đã đọc hết các câu hỏi, bài trả lời cũng như hình mình post lên chưa?

Minh đã gửi hình và yêu cầu của mình là: điểm thuận chiều kim đồng hồ, thứ tự các điểm ghi là do chương trình tự chạy (Điểm không bắt buộc phải ghi từ đâu, miễm là thuận chiều kim đồng hồ, điểm ghi lên có tỉ lệ tương đối với hình vẽ).

Mình đã nói là không biết gì về lập trình, nên bạn có gửi code cho minh thì mình cũng không kiểm nghiệm được sự đúng hay của nó, trừ khi bạn gửi cho minh 1 file lsp hướng dân chi tếit sử dụng thì mình mới có câu trả lời chính xác của bạn!!!.

Hơn nữa mấy đường link file bạn post lên bị lỗi rồi, mình khong vào được.

Có bạn nào nói là yêu cầu này đã được Hài Hòa làm? vậy bạn cho minh hỏi là Hài Hòa Miền Bắc hay Tp. HCM thế? Vì theo minh biết HH có 2 cơ sở mà? Mình muốn biết chính xác cơ sở nào để tiện liên hệ?

[ssg 1.102]

hi, chào bạn

Mình cảm thấy hình như bạn hơi nóng tính.

Không biết bạn đã đọc hết các câu hỏi, bài trả lời cũng như hình mình post lên chưa?

Minh đã gửi hình và yêu cầu của mình là: điểm thuận chiều kim đồng hồ, thứ tự các điểm ghi là do chương trình tự chạy (Điểm không bắt buộc phải ghi từ đâu, miễm là thuận chiều kim đồng hồ, điểm ghi lên có tỉ lệ tương đối với hình vẽ).

Mình đã nói là không biết gì về lập trình, nên bạn có gửi code cho minh thì mình cũng không kiểm nghiệm được sự đúng hay của nó, trừ khi bạn gửi cho minh 1 file lsp hướng dân chi tếit sử dụng thì mình mới có câu trả lời chính xác của bạn!!!.

Hơn nữa mấy đường link file bạn post lên bị lỗi rồi, mình khong vào được.

Có bạn nào nói là yêu cầu này đã được Hài Hòa làm? vậy bạn cho minh hỏi là Hài Hòa Miền Bắc hay Tp. HCM thế? Vì theo minh biết HH có 2 cơ sở mà? Mình muốn biết chính xác cơ sở nào để tiện liên hệ?

1) Ssg tôi nóng tính? Cái đó để mọi người nhận xét. Nếu quả thật như vậy thì xin rút kinh nghệm.

2) Đính chính: ssg chưa bao giờ post cái link nào trong phạm vi topic này mà bạn bảo là link lỗi! Mình chỉ có 1 chương trình lisp, đáp ứng gần như đúng yêu cầu của bạn, chỉ khác 1 điểm là chiều đánh số ngược kim đồng hồ. Lý do: tại thời điểm lập trình, bạn chưa hề nêu yêu cầu là đánh số theo chiều nào.

3) Chương trình lisp nói trên hiện vẫn còn sờ sờ ra đó. Hầu như mọi người quan tâm đến topic này đều biết và đã dùng thử, chỉ trừ có bạn!

4) Sử dụng lisp rất đơn giản, không cần biết một tí gì về lập trình, bạn không phải nhắc đi nhắc lại nhiều lần. Nếu bạn chưa biết dùng lisp (tình huống ngoài dự kiến) thì xin hướng dẫn vắn tắt:

- Copy code, paste vào Notepad, save dạng *.lsp (đừng hỏi là code đó ở đâu nhé!)

- Chạy lệnh appload, load nó vào

- Gõ lệnh lisp và đáp ứng các yêu cầu của nó. Tên lệnh lisp, nếu người viết code không giới thiệu thì tìm trong code các chữ ở kề ngay sau dấu 2 chấm của dòng (defun C:XXXX...). Cụ thể, với trình lisp của mình, tên lệnh là VC.

Muốn biết cụ thể hơn, bạn tìm đọc mấy bài hướng dẫn chi tiết về sử dụng lisp đã post khá nhiều trên diễn đàn.

[vinataba 3]

vấn đề là cả 2 Bác đều nóng tính .thật ra ở đây có 2 vấn đề

1. anh Thanhgam2003 làm việc với hồ sơ thửa đất nên chỉ cần tọa độ các đỉnh của ô đất mà không quan trọng cách đánh số thứ tự vị trí

2. Đối với Vinataba, mình làm trong xây dựng và mình cần lisp này để kiểm tra tọa độ của cọc khoan nhồi nên thứ tự của cọc rất quan trọng. và text tên điểm thì được chèn ngại tại vị trí của point vì vậy chỉ cần lấy giá trị của text này là được

 

Mình gửi bác SSG file có sãn vị trí các điểm và vị trí của text

http://www.cadviet.com/upfiles/VD.rar

thanks các Bác

[se7en 5]

:)

1. oh No, không phải là employee của Hài Hoà đâu. Chỉ biết vì có lần thấy ông anh tôi chạy thử soft đó thôi. Hài Hoà có dùng khoá cứng nên có cài vào mà không có khoá cũng không chạy được...hic...

 

2. Đoạn Lisp của bác không hiểu sao khi chạy nó báo lỗi "error: no function definition: DTR"

 

3. Theo tôi cách bác ssg dùng cái hàm "BOUNDARY" để tạo 1 "vùng" là không tiện vì như thế ta phải pick nhiều lắm nếu có nhiều thửa. Việc tạo vùng đó để cho user tự làm khi họ vẽ (phải bắt buộc thôi). Thực ra nếu bạn gì đó mà làm cái hồ sơ thửa này thì nên cài bản AUTOCAD MAP chứ đừng cài AUTOCAD thông thường (có các phiên bản cho các ngành như ACAD MAP, ACAD MECHANIC, ACAD ARTCHITEC...) trong phiên bản ACADMAP có thêm một menu MAP gồm các lệnh chuyên cho làm bản đồ và việc tạo vùng tự động cho mấy cái thửa kia chỉ là tíc tắc. Khoai Tây đã làm sẵn rồi thì Khoai Lang cứ thế mà dùng thôi :)

 

Nên chăng ssg hãy chọn cách là khi chuơng trình chạy thì cho thông báo "Select close_region" chẳng hạn, như vậy thì user có thể chọn được nhiều Object và tránh được việc "BOUNDARY" bị lỗi khi pick vào trong region (thi thoảng tôi pick vào trong 1 vùng để tạo close_region thì hàm BOUNDARY nó báo lỗi mà không hiểu tại sao)

cần gì fải tạo topology trong cad map như bạn elleHCSC nói, yêu cầu của thanhgam2003 như mình nói ban đầu chẳng khác gì trích hồ sơ kỹ thuật thửa đất,hồi xưa có dùng đến cái này rùi,có gì mình sẽ tìm lại các module ấy cho bạn, để đâu lâu quá hổng nhớ nữa, còn k mình sẽ gửi bạn file dvb của mình lại cho bạn sau, gửi liền không được vì mình đang đi du lịch mất tiêu rùi).

[thanhgam2003 1]

cần gì fải tạo topology trong cad map như bạn elleHCSC nói, yêu cầu của thanhgam2003 như mình nói ban đầu chẳng khác gì trích hồ sơ kỹ thuật thửa đất,hồi xưa có dùng đến cái này rùi,có gì mình sẽ tìm lại các module ấy cho bạn, để đâu lâu quá hổng nhớ nữa, còn k mình sẽ gửi bạn file dvb của mình lại cho bạn sau, gửi liền không được vì mình đang đi du lịch mất tiêu rùi).

Đúng rồi đó.

Mình đang làm bên lĩnh vực đất đai mà.

Khi nào du lịch về, pac gửi cho em xem với nhé.

Chúc pac có cuộc hành trình vui vẻ.

[ssg 1.102]

... mình làm trong xây dựng và mình cần lisp này để kiểm tra tọa độ của cọc khoan nhồi nên thứ tự của cọc rất quan trọng. và text tên điểm thì được chèn ngay tại vị trí của point vì vậy chỉ cần lấy giá trị của text này là được

 

Mình gửi bác SSG file có sãn vị trí các điểm và vị trí của text

http://www.cadviet.com/upfiles/VD.rar

thanks các Bác

 

Chương trình hôm nọ vẽ bảng gọi là "cho vui" thôi, chỉ có thể dùng với các bảng ngắn ngắn, số lượng dữ liệu ít. Trường hợp của bạn số lượng dữ liệu khá nhiều. Cách thức bài bản hơn là xuất tọa độ các điểm cũng như tên điểm sang Excel, sau đó tùy ý xử lý và insert lại vào Cad. Cách này có ưu điểm nổi bật là bạn có thể dùng các công cụ Excel để xử lý dữ liệu cho nhiều mục đích khác nhau.

Tên lệnh là EP (Export Points). Sau khi export, chương trình sẽ tự khởi động Excel và open file.

 

Các điểm lưu ý:

- Text ghi thứ tự điểm phải có tọa độ x, y (của điểm insert) trùng với x, y của point (có thể khác z). Nếu không, chương trình tìm không thấy text sẽ mặc định gán số thứ tự là 0! Bản vẽ bạn gởi có vài điểm như vậy.

- Lisp không có khả năng can thiệp vào cầu trúc file của *.xls. Mặc dù lưu ở dạng *.xls nhưng bản chất của nó vẫn là text file, các field được phân biệt bằng 1 dấu tab. Tuy vậy, trình Excel vẫn hiểu và open được loại file này.

- Khi save, Excel sẽ hỏi "Do you want keep the workbook in this format?”. Nếu bạn muốn file được chuyển thành “*.xls thật sự” thì phải trả lời “No”, sau đó save đè lên file có hiện có là xong.

 

;;;**********************************************************
;;;This program export coordinate of points and ordinal numbers to Excel
;;;Each ordinal number must be the same x, y as correlative point_
;;;otherwise it is assigned "0" value.
;;;The file save as *.xls but data structure still are text file.
;;;If you want convert them to actual *.xls file, when save Excel ask:_
;;;"Do you want keep the workbook in this format?", you must answer "No".
;;;Written by Ssg - December 2007 - www.cadviet.com
;;;**********************************************************


;;;--------------------------------------------------------------------
(defun ss2Lp(ssp / Lp i e p) ;;;Convert ss of points to list of 3Dpoints
(setq i 0 Lp nil)
(repeat (sslength ssp) 
   (setq
       e (ssname ssp i)
       p (cdr (assoc 10 (entget e)))
       Lp (append Lp (list p))
       i (1+ i)
   )
)
Lp
)
;;;-------------------------------------------------------------------------------
(defun C:EP(/ ssp Lp Ld fn f p sst txt rec L1) ;;;Export Points
(setq
   ssp (ssget '((0 . "POINT")))
   Lp (ss2Lp ssp)
   Ld nil
   fn (getfiled "title" "" "xls" 1)
   f (open fn "w")
)
(princ "TT\tX\tY\tZ" f)
(foreach p Lp
   (if (setq sst (ssget "x" (list (cons 0 "TEXT") (cons -4 "=,=,*") (cons 10 p))))
       (setq txt (cdr (assoc 1 (entget (ssname sst 0)))))
       (setq txt "0")
   )
   (setq
       rec (cons (atoi txt) p)
       Ld (append Ld (list rec))
   )
)
(setq Ld (vl-sort Ld '(lambda (x y) (< (car x) (car y)))))
(foreach L1 Ld
   (princ (strcat "\n" (rtos (car L1)) "\t" (rtos (cadr L1)) "\t"
                       (rtos (caddr L1)) "\t" (rtos (cadddr L1))) f) 
)
(close f)
(alert "Finish export! Program will start Excel and open data file...")
(command "start" (strcat "excel " fn))  
)
;;;-------------------------------------------------------------------------------

[vinataba 3]

cảm ơn bác SSG, chương trình chạy quá tuyệt.

[se7en 5]

Gửi thanhgam2003 file trích tọa độ.Bạn Load file này trong cad xong làm như sau:

1/Tạo 1 text style có tên là vhelven (nhớ viết đúng tên vì chương trình dùng đúng style này, còn trong style này bạn chọn font gì cũng được, nhưng nên chọn VNI vì sẽ xuất ra tiếng việt).

2/sau đó gõ lệnh xy

-Chọn tỷ lệ bản vẽ.

-Chọn xuất ra bản vẽ. (:)

-Click điểm hay chọn đối tượng thì tùy bạn. Nếu click điểm thì chọn khép điểm hay không khép điểm. Trong trích xuất hồ sơ kỹ thuật thửa đất dùng cho địa chính thì nên chọn khép điểm.

-Chọn vi trí chèn bảng tọa độ.

 

Khuyết điểm : bảng tọa độ trong CAD bao gồm nhiều đối tượng riêng lẻ.

Bạn có cần xuất sang excel không hay chỉ thế là ok rùi? nếu cần thì nói để mình gửi module đó cho.

Nó nè :

http://www.yourfilehost.com/media.php?cat=...amp;file=xy.FAS

 

Chúc dzui dzẻ. :)

[elleHCSC 98]

To SSG !

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;This program make ordinal numbers and co-ordinate table for vertexs.
;;;Accept any objects that are Region, Polyline, Line and Arc (except Spline)
;;;providing there is a closed area between them.
;;;Written by Ssg - December 2007 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun getth( / d h) ;;;Return current text height
(setq
d (tblsearch "style" (getvar "textstyle"))
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
h
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p / sty d h) ;;;Write txt on graphic screen, Middle Center
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
)
(if (> h1 0) (command "text" "j" "mc" p 0 txt)
(command "text" "j" "mc" p h2 0 txt)
)
)
;;;-------------------------------------------------------------------------------
;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 6 h))
p3 (polar p2 0 (* 8 h))
p4 (polar p3 0 (* 8 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL))
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun mesh1() ;;;Make 1 mesh unit
(linepy p0 (* -3 h))
(command "copy" "L" "" p0 (list (+ (car p0) (* 4 h)) (cadr p0)))
(command "array" "L" "" "r" 1 4 (* 8 h))
(linepx (polar p0 (* 1.5 pi) (* 3 h)) (* 28 h))
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / p et p0 pvL h oldos i pv num txtL)
;;;Vertex Co-ordinate

;;;INPUT DATA
(setq p (getpoint "\nPick a point inside polygon or region:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
p0 (getpoint "\nBase point of table (upper left):")
pvL (getvert et)
h (getTh)
oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 28 h))
(mesh1)
(txt1 (list "TT" "X" "Y" "Z"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS AND ORDINAL NUMBER
(setq i 0)
(repeat (1- (length pvL))
(mesh1)
(setq
pv (nth i pvL)
num (itoa (1+ i))
txtL (list num (rtos (car pv)) (rtos (cadr pv)) (rtos (caddr pv)))
)
(txt1 txtL)
(wtxtMC num (polar pv 0 h))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
(setq i (1+ i))
)

;;;FINISH
(command "erase" et "")
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

 

Bác SSG có thể giúp làm cho cái CT ở trên khi chạy số thứ tự đỉnh sẽ theo chiều thuận kim đồng hồ không ? vì khi dùng lệnh BO bao giờ cad cũng cho các đỉnh theo chiều ngược kim đồng hồ.

Tôi ko rành về lisp lắm nên ko biết cách sửa đoạn code trên mặc dù về thuật toán thì tôi biết làm thế nào để cho các đỉnh thửa chạy theo chiều thuận kim đồng hồ. VD các vertex List(x1y1, x2y2, xiyi...) thì khi đánh số thứ tự chỉ việc đảo ngược lại .

 

TKS

[ssg 1.102]

...

;;;INPUT DATA

(setq p (getpoint "\nPick a point inside polygon or region:"))

(command "boundary" p "")

(setq et (entlast))

(redraw et 3)

(setq

p0 (getpoint "\nBase point of table (upper left):")

pvL (reverse (getvert et))

h (getTh)

oldos (getvar "osmode")

)

...

 

Bác SSG có thể giúp làm cho cái CT ở trên khi chạy số thứ tự đỉnh sẽ theo chiều thuận kim đồng hồ không?

TKS

Bạn chỉ cần sửa như chỗ đánh dấu đỏ.

Lần sau bạn đừng nên trích dẫn dài như vậy. Nếu cần, cho nó vào hộp codebox.

[vinataba 3]

Các điểm lưu ý:

- Text ghi thứ tự điểm phải có tọa độ x, y (của điểm insert) trùng với x, y của point (có thể khác z). Nếu không, chương trình tìm không thấy text sẽ mặc định gán số thứ tự là 0! Bản vẽ bạn gởi có vài điểm như vậy.

- Lisp không có khả năng can thiệp vào cầu trúc file của *.xls. Mặc dù lưu ở dạng *.xls nhưng bản chất của nó vẫn là text file, các field được phân biệt bằng 1 dấu tab. Tuy vậy, trình Excel vẫn hiểu và open được loại file này.

- Khi save, Excel sẽ hỏi "Do you want keep the workbook in this format?”. Nếu bạn muốn file được chuyển thành “*.xls thật sự” thì phải trả lời “No”, sau đó save đè lên file có hiện có là xong.

 

Chào bác SSG, chương trình này chạy rất tốt. Nhờ bác làm giúp bài toán ngược lại được không. Tức là mình có file *.xls như cấu trúc xuất ra từ lisp, bây giờ mình vẽ lại thành các điểm point. Cảm ơn bác rất nhiều. ­

[se7en 5]

Các điểm lưu ý:

- Text ghi thứ tự điểm phải có tọa độ x, y (của điểm insert) trùng với x, y của point (có thể khác z). Nếu không, chương trình tìm không thấy text sẽ mặc định gán số thứ tự là 0! Bản vẽ bạn gởi có vài điểm như vậy.

- Lisp không có khả năng can thiệp vào cầu trúc file của *.xls. Mặc dù lưu ở dạng *.xls nhưng bản chất của nó vẫn là text file, các field được phân biệt bằng 1 dấu tab. Tuy vậy, trình Excel vẫn hiểu và open được loại file này.

- Khi save, Excel sẽ hỏi "Do you want keep the workbook in this format?”. Nếu bạn muốn file được chuyển thành “*.xls thật sự” thì phải trả lời “No”, sau đó save đè lên file có hiện có là xong.

 

Chào bác SSG, chương trình này chạy rất tốt. Nhờ bác làm giúp bài toán ngược lại được không. Tức là mình có file *.xls như cấu trúc xuất ra từ lisp, bây giờ mình vẽ lại thành các điểm point. Cảm ơn bác rất nhiều. ­

Bài toàn ngược lại thì các chương trình đã có tích hợp sẵn rùi chẳng hạn như land desktop đều có thể import điểm vào từ nhiều định dạng file khác nhau.

[thanhgam2003 1]

Gửi anh SSG

 

- Trong trường hợp em không muốn thể hiện thông tin cột Z, chỉ thể 3 cột: STT, X, Y

- Midle center cho đối tượng Text

- Bảng tọa độ xuất ra dạng block

- Size text =1 hoặc theo ý người dùng

thì em phải làm như thế nào trong đoạn code anh đã gửi.

 

 

cảm ơn anh rất nhiều.

[ssg 1.102]

Gửi anh SSG

 

- Trong trường hợp em không muốn thể hiện thông tin cột Z, chỉ thể 3 cột: STT, X, Y

- Midle center cho đối tượng Text

- Bảng tọa độ xuất ra dạng block

- Size text =1 hoặc theo ý người dùng

thì em phải làm như thế nào trong đoạn code anh đã gửi.

 

 

cảm ơn anh rất nhiều.

Không vấn đề gì. Có mấy điểm cần hỏi lại bạn cho chắc:

 

1- Mình đã sửa code mấy lần theo yêu cầu của nhiều người khác nhau. Ý bạn có phải đoạn code đầu tiên mình đã post ngày 7-12-2007 không?

 

2- Tạo block cho cả bảng toạ độ bao gồm các đường kẻ và các text đúng không? Đặt tên block là gì?

 

3- Ssg sửa luôn hay là gợi ý để bạn tự sửa?

[thanhgam2003 1]

Không vấn đề gì. Có mấy điểm cần hỏi lại bạn cho chắc:

 

1- Mình đã sửa code mấy lần theo yêu cầu của nhiều người khác nhau. Ý bạn có phải đoạn code đầu tiên mình đã post ngày 7-12-2007 không?

 

2- Tạo block cho cả bảng toạ độ bao gồm các đường kẻ và các text đúng không? Đặt tên block là gì?

 

3- Ssg sửa luôn hay là gợi ý để bạn tự sửa?

 

Lisp anh upload ngày đó em không download về được, mà em coppy phần "elleHCSC" load lại ngày Dec 27 2007, 11:35 và kèm theo phần có sửa một số cái. nội dung lisp như sau:

 

(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL

;;;-------------------------------------------------------------------------------

(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius

(setq p1 (polar p0 (dtr a) r)

)

(command "line" p0 p1 "")

)

;;;-------------------------------------------------------------------------------

(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0

;;;-------------------------------------------------------------------------------

(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0

;;;-------------------------------------------------------------------------------

(defun getVert (e / i L) ;;;Return list of all vertex from pline e

(setq i 0 L nil)(vl-load-com)

(repeat (fix (+ (vlax-curve-getEndParam e) 1))

(setq L (append L (list (vlax-curve-getPointAtParam e i))))

(setq i (1+ i)))L)

;;;-------------------------------------------------------------------------------

(defun getth( / d h) ;;;Return current text height

(setq

d (tblsearch "style" (getvar "textstyle"))

h (cdr (assoc 40 d))

)

(if (= h 0) (setq h (cdr (assoc 42 d))))h)

;;;-------------------------------------------------------------------------------

(defun wtxtMC (txt p / sty d h) ;;;Write txt on graphic screen, Middle Center

(setq

sty (getvar "textstyle")

d (tblsearch "style" sty)

h1 (cdr (assoc 40 d))

h2 (cdr (assoc 42 d)))

(if (> h1 0) (command "text" "j" "mc" p 0 txt)

(command "text" "j" "mc" p h2 0 txt)

)

)

;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS

;;;-------------------------------------------------------------------------------

(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row

(setq

p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))

p2 (polar p1 0 (* 6 h))

p3 (polar p2 0 (* 8 h))

p4 (polar p3 0 (* 8 h))

pL (list p1 p2 p3 p4)

i 0)

(repeat 4(wtxtMC (nth i txtL) (nth i pL))

(setq i (1+ i))

)

)

;;;-------------------------------------------------------------------------------

(defun mesh1() ;;;Make 1 mesh unit

(linepy p0 (* -3 h))

(command "copy" "L" "" p0 (list (+ (car p0) (* 4 h)) (cadr p0)))(

command "array" "L" "" "r" 1 4 (* 8 h))

(linepx (polar p0 (* 1.5 pi) (* 3 h)) (* 28 h)))

;;;-------------------------------------------------------------------------------

;;;MAIN PROGRAM

;;;-------------------------------------------------------------------------------

(defun C:VC( / p et p0 pvL h oldos i pv num txtL)

;;;Vertex Co-ordinate

;;;INPUT DATA

(setq p (getpoint "\nPick a point inside polygon or region:"))

(command "boundary" p "")

(setq et (entlast))

(redraw et 3)

 

 

2. Tạo block cho cả bảng toạ độ bao gồm các đường kẻ và các text. Tên Block tùy anh đặt. Nhưng text phải nằm giu7a4 ô. Bởi với chức năng này cho phép anh scale tỉ lệ dễ dàng đối với các đối tượng có diện tích nhỏ

3. Nhờ anh sửa giúp dùm em được ko?

 

 

Cảm ơn anh.

[ssg 1.102]

Gửi anh SSG

 

- Trong trường hợp em không muốn thể hiện thông tin cột Z, chỉ thể 3 cột: STT, X, Y

- Midle center cho đối tượng Text

- Bảng tọa độ xuất ra dạng block

- Size text =1 hoặc theo ý người dùng

thì em phải làm như thế nào trong đoạn code anh đã gửi.

cảm ơn anh rất nhiều.

Lisp đã sửa đúng như ý bạn:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by Ssg - September 2008 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
   (setq p1 (polar p0 (dtr a) r))
   (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0  "TEXT") (cons 7 (getvar "textstyle"))
   (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 h) (cons 72 1) (cons 73  2)))
)
;;;-------------------------------------------------------------------------------


;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 6 h))
   p3 (polar p2 0 (* 8 h))
   p4 (polar p3 0 (* 8 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 3
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun mesh1() ;;;Make 1 mesh unit
(linepy p0 (* -3 h))
(command "copy" "L" "" p0 (list (+ (car p0) (* 4 h)) (cadr p0)))
(command "array" "L" "" "r" 1 3 (* 8 h))
(linepx (polar p0 (* 1.5 pi) (* 3 h)) (* 20 h))
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 pvL oldos j pv num txtL ss bn)
;;;Vertex Co-ordinate

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))
(setvar "osmode" 0)

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
   p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
   p0 p00
   pvL (reverse (getvert et))
   oldos (getvar "osmode")
)

;;;HEADER
(linepx p0 (* 20 h))
(mesh1)
(txt1 (list "TT" "X" "Y"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0)
(repeat (1- (length pvL))
   (mesh1)
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
       txtL (list num (rtos (car pv)) (rtos (cadr pv)) )
   )
   (txt1 txtL)
   ;(wtxtMC num (polar pv 0 h) h)
   (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
   (setq j (1+ j))
)

;;;MAKE BLOCK
(setq ss (collect et))
(command "erase" et "")
(setq bn "1")
(while (tblsearch "block" bn) (setq bn (itoa (1+ (atoi bn)))))
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setq j 0)
(repeat (1- (length pvL))
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h)
   (setq j (1+ j))
)

;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

[ssg 1.102]

Lisp đã sửa đúng như ý bạn...

Xin lỗi bạn, mình quên không đưa vào các function collect (chúng thường xuyên được autoload trên máy mình nên khi test không phát hiện ra)

Bạn dùng cái này. Nếu có gì bất ổn thì phản hồi:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by Ssg - September 2008 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
   (setq p1 (polar p0 (dtr a) r))
   (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0  "TEXT") (cons 7 (getvar "textstyle"))
   (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 h) (cons 72 1) (cons 73  2)))
)
;;;-------------------------------------------------------------------------------
(defun Collect(e / e2 SS) ;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil) (setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 6 h))
   p3 (polar p2 0 (* 8 h))
   p4 (polar p3 0 (* 8 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 3
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun mesh1() ;;;Make 1 mesh unit
(linepy p0 (* -3 h))
(command "copy" "L" "" p0 (list (+ (car p0) (* 4 h)) (cadr p0)))
(command "array" "L" "" "r" 1 3 (* 8 h))
(linepx (polar p0 (* 1.5 pi) (* 3 h)) (* 20 h))
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 pvL oldos j pv num txtL ss bn)
;;;Vertex Co-ordinate

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))
(setvar "osmode" 0)

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
   p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
   p0 p00
   pvL (reverse (getvert et))
   oldos (getvar "osmode")
)

;;;HEADER
(linepx p0 (* 20 h))
(mesh1)
(txt1 (list "TT" "X" "Y"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0)
(repeat (1- (length pvL))
   (mesh1)
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
       txtL (list num (rtos (car pv)) (rtos (cadr pv)) )
   )
   (txt1 txtL)
   ;(wtxtMC num (polar pv 0 h) h)
   (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
   (setq j (1+ j))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(command "erase" et "")
(setq bn "1")
(while (tblsearch "block" bn) (setq bn (itoa (1+ (atoi bn)))))
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setq j 0)
(repeat (1- (length pvL))
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h)
   (setq j (1+ j))
)

;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

[thanhgam2003 1]

Chao SSG

Khi lam hồ sơ thật, em gặp vấn đề sau, anh giup em nhe.

1. khi xuất ra bảng tọa độ, nếu dãy số là 10 số thì cột, ô vuông chứa text không đủ,

2. Vị trí x thay là y, y thay là x vì trong hệ thống tọa độ của bản đồ là ngược lại lại so với tọa độ của cad ma

3. Anh thêm dùm em 1 cột S(m) thể hiện chiều dài theo khoảng cách của các đoạn thẳng

4. Điểm 1 được lặp lại 2 lần trong cột 1

 

Em load kết quả từ cách làm của anh và file em muốn thể hiện, anh coi và giúp em nhé.

 

http://www.cadviet.com/upfiles/guihoi_1.dwg

 

Cảm ơn anh.

[ssg 1.102]

Chao SSG

Khi lam hồ sơ thật, em gặp vấn đề sau, anh giup em nhe.

1. khi xuất ra bảng tọa độ, nếu dãy số là 10 số thì cột, ô vuông chứa text không đủ,

2. Vị trí x thay là y, y thay là x vì trong hệ thống tọa độ của bản đồ là ngược lại lại so với tọa độ của cad ma

3. Anh thêm dùm em 1 cột S(m) thể hiện chiều dài theo khoảng cách của các đoạn thẳng

4. Điểm 1 được lặp lại 2 lần trong cột 1

 

Em load kết quả từ cách làm của anh và file em muốn thể hiện, anh coi và giúp em nhé.

 

http://www.cadviet.com/upfiles/guihoi_1.dwg

 

Cảm ơn anh.

OK, mình đã xem bản vẽ. Tất cả những vấn đề trên đều làm được. Nhưng thong thả nhé, mình cũng đang hơi bận việc...

[thanhgam2003 1]

OK, mình đã xem bản vẽ. Tất cả những vấn đề trên đều làm được. Nhưng thong thả nhé, mình cũng đang hơi bận việc...

 

 

da. anh nhanh nhanh bớt chút thời gian giup em nhé. Em đang rất cần.

 

 

cảm ơn anh.

[ssg 1.102]

Chao SSG

Khi lam hồ sơ thật, em gặp vấn đề sau, anh giup em nhe.

1. khi xuất ra bảng tọa độ, nếu dãy số là 10 số thì cột, ô vuông chứa text không đủ,

2. Vị trí x thay là y, y thay là x vì trong hệ thống tọa độ của bản đồ là ngược lại lại so với tọa độ của cad ma

3. Anh thêm dùm em 1 cột S(m) thể hiện chiều dài theo khoảng cách của các đoạn thẳng

4. Điểm 1 được lặp lại 2 lần trong cột 1

 

Em load kết quả từ cách làm của anh và file em muốn thể hiện, anh coi và giúp em nhé.

 

http://www.cadviet.com/upfiles/guihoi_1.dwg

 

Cảm ơn anh.

Lisp có đủ 4 yêu cầu trên:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Free utility - www.cadviet.com - September 2008 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
   (setq p1 (polar p0 (dtr a) r))
   (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0  "TEXT") (cons 7 (getvar "textstyle"))
   (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 h) (cons 72 1) (cons 73  2)))
)
;;;-------------------------------------------------------------------------------
(defun Collect(e / e2 SS) ;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil) (setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 8 h))
   p3 (polar p2 0 (* 12 h))
   p4 (polar p3 0 (* 10 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 8 h))
   p3 (polar p2 0 (* 12 h))
   p4 (polar p3 0 (* 10 h))
p4 (polar p4 (* 0.5 pi) (* 1.5 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn)
;;;Vertex Co-ordinate

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
   p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
   p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
   pvL (reverse (getvert et))
n (length pvL)
p02 (polar p01 (* 1.5 pi) (* n h 3))
   oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
   (list(+ (car p0) (* 4 h)) (cadr p0))
(list(+ (car p0) (* 16 h)) (cadr p0))
   (list(+ (car p0) (* 28 h)) (cadr p0))
   (list(+ (car p0) (* 38 h)) (cadr p0))
""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0 pt nil)
(repeat n
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
)
(if pt (setq S (rtos (distance pt pv))) (setq S ""))
   (setq txtL (list num (rtos (cadr pv)) (rtos (car pv)) S))
   (txt2 txtL)
   (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
(setq pt pv)
   (setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(command "erase" et "")
(setq bn "1")
(while (tblsearch "block" bn) (setq bn (itoa (1+ (atoi bn)))))
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setq j 0)
(repeat (1- n)
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h)
   (setq j (1+ j))
)
;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

 

Góp ý:

Nếu có nhờ ai viết lisp, bạn nên nêu rõ và đủ các yêu cầu ngay từ đầu. Làm lần đầu không ngại nhưng sửa đi sửa lại... ngán lắm!

[thanhgam2003 1]

cảm ơn anh. em đã test và thấy được rồi. E phải đưa yêu cầu nhiều làn là do em chưa thấy rõ tất cả yêu cầu của bài toán. Lần sau nếu có yêu cầu gì, em sẽ tìm hiểu kỹ rồi mới post lên.

 

 

cảm ơn nhiều nhiều anh SSG