trích do

Tháng 9 11, 2009

Nhờ các bạn dúp dùm mình họa đồ trích đo này không có up file theo đó minh đa rât cần.

text đánh theo thứ tự từ trái qua phải

bản vẽ gán theo tỷ lệ cho trước

có kèm theo bảng toa độ

Bản trích đo: http://www.cadviet.com/upfiles/2/mau_trich_do.dwg

File bản đồ: http://www.cadviet.com/upfiles/2/dc_4f135ivd.dwg

Tháng 9 11, 2009

Nhờ các bạn dúp dùm mình họa đồ trích đo này không có up file theo đó minh đa rât cần.
text đánh theo thứ tự từ trái qua phải

bản vẽ gán theo tỷ lệ cho trước

có kèm theo bảng toa độ

Bản trích đo: http://www.cadviet.com/upfiles/2/mau_trich_do.dwg

File bản đồ: http://www.cadviet.com/upfiles/2/dc_4f135ivd.dwg

Mình thử diễn đạt lại ý của bạn thế này xem có đúng không nhé.

Bạn có một hình đa giác bất kỳ với n cạnh.

bạn muốn một lisp có chức năng:

- pick lần lượt vào các đỉnh của da giác đó lần lượt theo một chiều nhất định (cùng chiều hoặc ngược chiều kim đồng hồ)

- Lisp sẽ đánh số thứ tự các điểm đã pick.

- Xuất một bảng thống kê như bản vẽ thứ nhất của bạn gồm: tọa độ (X,Y) của các đỉnh; chiều dài các cạnh giữa 2 đỉnh kề nhau.

Trước đây đã có một bạn nhờ mình làm việc này (tại đây, bài số 14) nhưng bạn ấy diễn đạt khiến mình không thể hiểu. giờ nhìn vào bản vẽ thứ nhất của bạn nên mình lờ mờ đoán ra. ko biết có fải ý của bạn không.

Tháng 9 14, 2009

Mình thử diễn đạt lại ý của bạn thế này xem có đúng không nhé.
Bạn có một hình đa giác bất kỳ với n cạnh.

bạn muốn một lisp có chức năng:

- pick lần lượt vào các đỉnh của da giác đó lần lượt theo một chiều nhất định (cùng chiều hoặc ngược chiều kim đồng hồ)

- Lisp sẽ đánh số thứ tự các điểm đã pick.

- Xuất một bảng thống kê như bản vẽ thứ nhất của bạn gồm: tọa độ (X,Y) của các đỉnh; chiều dài các cạnh giữa 2 đỉnh kề nhau.

Trước đây đã có một bạn nhờ mình làm việc này (tại đây, bài số 14) nhưng bạn ấy diễn đạt khiến mình không thể hiểu. giờ nhìn vào bản vẽ thứ nhất của bạn nên mình lờ mờ đoán ra. ko biết có fải ý của bạn không.

Có thể diễn đạt như sau:

có một bản đồ địa chính hoàn chỉnh, thửa đất được tạo bỡi các polyline kín, trong thửa đất có các thông tin: loại đất, số hiệu thửa đất, diện tích. cần tạo ra file hồ sơ kỹ thuật thửa đất cho mỗi thửa đất (file sơ đồ trích đo thửa đất). Yêu cầu chương trình lisp:

Trên bản đồ địa chính, chọn thửa đất cần tạo hồ sơ kỹ thuật, chương trình sẽ mở file mẫu hố sơ kỹ thuật, chèn thửa đất vừa chọn vào giữa khung, tự động đánh số đỉnh thửa, tạo bảng kê phía dưới phải của khung, các nội dung text khác có sẵn trên file mẫu hoặc do người sử dụng nhập vào

Hy vọng đúng ý bạn trang7889

Tháng 9 15, 2009

Cảm ơn bạn TnmTpc đã Reply cho mình.

ý mình là như bạn tả đó. và file mẫu nằm trong thư mục đã được chỉ định trong Options...

ptoin

Tháng 9 15, 2009

mình có đọan lisp này của bạn mình đang sài nhưng nó đánh số theo chiều kim đồng hồ bạn tham khảo thử nhé. Thank!

(defun *error* (msg)

(princ "error: ")

(princ msg)

(princ)

)

(defun Wdis (p1 p2 / dis ang point)

(setq dis (distance p1 p2))

(setq ang (angle p1 p2))

(if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )

(progn

(setq ang (+ Ang Pi))

(setq Point (polar p2 ang (/ dis 2.0)))

)

(setq Point (polar p1 ang (/ dis 2.0)))

)

(command "Text" "S" "vtimesn" "c" point (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2) )

)

(defun ssgetLayer( La1 La2 / ss)

(setq ss (ssget "X" (list

(cons -4 "

(cons 8 La1)

(cons 0 "LWPOLYLINE")

(cons -4 "AND>")

(cons -4 "

(cons 8 La1)

(cons 0 "LINE")

(cons -4 "AND>")

(cons -4 "

(cons 8 La2)

(cons 0 "LWPOLYLINE")

(cons -4 "AND>")

(cons -4 "

(cons 8 La2)

(cons 0 "LINE")

(cons -4 "AND>")

(cons -4 "OR>")

)

))

ss

)

(defun pointpl (name tt k / namem i bien t1 p1 diem)

(setq namem name)

(setq i 1)

(while (<= i k)

(progn

(setq bien (assoc tt namem))

(setq t1 (member bien namem))

(setq p1 (car t1))

(setq namem (cdr t1))

(setq diem (cdr p1))

(setq i (+ 1 i))

)

diem

)

(defun c:Toado( / i k luuxy st p xoa)

(setvar "cmdecho" 0)

(setq st (ssgetLayer "Rtd" "ch") )

(if (/= st nil)

(progn

(if (null (tblsearch "style" "vtimesn"))

(command "_style" "vtimesn" "vtimesn.ttf" "" "" "" "" ""))

(if (null (tblsearch "style" "vtimesb"))

(command "_style" "vtimesb" "vtimesb.ttf" "" "" "" "" ""))

(if (null (tblsearch "layer" "sohieu_diem"))

(command "_layer" "n" "sohieu_diem" ""))

(command "_layer" "c" "2" "sohieu_diem" "")

(if (null (tblsearch "layer" "bang_toado"))

(command "_layer" "n" "bang_toado" ""))

(command "_layer" "c" "7" "bang_toado" "")

(command "_layer" "c" "5" "Rsd" "")

(command "_layer" "c" "4" "Rtd" "")

(if (null (tblsearch "layer" "Polygon"))

(command "_layer" "n" "Polygon" ""))

(command "_layer" "c" "8" "Polygon" "")

(setq r1 (getvar "USERR1"))

(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))

(if (= TileBdHT nil)

(setq TileBdHT r1))

(setvar "USERR1" TileBdHT)

(setvar "blipmode" 0)

(setq old (getvar "osmode"))

(setvar "osmode" 0)

(setq p (getpoint "\n Pick"))

(command "_layer" "s" "Polygon" "")

(if (/= p nil)

(command "-Boundary" "a" "b" "n" st "" "" p "" )

)

(setq luuxy (entget (entlast)))

(setq p (getpoint "\n Diem dat bang toa do :"))

; (entdel (entlast))

(setq k (cdr (assoc 90 luuxy)))

(if (/= p nil)

(progn

(setq p01 p)

(setq p02 (mapcar '+ p '(10.0 0.0 0.0)))

(setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))

(setq p04 (mapcar '+ p '(35.0 0.0 0.0)))

(setq p05 (mapcar '+ p '(45.0 0.0 0.0)))

(setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))

(setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))

(setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))

(setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))

(if (<= k 3)

(progn

(setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))

(setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))

(setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))

(setq p13 (mapcar '+ p '(32.0 -40.0 0.0)))

(setq p14 (mapcar '+ p '(45.0 -40.0 0.0)))

)

(progn

(setq ty (* -1 (+ 10.0 (* k 3))))

(setq t0 (list 0.0 ty 0.0))

(setq t1 (list 10.0 ty 0.0))

(setq t2 (list 25.5 ty 0.0))

(setq t3 (list 41.0 ty 0.0))

(setq t4 (list 50.0 ty 0.0))

(setq p10 (mapcar '+ p t0))

(setq p11 (mapcar '+ p t1))

(setq p12 (mapcar '+ p t2))

(setq p13 (mapcar '+ p t3))

(setq p14 (mapcar '+ p t4))

)

(command "layer" "s" "bang_toado" "")

(command "Line" p01 p05 "")

(command "Line" p01 p10 "")

(command "Line" p02 p11 "")

(command "Line" p03 p12 "")

(command "Line" p04 p13 "")

(command "Line" p05 p14 "")

(command "Line" p07 p08 "")

(command "Line" p06 p09 "")

(command "Line" p10 p14 "")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(22.5 2.0 0.0)) 1.8 0 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.5 0 "Soá hieäu")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.5 0 "ñieåm")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(22.5 -1.30 0.0)) 1.8 0 "Toïa ñoä")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.5 0 "X(m)")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.5 0 "Y(m)")

(command "Text" "S" "vtimesb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.5 0 "Caïnh")

)

(setq i 1)

(while (<= i k)

(progn

(setq toado (pointpl luuxy 10 i))

(setq x (rtos (car toado) 2 2))

(setq y (rtos (cadr toado) 2 2))

(command "layer" "s" "sohieu_diem" "")

(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))

(command "Text" "S" "vtimesn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)

(command "donut" "0.0" (* 0.25 (/ TileBdHT 500)) toado "")

(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))

(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))

(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))

(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))

(setq psh (mapcar '+ p tsh))

(setq pxx (mapcar '+ p txx))

(setq pyy (mapcar '+ p tyy))

(setq pgc (mapcar '+ p tgc))

(if (= i 1)

(progn

(setq toado1 toado)

(setq x1 (rtos (car toado1) 2 2))

(setq y1 (rtos (cadr toado1) 2 2))

)

(if (>= i 2)

(progn

(setq canh (distance toado0 toado))

(command "layer" "s" "bang_toado" "")

(command "Text" "S" "vtimesn" "j" "M" pgc 1.5 0 (rtos canh 2 2) )

(command "layer" "s" "sohieu_diem" "")

(wdis toado0 toado)

)

(command "layer" "s" "bang_toado" "")

(command "Text" "S" "vtimesn" "j" "M" psh 1.5 0 i)

(command "Text" "S" "vtimesn" "j" "M" pxx 1.5 0 y)

(command "Text" "S" "vtimesn" "j" "M" pyy 1.5 0 x)

(setq toado0 toado)

(setq i (+ i 1))

)

(command "layer" "s" "sohieu_diem" "")

(wdis toado toado1)

(setq canh (distance toado toado1))

(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))

(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))

(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))

(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))

(setq psh (mapcar '+ p tsh))

(setq pxx (mapcar '+ p txx))

(setq pyy (mapcar '+ p tyy))

(setq pgc (mapcar '+ p tgc))

(command "layer" "s" "bang_toado" "")

(command "Text" "S" "vtimesn" "j" "M" pgc 1.5 0 (rtos canh 2 2) )

(command "Text" "S" "vtimesn" "j" "M" psh 1.5 0 "1")

(command "Text" "S" "vtimesn" "j" "M" pxx 1.5 0 y1)

(command "Text" "S" "vtimesn" "j" "M" pyy 1.5 0 x1)

(setvar "osmode" old)

) ;(end progn)

) ;(end if)

(if (= st nil)

(progn

(setvar "cmdecho" 1)

(princ "Khong co layer Ranh_toado")

)

(command "_layer" "s" "0" "")

)

(defun c:capnhat()

(setq is (ssgetLayer "Polygon" "Polygon") )

(setq namecn (getfiled "FILE CAP NHAT" "" "DWG" 3))

(command "Wblock" namecn "" '(0 0) is "")

(command "oops")

(command "save")

; (setq namegoc (getfiled "FILE BAN DO GOC" "" "DWG" 3))

(setq TenQuan (strcat " " (getString T "\nTen Quan : ")))

(setq TenPhuong (strcat " " (getString T "\nTen Phuong : ")))

(setq TenTo (strcat " " (getString T "\nTo So : ")))

(setq namegoc (strcat "q" TenQuan "-" TenPhuong "-" TenTo ".dwg"))

(command "open" namegoc)

)

hy vọng bạn dúp mình sớm.

Tháng 9 18, 2009

mình có đọan lisp này của bạn mình đang sài nhưng nó đánh số theo chiều kim đồng hồ bạn tham khảo thử nhé. Thank!

hy vọng bạn dúp mình sớm.

Chào bạn Trang7889,

Mình mới đang tập viết lisp, còn nhiều điều chưa biết. Yêu cầu của bạn dự theo sự diễn giải của bác tnmtpc mình cố gắng viết thử thì nó ra được như sau. Bạn hãy dùng thử và kết hợp với những điều bạn đã biết về lisp dể hoàn thiện nó nhé.

Lisp mình viết hoạt động như sau:

1/- bạn mở bản vẽ tổng thể , copy cái bản vẽ mẫu trích đồ của bạn vào đó, load lisp và gõ lệnh trdo. Lisp sẽ yê cầu bạn chọn thửa đất cần trích.

2/- Bạn pick một điểm bên trong thửa đất cần trích họa đồ (lưu ý rằng thửa đất đó phải được khép kín, không có chỗ hở tại các vị trí nối.) Để pick đúng bạn có thể sử dụng lệnh Zoom in về khu vực chứa thửa đất. Lisp sẽ hỏi bạn vị trí cần dán thửa đất vào.

3/- Chọn vị trí trên bản mẫu trích đồ để paste thửa đất này vào cho đẹp. Cần chú ý để sao cho sau khi Scale lên tỷ lệ 1/500 như mẫu của bạn thì thửa đất nằm gọn gàng bạn nhé. Lisp sẽ hỏi bạn tâm scale.

4/- Bạn chọn tâm scale. Lisp sẽ tự động đánh số đỉnh của thửa đất theo cái cách mà nó được tạo ra. Điều này có thể chưa phù hợp với ý của bạn nhưng mình chưa rõ ý bạn nên tạm thời chấp nhận vậy. Hiện tại mình để tỳ lệ scale là 2 do bản vẽ tổng có tỷ lệ là 1/1000 mà bản trích đồ bạn yêu cầu tỷ lệ là 1/500. Sau đó lisp sẽ hỏi bạn vị trí đặt bảng tọa độ góc ranh.

5/- Bạn hãy chọn điểm đặt là góc dưới bên phải của bảng trên bản mẫu trích đồ sao cho phú hợp ý bạn. Lisp sẽ hỏi bạn nhập cao độ ô trong bảng. Ở dây bạn nên chọn là 5 vì mình đã cố định chiều cáo chữ và các điểm đặt của text trong bảng theo kích thước này. Nếu bạn thay đổi thì bảng có thể sẽ rất xấu.

6/- Lisp sẽ tự động điền các thông số vào bảng giống như bảng mẫu bạn đã gửi.

Hiện tại mình mới chỉ làm đến đây , còn các yêu cầu khác như nhập tên bản đồ, số thửa ..... bạn sẽ tự nhập hoặc nếu cần mình sẽ bổ sung sau bạn nhé.

Do năng lực có hạn mà mình thấy chưa có người trả lời cho yêu cầu của bạn nên mạo muội post cái lisp này lên. Bạn dùng nếu thấy có gì chưa hợp lý thì góp ý để mình sửa tiếp nếu được.

Lisp đây bạn:

http://www.cadviet.com/upfiles/2/trichdo.lsp

Chúc bạn thuận lợi trong công việc.

Tháng 9 20, 2009

Chào bạn Trang7889,
Mình mới đang tập viết lisp, còn nhiều điều chưa biết. Yêu cầu của bạn dự theo sự diễn giải của bác tnmtpc mình cố gắng viết thử thì nó ra được như sau. Bạn hãy dùng thử và kết hợp với những điều bạn đã biết về lisp dể hoàn thiện nó nhé.

Lisp mình viết hoạt động như sau:

3/- Chọn vị trí trên bản mẫu trích đồ để paste thửa đất này vào cho đẹp. Cần chú ý để sao cho sau khi Scale lên tỷ lệ 1/500 như mẫu của bạn thì thửa đất nằm gọn gàng bạn nhé. Lisp sẽ hỏi bạn tâm scale.

4/- Bạn chọn tâm scale. Lisp sẽ tự động đánh số đỉnh của thửa đất theo cái cách mà nó được tạo ra. Điều này có thể chưa phù hợp với ý của bạn nhưng mình chưa rõ ý bạn nên tạm thời chấp nhận vậy. Hiện tại mình để tỳ lệ scale là 2 do bản vẽ tổng có tỷ lệ là 1/1000 mà bản trích đồ bạn yêu cầu tỷ lệ là 1/500. Sau đó lisp sẽ hỏi bạn vị trí đặt bảng tọa độ góc ranh.

5/- Bạn hãy chọn điểm đặt là góc dưới bên phải của bảng trên bản mẫu trích đồ sao cho phú hợp ý bạn. Lisp sẽ hỏi bạn nhập cao độ ô trong bảng. Ở dây bạn nên chọn là 5 vì mình đã cố định chiều cáo chữ và các điểm đặt của text trong bảng theo kích thước này. Nếu bạn thay đổi thì bảng có thể sẽ rất xấu.

6/- Lisp sẽ tự động điền các thông số vào bảng giống như bảng mẫu bạn đã gửi.

Xin cám ơn Bạn PHANTHANHBINH, và xin cho phép mình tham gia vào lisp của Bạn nha.

Nhờ bạn giúp thêm vào nội dung sau:

-- Trong bản vẽ của mình, tỉ lệ là 1/1 ( mà là tỉ lệ in ra bản đồ 1/500), mình muốn trích thửa đó ra với tỉ lệ 1/1 ---> 1/500; hoặc mình cần thay đổi qua 1/100, 1/200, 1/1000. Ý mình muốn Lisp xác nhận flie Bản đồ gốc là tỉ lệ mấy và cần trích ra thửa đó với tỉ lệ nào ?

-- Ý 2 là chèn khung bản vẽ mẫu vào vị trí thích hợp thể hiện thửa đất trên khung, và ghi luôn vào bảng thống kê tọa độ, cạnh thửa đất trích ra.

Mong được anh giúp.

Tháng 9 21, 2009

Xin cám ơn Bạn PHANTHANHBINH, và xin cho phép mình tham gia vào lisp của Bạn nha.
Nhờ bạn giúp thêm vào nội dung sau:

-- Trong bản vẽ của mình, tỉ lệ là 1/1 ( mà là tỉ lệ in ra bản đồ 1/500), mình muốn trích thửa đó ra với tỉ lệ 1/1 ---> 1/500; hoặc mình cần thay đổi qua 1/100, 1/200, 1/1000. Ý mình muốn Lisp xác nhận flie Bản đồ gốc là tỉ lệ mấy và cần trích ra thửa đó với tỉ lệ nào ?

-- Ý 2 là chèn khung bản vẽ mẫu vào vị trí thích hợp thể hiện thửa đất trên khung, và ghi luôn vào bảng thống kê tọa độ, cạnh thửa đất trích ra.

Mong được anh giúp.

Chào bác khaosat2009,

Về cái ý một của bác, để giải quyết không khó khăn lắm, đó chỉ là thay đổi tỷ lệ scale thay vì mình đặt cố định là 2 thì ta sẽ cho đó là một biến phụ thuộc vào các giá trị tỷ lệ của bản vẽ trích thửa và bản đồ tổng thể mà thôi. Để làm điều này bác hãy bổ sung đoạn lisp sau đây vào cái lisp cũ của mình nhé:

(setq tltt (getreal "\n Hay nhap ty le ban ve trich thua :")
	tlbd (getreal "\n Hay nhap ty le ban do tong the :")
	tlsc ( / tltt tlbd))

Bổ sung đoạn code này vào ngay phía trên dòng code: (Command "scale" ent1 "" (getpoint) 2) và thay giá trị 2 trong dòng code này bằng biến tlsc. Tức là dòng code đó sẽ thành : (Command "scale" ent1 "" (getpoint) tlsc) bác nhé.

Khi đó lúc chạy lisp đến đoạn này lisp sẽ yêu cầu bác nhập giá trị tỷ lệ bác cần cho bản vẽ trích thửa và tỷ lệ bản đồ chung mà bác đang xài. Các thao tác khác vẫn như cụ bác ạ.

Về cái ý thứ hai thì mình đã nói trong bài trước, bác chỉ cần copy cái bản vẽ mẫu của bác vào cái bản đồ tổng thể, sau đó khi chạy lisp do việc chọn điểm đặt của hình trích thửa và khung bảng tọa độ góc ranh là tùy ý người dùng nên bác cứ rê chuột thoải mái tới cái chỗ bác thấy phù hợp trên bản vẽ mẫu là Ok mà. Trong quá trình chọn điểm này lisp đã tạm pause để bác chọn nên bác có thể sử dụng các lệnh pan, zoom thoải mái mà chọn cho hợp lý nhất mà. Thực tế có thể khi bác chọn nó chưa chuẩn lắm thì cũng chả sao cả vì sau khi bác đã có kết quả của lisp, bác hoàn toàn có thể xài thằng move để chuyển nó về đúng chỗ mình cần bác ạ. Việc này tuy rằng có hơi lách cách nhưng nó lại đảm bảo cho bác có cái kết quả vừa mắt mà đỡ phải lăn tăn trong quá trình chạy lisp.

Bác thử xem nhé, nếu thấy chỗ nào chưa vừa ý, bác cứ bảo, mình sẽ chỉnh sửa lại bác nhé.

Chúc bác luôn vui và thành công trong công việc cũng như cuộc sống.

Tháng 9 21, 2009

Chào bác khaosat2009,
Về cái ý một của bác, để giải quyết không khó khăn lắm, đó chỉ là thay đổi tỷ lệ scale thay vì mình đặt cố định là 2 thì ta sẽ cho đó là một biến phụ thuộc vào các giá trị tỷ lệ của bản vẽ trích thửa và bản đồ tổng thể mà thôi. Để làm điều này bác hãy bổ sung đoạn lisp sau đây vào cái lisp cũ của mình nhé:
(setq tltt (getreal "\n Hay nhap ty le ban ve trich thua :")
	tlbd (getreal "\n Hay nhap ty le ban do tong the :")
	tlsc ( / tltt tlbd))
Bổ sung đoạn code này vào ngay phía trên dòng code: (Command "scale" ent1 "" (getpoint) 2) và thay giá trị 2 trong dòng code này bằng biến tlsc. Tức là dòng code đó sẽ thành : (Command "scale" ent1 "" (getpoint) tlsc) bác nhé.

Nhờ bạn giúp : khi mình chọn vị trí để chèn thửa trích ra đó và chọn vào khung bản vẽ. Thì lisp tiếp tục tạo bảng tọa độ và kích thước, chọn điểm chèn bảng vào trong vị trí khung bản vẽ.

như file mình gởi sau đây :

Mong được Bạn giúp

Tháng 9 23, 2009

Nhờ bạn giúp : khi mình chọn vị trí để chèn thửa trích ra đó và chọn vào khung bản vẽ. Thì lisp tiếp tục tạo bảng tọa độ và kích thước, chọn điểm chèn bảng vào trong vị trí khung bản vẽ.
như file mình gởi sau đây :

http://www.cadviet.com/upfiles/2/mau_trich_do2.rar

Mong được Bạn giúp

Chào bạn khaosat 2009,

Mình gửi bạn file mà mình đã làm thử với cái lisp đã viết ở trên. Kết quả khác với bản vẽ bạn đã post ở những điểm sau :

1/- Trên bản vẽ trích không đánh dấu các điểm bằng các dấu tròn như của bạn

2.- Trên bản vẽ trích ra không ghi độ dài các cạnh như trên bản vẽ của bạn

3/- Nội dung của bảng tọa độ ranh thiếu mất một dòng text mà mình chưa hiểu đó là chữ gì.

Để bổ sung những điều này hoàn toàn có thể được nhưng mình chưa rõ yêu cầu của bạn có phải vậy không, còn việc chọn vị trí hình trích và vị trí bảng tọa độ ranh thì hoàn toàn do mình tự chọn mà bạn. Bạn hãy đọc kỹ lại các bài viết của mình sẽ hiểu mà. Với cái kết quả như hình mình gửi bạn thì mình chỉ chạy lisp một phát là xong ngay chả phải chỉnh sửa gì đâu mà.

Bạn thử lại xem nhé.

http://www.cadviet.com/upfiles/2/mau_trich_do2.dwg

Chúc bạn thành công

Tháng 9 23, 2009

Nhờ bạn giúp : khi mình chọn vị trí để chèn thửa trích ra đó và chọn vào khung bản vẽ. Thì lisp tiếp tục tạo bảng tọa độ và kích thước, chọn điểm chèn bảng vào trong vị trí khung bản vẽ.
như file mình gởi sau đây :

http://www.cadviet.com/upfiles/2/mau_trich_do2.rar

Mong được Bạn giúp

Chào bạn khaosat 2009,

Mình đã sửa lại cái lisp để trích thửa theo đúng cái mẫu bạn gửi. Bạn có thể so sánh cái lisp này với cái lisp trước để thấy phần mình bổ sung vào và rút ra kinh nghiệm để chỉnh sửa lisp sau này.

Mình nhắc lại cách sử dụng nhé:

1/- Load lisp vào bản vẽ tổng đồ.

2/- Copy bản vẽ trích thửa mẫu của bạn vào đó.

3/- Gõ lệnh trdo để chạy lisp.

4/- Khi lisp yêu cầu bạn chọn thửa , bạn có thể dùng lệnh zoom và pan để pick đúng một điểm nằm trong thửa đất đó.

5/- Lisp sẽ yêu câù bạn chọn điểm để paste thửa đất này vào, bạn hãy dùng zoom và pan dể kéo thửa đất về đúng vị trí bạn mong muốn trên bản vẽ trích thửa. Cần lưu ý chừa không gian để bạn scale nó lên theo đúng tỷ lệ yêu cầu.

6/- Bạn nhập tỷ lệ bản vẽ trích thửa theo mong muốn.

7/- Bạn nhập tỷ lệ của bản vẽ tổng đồ. Lisp sẽ tính giùm bạn tỷ lệ cần scale.

8/- Bạn chọn tâm scale. Lisp sẽ scale thửa đất lên đúng yêu cầu của bạn và tự động đánh dấu các điểm góc ranh của thửa đất bằng các chấm điểm đỏ và đánh số các điểm này theo trật tự tạo ra đường biên bởi lệnh boundary trước đó.

9/- Lisp yêu cầu bạn chọn điểm góc dưới bên phải của khung bảng liệt kê tọa độ. Bạn có thể sử dụng các lệnh truy bắt để chọn đúng điểm bạn định đặt khung trên bản vẽ trích thửa.

10/- Bạn nhập chiều cao của một dòng trong bảng. Ở đây bạn nên nhập là 5 do mình đã fix chiều cao text trong bảng, Còn chiều rộng các cột mình đã mặc định cho nó rồi theo kích thước chiều cao chữ.

11/- Lisp sẽ tự động tạo bảng, điền các tên cột và tên bảng, điền các tọa độ góc ranh và độ dài các cạnh cho bạn ở trong khung cũng như trên bản đồ trích thửa với các màu mà bạn đã cho mẫu.

Sau khi lisp chạy xong, bạn có thể zoom lớn bản vẽ trích thửa để điều chỉnh vị trí các text cho đẹp bằng lệnh move. Điều này là cần thiết vì thực tế các thửa đất đôi khi có những góc ranh rất sát nhau mà kích thước và vị trí các text thì đã bị fix rồi nên chúng có thể chồng chéo lên nhau bạn ạ. Lisp của mình không như người có thể lựa chọn chỗ trống để đặt text được mà chỉ có thể cho nó một công thức chung để chọn điểm đặt thôi.

Bạn hãy xem một bản trích thửa mình đã trích bằng lisp này và dùng thử, nếu có gì chưa hài lòng bạn hãy post lên nhé.

Đây là file lisp:

http://www.cadviet.com/upfiles/2/trichdo.lsp

Và đây là file kết quả :

http://www.cadviet.com/upfiles/2/mau_trich_do2_1.dwg

Chúc bạn thành công.

Tháng 9 24, 2009

Chào bạn khaosat 2009,
Mình đã sửa lại cái lisp để trích thửa theo đúng cái mẫu bạn gửi. Bạn có thể so sánh cái lisp này với cái lisp trước để thấy phần mình bổ sung vào và rút ra kinh nghiệm để chỉnh sửa lisp sau này.

Mình nhắc lại cách sử dụng nhé:

......

8/- Bạn chọn tâm scale. Lisp sẽ scale thửa đất lên đúng yêu cầu của bạn và tự động đánh dấu các điểm góc ranh của thửa đất bằng các chấm điểm đỏ và đánh số các điểm này theo trật tự tạo ra đường biên bởi lệnh boundary trước đó.

9/- Lisp yêu cầu bạn chọn điểm góc dưới bên phải của khung bảng liệt kê tọa độ. Bạn có thể sử dụng các lệnh truy bắt để chọn đúng điểm bạn định đặt khung trên bản vẽ trích thửa.

10/- Bạn nhập chiều cao của một dòng trong bảng. Ở đây bạn nên nhập là 5 do mình đã fix chiều cao text trong bảng, Còn chiều rộng các cột mình đã mặc định cho nó rồi theo kích thước chiều cao chữ.

11/- Lisp sẽ tự động tạo bảng, điền các tên cột và tên bảng, điền các tọa độ góc ranh và độ dài các cạnh cho bạn ở trong khung cũng như trên bản đồ trích thửa với các màu mà bạn đã cho mẫu.

Sau khi lisp chạy xong, bạn có thể zoom lớn bản vẽ trích thửa để điều chỉnh vị trí các text cho đẹp bằng lệnh move. Điều này là cần thiết vì thực tế các thửa đất đôi khi có những góc ranh rất sát nhau mà kích thước và vị trí các text thì đã bị fix rồi nên chúng có thể chồng chéo lên nhau bạn ạ. Lisp của mình không như người có thể lựa chọn chỗ trống để đặt text được mà chỉ có thể cho nó một công thức chung để chọn điểm đặt thôi.

Cám ơn Bạn,

Lisp cua bạn thật là hay, khi trích thửa ra nơi khác vẩn nhớ được vị trí các điểm tọa độ để lập bảng Toạ Độ.

Còn việc đặt bảng TĐ, sao mình thể hiện thường bị méo, kẻ khung không đúng theo yêu cầu.không hiểu đặt chế độ snap ra sao ?

Vấn đề 11, mình có 1 lisp của các anh khác viết muốn chuyển đến bạn phamthanhbinh để tham khảo thêm. Không biết bạn có đồng ý không ?

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

;;;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 and elleHCSC - January 2009 - www.cadviet.com

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

Vì sự sáng tạo và lòng hảo tâm, mong đựoc Bạn và các anh hiểu, giúp đở.

Tháng 9 24, 2009

đầu tiên mình cảm ơn bạn phamthanhbinh đã cố gắng giúp mình! nhưng hình như tọa độ bị (-) đó bạn ơi.

ý mình là từ file bản đồ gốc là vẽ tỉ lệ 1/1 khi dán vào bản vẽ mẫ thì phải scale lên (VD: 500 là x2 lần; 200 là x4 lần đó bạn).

bảng tọa độ là lấy theo list của point của bản đồ

bạn có thể giúp mình chèn file mẫu vào file bản đồ hiện tại theo pickpoints được ko?

list mẫ bạn gửi hình như ko chạy số điểm góc thửa theo chiều kim đồng hồ. mình chạy trên file bản đồ của mình thì bảng tọa độ

ko hiện kết quả.

bạn xem lại dúp nhé.

cảm ơn!

Tháng 9 24, 2009

Cám ơn Bạn,
Lisp cua bạn thật là hay, khi trích thửa ra nơi khác vẩn nhớ được vị trí các điểm tọa độ để lập bảng Toạ Độ.

Còn việc đặt bảng TĐ, sao mình thể hiện thường bị méo, kẻ khung không đúng theo yêu cầu.không hiểu đặt chế độ snap ra sao ?

Vấn đề 11, mình có 1 lisp của các anh khác viết muốn chuyển đến bạn phamthanhbinh để tham khảo thêm. Không biết bạn có đồng ý không ?

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

;;;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 and elleHCSC - January 2009 - www.cadviet.com

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

Vì sự sáng tạo và lòng hảo tâm, mong đựoc Bạn và các anh hiểu, giúp đở.

Chào bạn khaosat 2009,

1/- Việc nhớ tọa độ của bản đồ trích thửa thực ra là do mình đã lưu nó lại trong các biến plst và plst1 ấy mà.

2/- Bạn phải đặt biến hệ thống snapmode về 0 vì trong lisp các tọa độ thường bị phụ thuộc vào một điểm chọn bất kỳ mà. Đây là do sơ suất của mình không đưa hàm lưu biến snapmode cũ, hàm đặt lại biến hệ thống snapmode và hàm khôi phục biến snapmode. Mình sẽ bổ sung ngay.

3/- Rất cám ơn bạn có ý chia sẻ, mình rất vui nếu nhận được sự chia xẻ của bạn, thực ra mình cũng còn đang tập tọe với lisp nên được tham khảo các lisp của các bậc đàn anh đàn chú là quý hóa lắm lắm. Chắc hẳn mình sẽ mót được nhiều thứ từ các lisp đó bạn ạ.

Tháng 9 24, 2009

đầu tiên mình cảm ơn bạn phamthanhbinh đã cố gắng giúp mình! nhưng hình như tọa độ bị (-) đó bạn ơi.
ý mình là từ file bản đồ gốc là vẽ tỉ lệ 1/1 khi dán vào bản vẽ mẫ thì phải scale lên (VD: 500 là x2 lần; 200 là x4 lần đó bạn).

bảng tọa độ là lấy theo list của point của bản đồ

bạn có thể giúp mình chèn file mẫu vào file bản đồ hiện tại theo pickpoints được ko?

list mẫ bạn gửi hình như ko chạy số điểm góc thửa theo chiều kim đồng hồ. mình chạy trên file bản đồ của mình thì bảng tọa độ

ko hiện kết quả.

bạn xem lại dúp nhé.

cảm ơn!

Chào bạn Trang7889,

1/- Việc tọa độ bị trừ là do bản đồ gốc nó như vậy, hình như người vẽ cố tình để thế cho oai hay sao đó chứ mình đâu có dám thay đổi tọa độ của bản vẽ gốc đâu, bạn đừng hiểu nhầm mình tội nghiệp.

2/- Hình như bạn hơi nhầm chút xíu, bản đồ gốc là tỷ lệ 1/1000 thì khi bạn trích thửa với tỷ lệ 1/500 , hệ số scale sẽ là 2, còn khi trích thửa với tỷ lệ 1/200 thì hệ số scale phải là 5 chứ không phải 4 bạn ạ. Để thuận lợi cho người dùng, theo ý của bác Khaosat 2009 mình đã để cho người dùng nhập tỷ lệ mong muốn của bản vẽ trích thửa, và nhập tỷ lệ của bản đồ gốc. Như vậy bạn hoàn toàn yên tâm về việc lấy hệ số scale mà không sợ sai bạn ạ.

3/- Bảng tọa độ góc ranh là mình lấy theo tọa độ trên bản đồ gốc đấy chứ, không phải là lấy theo tọa độ trên bản vẽ trích thửa đôu bạn ạ. Bạn kiểm tra lại xem nhé. Ngay cả chiều dài các cạnh cũng vậy, đều được lấy theo kích thước trên bản đồ gốc đó , không phải trên bản đồ trích thửa đâu vì trên bản đồ trích thửa chúng đã được scale lên rồi mà.

4/- Thực tế lisp của mình yêu cầu bạn phải copy cái bản trích đo mẫu vào bản đồ gốc trước khi chạy lisp. Việc mở một file bản vẽ khác trong khi lisp đang chạy mình vẫn chưa thủng lắm, mặc dù đã được các bác Tue_NV, Giabach chỉ dạy. Khổ nỗi do trí não hơi lùn , chưa vận dụng được nên yêu cầu của bạn chắc phải vài ba bữa nữa mình mới có thể trả lời.

5/- Cái vụ đánh số đỉnh của thửa đất thì mình cũng chưa biết cách chọn nó sao cho hợp lý cả vì có thể mỗi ngưới có yêu cầu cách đánh số khác nhau. Hiện tại mình đánh theo trật tự các đỉnh dược hình thành khi xài lệnh boundary. Nếu muốn đánh theo một trật tự nhất định sẽ phải bổ sung một đoạn lisp để sắp xếp lại các đỉnh theo một quy luật đã định đó. Bạn hãy cho mình cái quy luật của bạn mình sẽ cố gắng bổ sung thêm theo ý bạn.

6/- Bạn có thể gửi cho mình file bản đồ của bạn để mình kiểm tra không??? thực tế mình không phải dân trắc địa . giao thông hay quy hoạch gì cả mà là một thằng "me cha ni cô" , do vậy chả có cái bản đồ nào để thử, lisp mình viết dựa trên cái file mà bạn gửi đó và file của bác khaosat 2009 . Lisp có thể chạy sai vì một số nguyên nhân sau:

a/- Trên file bản đổ của bạn text style hiện hành đang có giá trị textsize khác 0, bạn hãy đặt lại giá trị này về 0 xem nhé.

b/- Có thể trong quá trình bạn copy các dòng code bị thiếu đi một vài cái ký tự nào đó.

c/- Các biến hệ thống trên bản vẽ của bạn có thể xung đột gì đó với lisp.

Nhưng theo mình có lẽ nguyên nhân a là lớn hơn cả vì khi mình viết lisp đã phải chỉnh lại cái textsize trên bản vẽ của bạn đó.

Chúc bạn đạt nguyện vọng của mình.

Tháng 9 24, 2009

Chào bạn khaosat 2009,
1/- Việc nhớ tọa độ của bản đồ trích thửa thực ra là do mình đã lưu nó lại trong các biến plst và plst1 ấy mà.

2/- Bạn phải đặt biến hệ thống snapmode về 0 vì trong lisp các tọa độ thường bị phụ thuộc vào một điểm chọn bất kỳ mà. Đây là do sơ suất của mình không đưa hàm lưu biến snapmode cũ, hàm đặt lại biến hệ thống snapmode và hàm khôi phục biến snapmode. Mình sẽ bổ sung ngay.

3/- Rất cám ơn bạn có ý chia sẻ, mình rất vui nếu nhận được sự chia xẻ của bạn, thực ra mình cũng còn đang tập tọe với lisp nên được tham khảo các lisp của các bậc đàn anh đàn chú là quý hóa lắm lắm. Chắc hẳn mình sẽ mót được nhiều thứ từ các lisp đó bạn ạ.

Gởi Bạn phamthanhbinh, Lisp mình sưu tầm.

Mong được góp cùng bạn

Thân.

Tháng 9 24, 2009

Gởi Bạn phamthanhbinh, Lisp mình sưu tầm.
Mong được góp cùng bạn

http://www.cadviet.com/upfiles/2/hskt.rar

Thân.

Cám ơn bác Khaosat 2009,

Đọc cái lisp của bác gửi thấy nó hoành tráng quá, nguyên cái việc hiểu cho hết các dòng code này cũng đã méo cả mồm rối bác ạ. Các bác SSG và ElleHCSC viết quá ư là hoàn thiện rồi, mình chả dám vọc vạch gì vào đó nữa, hiện mình đang cố gắng để hiểu cho hết cái các bác ấy viết rồi mới nghĩ tới chuyện vận dụng nó bác ạ. Qua đó mới thấy cái biển lisp này nó vô bờ thiết bác hé.

Chúc bác luôn mạnh giỏi.

Tháng 9 24, 2009

2/- Hình như bạn hơi nhầm chút xíu, bản đồ gốc là tỷ lệ 1/1000 thì khi bạn trích thửa với tỷ lệ 1/500 , hệ số scale sẽ là 2, còn khi trích thửa với tỷ lệ 1/200 thì hệ số scale phải là 5 chứ không phải 4 bạn ạ. Để thuận lợi cho người dùng, theo ý của bác Khaosat 2009 mình đã để cho người dùng nhập tỷ lệ mong muốn của bản vẽ trích thửa, và nhập tỷ lệ của bản đồ gốc. Như vậy bạn hoàn toàn yên tâm về việc lấy hệ số scale mà không sợ sai bạn ạ.

Bạn phanthanhbinh ơi.

Việc trích thửa của bạn rất hay, bạn có thể giúp thên một việc trích các thửa theo hình vuông các nội dung trong ấy ra được không ? và yêu cầu có tăng giảm theo tỷ lệ.

Ví dụ như có hình vuông cạnh 500 x 500 cố định, mình đưa hình vuông và vị trí cần trích ở giữa thửa đó ( ý là muốn lấy hết các vùng chung quanh ), trích khu vực đó ra ( như copy ra và cắt theo khung hình vuông ). nhưng thực hiện yêu cầu hòi bản gốc tỉ lệ bao nhiêu và đưa ra tỷ lệ bao nhiêu ?

Lisp thực hiện tăng, giãm theo tỷ lệ và được khống chế theo kích thước khung 500x500 trên ( mục đích làm họa đồ vị trí cho biết các thửa tiếp giáp )

Tháng 9 24, 2009

Bạn phanthanhbinh ơi.
Việc trích thửa của bạn rất hay, bạn có thể giúp thên một việc trích các thửa theo hình vuông các nội dung trong ấy ra được không ? và yêu cầu có tăng giảm theo tỷ lệ.

Ví dụ như có hình vuông cạnh 500 x 500 cố định, mình đưa hình vuông và vị trí cần trích ở giữa thửa đó ( ý là muốn lấy hết các vùng chung quanh ), trích khu vực đó ra ( như copy ra và cắt theo khung hình vuông ). nhưng thực hiện yêu cầu hòi bản gốc tỉ lệ bao nhiêu và đưa ra tỷ lệ bao nhiêu ?

Lisp thực hiện tăng, giãm theo tỷ lệ và được khống chế theo kích thước khung 500x500 trên ( mục đích làm họa đồ vị trí cho biết các thửa tiếp giáp )

Chào bác khaosat 2009,

Theo thiển ý của mình thì chắc chắn là làm được, có điều do kỹ năng về lisp của mình còn hơi lùn nên chắc phải mất vài bữa bác ạ. Bởi vì nó dính tới việc tìm giao điểm giữa các polyline là cái khung biên 500x500 của bác và các polyline biên các thửa trên bản đồ bác ạ. Việc này đã có các lisp của bác Giabạch và tue_NV, nhưng do mình chưa thủng lắm nên phải cày vài bữa đã. Sau đó là break các polyline trên bản đồ tại các giao điểm này rồi mới copy được bác ạ. Các vấn đề khác chắc không quá khó nữa đâu.

Nếu các bác khác như bác SSG, Giabach, Tue_NV, Thiep mà rảnh viết được cho bác thì sẽ nhanh thôi. Còn mình thì chắc bác phải chờ vài bữa nhé.

Chúc bác vui.

Tháng 9 25, 2009

Chào bác khaosat 2009,
Theo thiển ý của mình thì chắc chắn là làm được, có điều do kỹ năng về lisp của mình còn hơi lùn nên chắc phải mất vài bữa bác ạ. Bởi vì nó dính tới việc tìm giao điểm giữa các polyline là cái khung biên 500x500 của bác và các polyline biên các thửa trên bản đồ bác ạ. Việc này đã có các lisp của bác Giabạch và tue_NV, nhưng do mình chưa thủng lắm nên phải cày vài bữa đã. Sau đó là break các polyline trên bản đồ tại các giao điểm này rồi mới copy được bác ạ. Các vấn đề khác chắc không quá khó nữa đâu.

Nếu các bác khác như bác SSG, Giabach, Tue_NV, Thiep mà rảnh viết được cho bác thì sẽ nhanh thôi. Còn mình thì chắc bác phải chờ vài bữa nhé.

Chúc bác vui.

Chào bác phamthanhbinh

Cám ơn Bác đã có nhã ý, nhưng thực sự Bài toán này cũng khá lớn mà lại không thuộc chuyên môn của mình nên đành "bó tay".

Chúc bác mạnh khỏe, luôn thăng tiến trong công việc.

Tháng 9 25, 2009

Chào bác phamthanhbinh
Cám ơn Bác đã có nhã ý, nhưng thực sự Bài toán này cũng khá lớn mà lại không thuộc chuyên môn của mình nên đành "bó tay".

Chúc bác mạnh khỏe, luôn thăng tiến trong công việc.

Chào các bác phamthanhbinh, khaosat2009, gia_bach,

Nếu trích bản đồ theo 1 ô window nào đó thì có thể áp dụng 1 phần lisp break_with vào được mà. Thiep xin gánh 1 chút cho việc này nhé

Tháng 9 25, 2009

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.

Mình có thể dùng lisp này cắt và scase.

Huy vọng chia sẻ được chút ít với các Bạn.

Tháng 9 25, 2009

Chào các bác phamthanhbinh, khaosat2009, gia_bach,
Nếu trích bản đồ theo 1 ô window nào đó thì có thể áp dụng 1 phần lisp break_with vào được mà. Thiep xin gánh 1 chút cho việc này nhé

Rất mong được bạn giúp đở và chia sẻ.

Tháng 9 28, 2009

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.
Mình có thể dùng lisp này cắt và scase.

Huy vọng chia sẻ được chút ít với các Bạn.

Tháng 9 28, 2009

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.
Mình có thể dùng lisp này cắt và scase.

http://www.cadviet.com/upfiles/2/cwb.rar

Huy vọng chia sẻ được chút ít với các Bạn.

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.

Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;---------------------- -
(defun Text (model str po h ang / obj)
 (setq	obj (vla-AddText
      *Model*
      str
      (vlax-3d-point po)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentTopCenter)
 (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
)
;;;====================================================================
(defun break_with (Lstent enL /	lst masterlist ss oc break_obj intpts)
 (princ "\nCalculating Break Points, Please Wait.\n")

 ;;========================================
 ;; Break entity at break points in list
 ;;========================================

 (defun break_obj (ent	brkptlst   /	      brkobjlst	 en
		enttype	   maxparam   closedobj	 minparam
		obj	   obj2break  p1param	 p2param
		brkpt2	   dlst	      idx	 brkptS
		brkptE	   brkpt      result	 result
		ignore	   dist	      tmppt	 #ofpts
		enddist	   lastent    obj2break	 stdist
	       )
    (setq obj2break ent
   brkobjlst (list ent)
   enttype   (dxf 0 ent)
    )
   (if	(not (or (eq (dxf 0 obj2break) "TEXT")
	 (eq (dxf 0 obj2break) "MTEXT")
     )
)
     (setq closedobj (vlax-curve-isclosed obj2break))
   )
   (setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
   (if	(and brkptlst
     (not (or (eq (dxf 0 obj2break) "TEXT")
	      (eq (dxf 0 obj2break) "MTEXT")
	  )
     )
)
     (progn
(setq brkptlst
       (mapcar
	 '(lambda (x)
	    (list
	      x
	      (vlax-curve-getdistatparam
		obj2break
		(cond
		  ((vlax-curve-getparamatpoint obj2break x)
		  )
		  ((vlax-curve-getparamatpoint
		     obj2break
		     (vlax-curve-getclosestpointto
		       obj2break
		       x
		     )
		   )
		  )
		)
	      )
	    )
	  )
	 brkptlst
       )
)

(setq
  brkptlst (vl-sort brkptlst
		    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))
	   )
)

(foreach brkpt (reverse brkptlst)
    (setq brkptS (car brkpt)
	  brkptE brkptS
    )
  ;; get last entity created via break in case multiple breaks
  (if brkobjlst
    (progn
      (setq tmppt brkptS)	; use only one of the pair of breakpoints
      ;; if pt not on object x, switch objects
      (if (not (numberp	(vl-catch-all-apply
			  'vlax-curve-getdistatpoint
			  (list obj2break tmppt)
			)
	       )
	  )
	(progn			; find the one that pt is on
	  (setq idx (length brkobjlst))
	  (while
	    (and (not (minusp (setq idx (1- idx))))
		 (setq obj (nth idx brkobjlst))
		 (if (numberp (vl-catch-all-apply
				'vlax-curve-getdistatpoint
				(list obj tmppt)
			      )
		     )
		   (null (setq obj2break obj))
				; switch objects, null causes exit
		   t
		 )
	    )
	  )
	)
      )
    )
  ); end (if brkobjlst

  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (setq closedobj (vlax-curve-isclosed obj2break))
  )
;;; single breakpoint ----------------------------------------------------
    (if
      (and closedobj
	   (not	(setq
		  brkptE (vlax-curve-getPointAtDist
			   obj2break
			   (+ (vlax-curve-getdistatparam
				obj2break
				(cond
				  ((vlax-curve-getparamatpoint
				     obj2break
				     brkpts
				   )
				  )
				  ((vlax-curve-getparamatpoint
				     obj2break
				     (vlax-curve-getclosestpointto
				       obj2break
				       brkpts
				     )
				   )
				  )
				)
			      )
			      0.00001
			   )
			 )
		)
	   )
      )
       (setq
	 brkptE	(vlax-curve-getPointAtDist
		  obj2break
		  (- (vlax-curve-getdistatparam
		       obj2break
		       (cond ((vlax-curve-getparamatpoint
				obj2break
				brkpts
			      )
			     )
			     ((vlax-curve-getparamatpoint
				obj2break
				(vlax-curve-getclosestpointto
				  obj2break
				  brkpts
				)
			      )
			     )
		       )
		     )
		     0.00001
		  )
		)
       ); end setq brkptE
    ); end fi (and closedobj

  ;; (if (null brkptE) (princ)) ; debug
  (setq LastEnt (GetLastEnt))
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (command "._break"
	     obj2break
	     "_non"
	     (trans brkptS 0 1)
	     "_non"
	     (trans brkptE 0 1)
    )
  )
  (and (= "CIRCLE" enttype) (setq enttype "ARC"))
  (if (and (not closedobj)	; new object was created
	   (not (equal LastEnt (entlast)))
      )
    (setq brkobjlst (cons (entlast) brkobjlst))
  ); end (if (and
); end (foreach brkpt
     );end progn brkptlst
   ); end if brkptlst

 ); defun break_obj

 ;;====================================
 ;; CAB - get last entity in datatbase
 (defun GetLastEnt (/ ename result)
   (if	(setq result (entlast))
     (while (setq ename (entnext result))
(setq result ename)
     )
   )
   result
 )
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;; S T A R T              S U B R O U T I N E             H E R E
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
   (progn
     ;; CREATE a list of entity & it's break points
     (foreach en Lstent
				; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
  (progn
    (setq lst nil)
    ;; check for break pts with other objects in Lstentwith
    (if	(and (not (equal en enint))
	     (setq intpts (acet-geom-intersectwith en enL 0))
	)
      (setq lst (append intpts lst))
				; entity w/ break points
    )
    (if	lst
      (setq masterlist
	     (cons (cons en lst) masterlist)
      )
    )
  )
)
     )
     (princ "\nBreaking Objects.\n")
     (if masterlist
(progn
  (acet-ui-progress "hoan thanh %" (length masterlist))
  (foreach obj2brk masterlist
    (break_obj (car obj2brk) (cdr obj2brk))
    (acet-ui-progress -1)
  )
  (acet-ui-progress)
)
     )
   )
 )
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
 (and
   (setq objl (vlax-ename->vla-object en))
   (setq
     ss
      (ssget
 "_A"
 (list
   (cons 0
	 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
   )
   (cons 410 (getvar "ctab"))
 )
      )
   )
   (setq lst (SS-enlst ss)
    lst (mapcar 'vlax-ename->vla-object lst))
   (mapcar
     '(lambda (x)
 (if (not
       (vl-catch-all-error-p
	 (vl-catch-all-apply
	   '(lambda ()
	      (vlax-safearray->list
		(vlax-variant-value
		  (vla-intersectwith objl x acextendnone)
		)
	      )
	    )
	 )
       )
     )
   (setq lstc (cons (vlax-vla-object->ename x) lstc))
 )
      )
     lst
   )
 )
 lstc
)
;;;------------------------------------------------
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichBD (/ ActDoc *Model* ss encur lsten p1 p2 p3 LenssBR lstp objCE)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (setq	bit1 (cond (bit1)
	  ("Rectangle")
    )
 )
 (initget "Square Rectangle Circle Ellipse Different")
 (setq	tmp (strcat "\nChon duong bao: [square/Rectangle/Circle/Ellipse/Different] <" bit1 ">: ")
bit1    (cond ((getkword tmp))
	     (bit1)
       )
 )
 (vla-StartUndoMark ActDoc)
 (setvar "cecolor" "104")
 (setq p1 (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
 (cond	((eq bit1 "Square")
 (setq a (cond (a)
	       (50)
	 )
 )
 (setq olda a)
 (setq a (getreal (strcat "\nChon kich thuoc canh Square <"
			  (rtos olda 2 1)
			  "> : "
		  )
	 )
 )
 (if (null a)
   (setq a olda)
 )
 (setq lstp (list (list (car p1) (cadr p1) 0)
		  (list (+ (car p1) a) (cadr p1) 0)
		  (list (+ (car p1) a) (+ (cadr p1) a) 0)
		  (list (car p1) (+ (cadr p1) a) 0)
		  (list (car p1) (cadr p1) 0)
	    )
 )
)
((eq bit1 "Rectangle")
 (setq a (cond (a)
	       (50)
	 )
 )
 (setq olda a)
 (setq a (getreal (strcat "\nChon chieu dai Rectangle <"
			  (rtos olda 2 1)
			  "> : "
		  )
	 )
 )
 (if (null a)
   (setq a olda)
 )
 (setq b (cond ( b )
	       (50)
	 )
 )
 (setq oldb b )
 (setq b (getreal (strcat "\nChon chieu rong Rectangle <"
			  (rtos oldb 2 1)
			  "> : "
		  )
	 )
 )
 (if (null b )
   (setq b oldb)
 )
 (setq lstp (list (list (car p1) (cadr p1) 0)
		  (list (+ (car p1) a) (cadr p1) 0)
		  (list (+ (car p1) a) (+ (cadr p1) b ) 0)
		  (list (car p1) (+ (cadr p1) b ) 0)
		  (list (car p1) (cadr p1) 0)
	    )
 )
)
((eq bit1 "Circle")
 (setq a (cond (a)
	       (50)
	 )
 )
 (setq olda a)
 (setq a (getreal (strcat "\nChon ban kinh Circle <"
			  (rtos olda 2 1)
			  "> : "
		  )
	 )
 )
 (if (null a)
   (setq a olda)
 )
 (setq objCE (vla-addCircle *Model* (vlax-3d-point p1) a))
 (setq cir (entlast))
 (setq cv   (* a 2 pi)
       lstp (list (vlax-curve-getStartPoint cir))
       d    (/ cv 160)
       l    0.0
 )
 (repeat 160
   (setq l    (+ l d)
	 p    (vlax-curve-getPointAtDist cir l)
	 lstp (append lstp (List p))
   )
 )
);end bit1 "Circle"

;;;	((eq bit1 "Ellipse")
;;;	 (setq a (getpoint p1 "\nPick diem ban kinh lon cua Ellipse"))
;;;	 (vl-cmdf ".Ellipse" pause pause pause); erro ttuc
;;;	 (setq objCE (entlast)
;;;	 p1 (vlax-curve-getStartPoint objCE))
;;;	 (command ".LENGTHEN" objCE "")
;;;	 (setq cv   (getvar "perimeter")
;;;	       lstp (list p1)
;;;	       d    (/ cv 160)
;;;	       l    0.0
;;;	 )
;;;	 (repeat 160
;;;	   (setq l    (+ l d)
;;;		 p    (vlax-curve-getPointAtDist objCE l)
;;;		 lstp (append lstp (List p))
;;;	   )
;;;	 )
;;;	);end bit1 "Ellipse"
;;;	((eq bit1 "Different")
;;;	 (prompt "\nchon 1 curve kin:")
;;;	 (setq ss (ssget)
;;;	       encur (ssname ss 0)
;;;	       objCE (vlax-ename->vla-object encur)
;;;	       p1 (vlax-curve-getStartPoint encur))
;;;	 (if (or (eq (dxf 0 encur) "LWPOLYLINE")
;;;		 (eq (dxf 0 encur) "POLYLINE")
;;;	     )
;;;	   (setq lstp (acet-geom-VERTEX-LIST encur))
;;;	   (progn
;;;	     (command ".LENGTHEN" encur "")
;;;	     (setq cv	(getvar "perimeter")
;;;		   lstp	(list p1)
;;;		   d	(/ cv 160)
;;;		   l	0.0
;;;	     )
;;;	     (repeat 160
;;;	       (setq l	  (+ l d)
;;;		     p	  (vlax-curve-getPointAtDist encur l)
;;;		     lstp (append lstp (List p))
;;;	       )
;;;	     )
;;;	   )
;;;	 )
;;;	 )
 );end cond
 (vla-ZoomExtents (vlax-get-acad-object))
 (ACET-LWPLINE-MAKE (list lstp))
 (setq ss (ssadd (entlast) (ssadd)))
 (setq	p2 (ACET-SS-DRAG-MOVE
     ss
     (list (car p1) (cadr p1))
     "Chon vi tri bat dau trich thua: "
   )
 )
 (command ".move" ss "" p1 p2)
 (setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
 (setq ss (ssdel encur (ssget "_CP" lstp)))
 (command ".copy" ss "" p2 p2)
 (setq	p3 (ACET-SS-DRAG-MOVE
     (ssadd encur ss)
     p2
     "Chon vi tri dat ban do trich thua: "
   )
 )
 (command ".move" ss encur "" p2 p3)
 (setvar "cecolor" "0")
 (setq	lsten	(vl-remove encur (gettouching encur)))
 (break_with  lsten encur)
 (vlax-invoke-method ActDoc 'Regen acActiveViewport)
 (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.0001))
 (setq lstp (acet-geom-vertex-list (entlast)))
 (entdel (entlast))
 (if (equal (vlax-curve-getEndParam encur) 160 1) (entdel encur))
 (setq	LenssBR	(SS-enlst (ssget "F" lstp)))
 (mapcar '(lambda (x)
     (if (or (not (eq (dxf 0 x) "TEXT"))
	     (not (eq (dxf 0 x) "MTEXT"))
	 )
       (entdel x)
     )
   )
  LenssBR
 )
 (if objCE (vla-move objCE (vlax-3d-point p1) (vlax-3d-point p3)))
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
 (princ)
)

Chỉnh sửa Tháng 11 19, 2010 theo phamthanhbinh

Đăng nhập

trích do

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

trang7889 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tnmtpc 207

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trang7889 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trang7889 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trang7889 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.548