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

[phongks82 0]

Bác viataba ơi . Em chưa biết chạy đoạn lisp này . em rất cần đoạn lisp này . Mong bác chỉ dùm em 1 cách chi tiết vì em mới biết đến diễn đàn và mới biết đến công dụng củaLisp. Thanks bác rất nhiều

 

Chào bác thanhgam2003 em cũng là dân trong nghề với bác . em cũng load lisp của bác ssg về nhưng em chưa rõ về cách chạy chương trình . mong bác hướng dẫn cụ thể cho em . em đang có công trình rất cần ứng dụng của lisp này . Thanks bác rất nhiều . Sở dĩ em cần sự giúp đỡ của bác là để cho bác ssg có thời gian nghỉ ngơi để nghiên cứu những thứ khác có ích cho cộng đồng . Mong nhận được hồi âm sơm từ anh. Thanks

[phongks82 0]

Bác ơi sao em làm không được hả bác ? bác chỉ giùm em chi tiết từ đầu dến cuối nhé bác . Thamks bác nhiều vì em đang cần xuất toạ độ các tim bu lông . mà bản vẽ của em có hàng ngàn toạ độ bu lông . cảm ơn bác rất nhiều

[thanhgam2003 1]

Chào bác thanhgam2003 em cũng là dân trong nghề với bác . em cũng load lisp của bác ssg về nhưng em chưa rõ về cách chạy chương trình . mong bác hướng dẫn cụ thể cho em . em đang có công trình rất cần ứng dụng của lisp này . Thanks bác rất nhiều . Sở dĩ em cần sự giúp đỡ của bác là để cho bác ssg có thời gian nghỉ ngơi để nghiên cứu những thứ khác có ích cho cộng đồng . Mong nhận được hồi âm sơm từ anh. Thanks

[/quote

 

 

 

Chào bạn!

Mìnhcũng chỉ là dân ban C nên mấy cái Lisp của Autocad minh cung mần mò mãi mới biết ứng dụng, thật ngại phải không bạn? các pác trên diễn đàn toàn tay kỳ kịu không à. Viết được Lisp, còn mình ứng dụng cũng thấy kho` khăn. Nhưng mà thôi, dù sao mình cũng tim ra cách ứng dụng nó rùi, mình chỉ cho pac nhé.

1. Mở Autocad/tool/AutoLisp/Visual Lisp Editor/new va dan đoạn code bạn copyy trên diễn đàn về, sau đó lưu thành file với tên gọi mới

2. Mở Autocad/tool/AutoLisp/load …..chọn tên file bạn mới đặt ở B1

3. Ứng dụng như anh SSg đã trình bày trên diễn đàn

 

 

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

[phongks82 0]

Chào bác thanhgam2003 em cũng là dân trong nghề với bác . em cũng load lisp của bác ssg về nhưng em chưa rõ về cách chạy chương trình . mong bác hướng dẫn cụ thể cho em . em đang có công trình rất cần ứng dụng của lisp này . Thanks bác rất nhiều . Sở dĩ em cần sự giúp đỡ của bác là để cho bác ssg có thời gian nghỉ ngơi để nghiên cứu những thứ khác có ích cho cộng đồng . Mong nhận được hồi âm sơm từ anh. Thanks

Chào bạn!

Mìnhcũng chỉ là dân ban C nên mấy cái Lisp của Autocad minh cung mần mò mãi mới biết ứng dụng, thật ngại phải không bạn? các pác trên diễn đàn toàn tay kỳ kịu không à. Viết được Lisp, còn mình ứng dụng cũng thấy kho` khăn. Nhưng mà thôi, dù sao mình cũng tim ra cách ứng dụng nó rùi, mình chỉ cho pac nhé.

1. Mở Autocad/tool/AutoLisp/Visual Lisp Editor/new va dan đoạn code bạn copyy trên diễn đàn về, sau đó lưu thành file với tên gọi mới

2. Mở Autocad/tool/AutoLisp/load …..chọn tên file bạn mới đặt ở B1

3. Ứng dụng như anh SSg đã trình bày trên diễn đàn

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

 

 

Chào anh

Cảm ơn anh nhiều khi anh đã hướng dẫn em tạo được file lisp . Em đã tạo được file này rùi nhưng em không chạy được chương trình.

Em cũng chưa biết phải dùng lệnh nào cả. Em dùng lệnh VC nhưng không đươc anh ah. Mong anh hướng dẫn em cụ thể chi tiết 1 lần nữa . Em chân thành cảm ơn anh . Mong nhận được hồi âm sớm của anh

[Phiphi- 176]

Chỉ với bản vẽ AutoCAD này http://www.cadviet.com/upfiles/Ve_be_mat_3D.zip và cũng chỉ được sử dụng pm AutoCAD 2006-2008, xin các Bác chỉ giúp nên làm sao để dựng được bề mặt địa hình 3D nhanh chóng. Hiện tại PP chỉ làm 1 cách rất thủ công: dựng các line cao độ rồi nối các đỉnh lại với nhau. Xin cám ơn.

[meohoang 344]

Chỉ với bản vẽ AutoCAD này http://www.cadviet.com/upfiles/Ve_be_mat_3D.zip và cũng chỉ được sử dụng pm AutoCAD 2006-2008, xin các Bác chỉ giúp nên làm sao để dựng được bề mặt địa hình 3D nhanh chóng. Hiện tại PP chỉ làm 1 cách rất thủ công: dựng các line cao độ rồi nối các đỉnh lại với nhau. Xin cám ơn.

Bạn vào trang cauduong.net có rất nhiều bài viết và link tải các phần mềm liên quan đến yêu cầu của bạn

[ssg 1.102]

Bác viataba ơi . Em chưa biết chạy đoạn lisp này . em rất cần đoạn lisp này . Mong bác chỉ dùm em 1 cách chi tiết vì em mới biết đến diễn đàn và mới biết đến công dụng củaLisp. Thanks bác rất nhiều

 

Chào bác thanhgam2003 em cũng là dân trong nghề với bác . em cũng load lisp của bác ssg về nhưng em chưa rõ về cách chạy chương trình . mong bác hướng dẫn cụ thể cho em . em đang có công trình rất cần ứng dụng của lisp này . Thanks bác rất nhiều...

 

Mìnhcũng chỉ là dân ban C nên mấy cái Lisp của Autocad minh cung mần mò mãi mới biết ứng dụng, thật ngại phải không bạn? các pác trên diễn đàn toàn tay kỳ kịu không à. Viết được Lisp, còn mình ứng dụng cũng thấy kho` khăn. Nhưng mà thôi, dù sao mình cũng tim ra cách ứng dụng nó rùi, mình chỉ cho pac nhé.

1. Mở Autocad/tool/AutoLisp/Visual Lisp Editor/new va dan đoạn code bạn copyy trên diễn đàn về, sau đó lưu thành file với tên gọi mới

2. Mở Autocad/tool/AutoLisp/load …..chọn tên file bạn mới đặt ở B1

3. Ứng dụng như anh SSg đã trình bày trên diễn đàn

 

Không phải nhiêu khê như vậy, các bạn xem ở đây, cực kỳ đơn giản:

 

http://www.cadviet.com/forum/index.php?showtopic=1787"

 

Tóm lại một cách ngắn gọn:

1. Copy code trên diễn đàn, mở trình Notepad (trình soạn thảo văn bản đơn giản, luôn luôn có sẵn trên máy khi cài đặt Windows) paste vào, save as dạng *.lsp (tên file * đặt tuỳ ý thích)

2. Trong Acad, gõ lệnh appload, chỉ định file *.lsp nói trên và bấm Load - Close. Nếu việc load thành công, Acad sẽ báo "*.lsp successfully loaded". Nếu muốn AutoCAD tự động load lisp khi khởi động, dùng Startup Suite như đã hướng dẫn trong link trên.

3. Tên lệnh của lisp, nếu tác giả không nói rõ là các ký tự nằm kề liền sau (defun C:

Cụ thể, với đoạn chương trình lập bảng toạ độ của ssg là VC. Sau đó, chương trình yêu cầu cái gì thì đáp ứng cái ấy.

 

Good luck!

[Phiphi- 176]

Bạn vào trang cauduong.net có rất nhiều bài viết và link tải các phần mềm liên quan đến yêu cầu của bạn

Cám ơn bác Meohoang.

Bài toán trên có thể dùng LISP để thực hiện theo cách làm như thế này có được không Bác:

1. Dùng lệnh của LISP- VDZ: vẽ điểm Z

2. Select 1 điểm và con số bên cạnh

3. LISP sẽ copy điểm và con số bên cạnh lên cao độ Z= con số đó. Con số nên đặt cao hơn điểm Z một khoảng cách nào đó

(Nếu LISP cho phép select tất cả thì tốt nhất)

4. Sau khi đã có các điểm Z. Dùng 1 lệnh khác của LISP, select tất cả các điểm cao độ đó để nối lại với nhau> được các ô tam giác và làm sao để các ô tam giác này có thể render được.

Kính nhờ các Bác viết giúp đoạn LISP để thực hiện những điều nêu trên. Thanks you.

[meohoang 344]

Cám ơn bác Meohoang.

Bài toán trên có thể dùng LISP để thực hiện theo cách làm như thế này có được không Bác:

1. Dùng lệnh của LISP- VDZ: vẽ điểm Z

2. Select 1 điểm và con số bên cạnh

3. LISP sẽ copy điểm và con số bên cạnh lên cao độ Z= con số đó. Con số nên đặt cao hơn điểm Z một khoảng cách nào đó

(Nếu LISP cho phép select tất cả thì tốt nhất)

4. Sau khi đã có các điểm Z. Dùng 1 lệnh khác của LISP, select tất cả các điểm cao độ đó để nối lại với nhau> được các ô tam giác và làm sao để các ô tam giác này có thể render được.

Kính nhờ các Bác viết giúp đoạn LISP để thực hiện những điều nêu trên. Thanks you.

Viết lisp này khá phức tạp . Hình như 1 bạn nào đó ở Đại học GTVT hay bách khoa HN có hỏi và bác Hoành có giải đáp ; hic nhưng tìm lại topic này chưa được.

Mèo tui dùng các phần mềm như 3D civil hoặc Nova là khỏe re

[Phiphi- 176]

Viết lisp này khá phức tạp . Hình như 1 bạn nào đó ở Đại học GTVT hay bách khoa HN có hỏi và bác Hoành có giải đáp ; hic nhưng tìm lại topic này chưa được.

Mèo tui dùng các phần mềm như 3D civil hoặc Nova là khỏe re

Vậy nhờ Bác dùng pm trên để vẽ giúp cho PP bề mặt 3D của bv post ở bài trên http://www.cadviet.com/upfiles/Ve_be_mat_3D.zip vì PP không biết các pm này.

Cám ơn Bác rất nhiều.

(Bác save ở dạng nào mà AutoCAD đọc được nhé)

[phongks82 0]

chào anh . em rất cần lisp này nhưng em không chạy được . anh lam ơn chỉ từng bước và lệnh chạy cho em nha. CHúc anh vui và thành công trong công việc

[phongks82 0]

Không phải nhiêu khê như vậy, các bạn xem ở đây, cực kỳ đơn giản:

 

http://www.cadviet.com/forum/index.php?showtopic=1787"

 

Tóm lại một cách ngắn gọn:

1. Copy code trên diễn đàn, mở trình Notepad (trình soạn thảo văn bản đơn giản, luôn luôn có sẵn trên máy khi cài đặt Windows) paste vào, save as dạng *.lsp (tên file * đặt tuỳ ý thích)

2. Trong Acad, gõ lệnh appload, chỉ định file *.lsp nói trên và bấm Load - Close. Nếu việc load thành công, Acad sẽ báo "*.lsp successfully loaded". Nếu muốn AutoCAD tự động load lisp khi khởi động, dùng Startup Suite như đã hướng dẫn trong link trên.

3. Tên lệnh của lisp, nếu tác giả không nói rõ là các ký tự nằm kề liền sau (defun C:

Cụ thể, với đoạn chương trình lập bảng toạ độ của ssg là VC. Sau đó, chương trình yêu cầu cái gì thì đáp ứng cái ấy.

 

Good luck!

 

Chào anh SSG em chẳng hiểu em làm sai ở đâu mà khi làm theo yêu cầu của anh vẫn thông báo ở dòng lệnh là Unknown command "VC". Press F1 for help. mặc dù em không làm sai bước nào theo hướng dẫn của anh cả. Nhưng có điều này em không hiếu tại sao copy code trên diễn đàn về paste vào Notepad thì code không sắp xếp theo trình tự như anh viết trên diễn đàn mà nó tạo thành 1 hàng ngang liền mạch. Em sợ lỗi này cho nên tại dòng lệnh không hiểu.Có cách nào khắc phục điều này không anh . ANh chỉ giùm em nha. Mong nhận được sự hồi âm của anh . CHúc anh mạnh khỏe và thành đạt trong cuộc sống.

[chuot8x_online 0]

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!

 

 

 

Rất cảm ơn bác SSG đã nhiệt tình giúp đỡ. Nhưng E có một yêu cầu nhỏ nữa được không ạ? trả là lisp của bác kết quả trả về tọa độ x,y là 4 số thập phân sau dấu phẩy, vậy muốn nó chỉ 1 hoặc 2 hoặc 3 số thập phân thôi thì phải làm thế nào ạ?

[ssg 1.102]

Chào anh SSG em chẳng hiểu em làm sai ở đâu mà khi làm theo yêu cầu của anh vẫn thông báo ở dòng lệnh là Unknown command "VC". Press F1 for help. mặc dù em không làm sai bước nào theo hướng dẫn của anh cả. Nhưng có điều này em không hiếu tại sao copy code trên diễn đàn về paste vào Notepad thì code không sắp xếp theo trình tự như anh viết trên diễn đàn mà nó tạo thành 1 hàng ngang liền mạch. Em sợ lỗi này cho nên tại dòng lệnh không hiểu.Có cách nào khắc phục điều này không anh . ANh chỉ giùm em nha. Mong nhận được sự hồi âm của anh . CHúc anh mạnh khỏe và thành đạt trong cuộc sống.

 

Nếu gặp trường hợp paste vào Notepad bị như trên, bạn paste vào Word cũng được, nhớ chọn canh lề bên trái, nó sẽ sắp xếp y như bạn thấy trên diễn đàn. Bấm saveas, trong hộp "File name" gõ đủ tên file và phần loại .lsp, trong hộp "Save as type" chọn "Plain text (*.txt). Sau đó, trình Word có hỏi gì cũng mặc nó, cứ bấm OK bạn sẽ có file *.lsp

Đó là nói chung cho những lần sau, còn lần này bạn có thể download trực tiếp file lsp từ đây:

 

http://www.cadviet.com/upfiles/BangToaDo2.zip

[ssg 1.102]

Rất cảm ơn bác SSG đã nhiệt tình giúp đỡ. Nhưng E có một yêu cầu nhỏ nữa được không ạ? trả là lisp của bác kết quả trả về tọa độ x,y là 4 số thập phân sau dấu phẩy, vậy muốn nó chỉ 1 hoặc 2 hoặc 3 số thập phân thôi thì phải làm thế nào ạ?

Trình lisp không liên quan đến việc ấy, nó theo thiết lập Units trong bản vẽ của bạn. Bạn dùng lệnh Units, trong Precision chọn mấy số thập phân tuỳ ý thích.

[cadcadcad 0]

http://www.cadviet.com/upfiles/BangToaDo2.zip

Bác ơi em là dân địa chính. Bác viết L này tuyệt quá, em fải thank bác nhiều nhiều, Bác quả là siêu hiii, em vote bác làm Đại ca dẫn đầu. Thank thêm một lần nữa! từ nay em đỡ khổ rồi, vì em toàn dùng tay thôi, h có L này của bác em Công nghiệp đc rồi. Chúc bác luôn khoẻ

[chuot8x_online 0]

Trình lisp không liên quan đến việc ấy, nó theo thiết lập Units trong bản vẽ của bạn. Bạn dùng lệnh Units, trong Precision chọn mấy số thập phân tuỳ ý thích.

 

em đã thử nhưng ko dc bác ah!

[ssg 1.102]

em đã thử nhưng ko dc bác ah!

Hơi vô lý! Thôi được, bạn thử dùng cái này xem:

 

http://www.cadviet.com/upfiles/BangToaDo3.zip

[chuot8x_online 0]

Hơi vô lý! Thôi được, bạn thử dùng cái này xem:

 

http://www.cadviet.com/upfiles/BangToaDo3.zip

 

 

Cám ơn bác SSG nhiều nhiều! cái lisp này thì ok rồi quá tuyệt!

Chúc bác năm mới An Khang Thịnh Vượng! có nhiều đóng góp cho Diễn Đàn!!!!

[dacvien2007 10]

Nhờ anh giúp viết bổ sung cho lisp đánh toạ độ đỉnh thửa đất , nó thể hiện thêm các cạnh đến cm 0,00 m vào

các cạnh qua các đỉnh của hình thể thửa đất

Rất cám ơn và mong tin.

[ssg 1.102]

Nhờ anh giúp viết bổ sung cho lisp đánh toạ độ đỉnh thửa đất , nó thể hiện thêm các cạnh đến cm 0,00 m vào

các cạnh qua các đỉnh của hình thể thửa đất

Rất cám ơn và mong tin.

Không hiểu ý bạn là gì! Ssg rất "lơ mơ" về các khoản có dính đến chữ "địa" (trắc địa, địa chính, địa hình...). Bạn diễn đạt sao cho ssg hiểu, ssg sẽ giúp bạn nếu việc đó nằm trong khả năng.

Và như ssg đã phát biểu nhiều lần trên diễn đàn, file *.dwg minh hoạ tự nó sẽ nói lên nhiều điều, không cần giải thích dài dòng.

[elleHCSC 98]

Không hiểu ý bạn là gì! Ssg rất "lơ mơ" về các khoản có dính đến chữ "địa" (trắc địa, địa chính, địa hình...). Bạn diễn đạt sao cho ssg hiểu, ssg sẽ giúp bạn nếu việc đó nằm trong khả năng.

Và như ssg đã phát biểu nhiều lần trên diễn đàn, file *.dwg minh hoạ tự nó sẽ nói lên nhiều điều, không cần giải thích dài dòng.

 

Khiếp bác Ssg sao lại sợ chữ "địa" thế, có gì đâu mà...cái mà Ssg sợ đúng hơn là sợ mọi người diễn đạt cho ssg không thấu đáo hết ý của họ muốn thôi mà...

 

đây là cái mẫu mà sẽ nhiều "ông" trắc địa sẽ hỏi xem làm sao dùng lisp mà được vầy...

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

 

Vẫn dựa trên cái VC của ssg đã post trước đây, elleHCSC cũng đã thêm 1 chút vào cái VC của ssg để cho ra cái cạnh như ý của dacvien2007 hỏi nhưng chửa có xong..cuối năm bận quá, ssg chỉnh thêm nhé...

 

;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a) ;;;Entmake text S at p with angle A - Top Center
 (if (/= p nil)
     (entmake (list
      (cons 0 "TEXT")
      (cons 62 5)
      (cons 10 p)	      
      (cons 40 (getTh))
      (cons 1 S)
      (cons 50 a)
      (cons 41 0.7)
      (cons 51 (DTR 18))
      (cons 7 (getvar "textstyle"))	      
      (cons 72 1)
      (cons 11 p)
      (cons 73 3)
    )
     )
  )
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a) ;;;Entmake text S at p with angle A - Bottom Center
 (if (/= p nil)
     (entmake (list
      (cons 0 "TEXT")
      (cons 62 5)
      (cons 10 p)	      
      (cons 40 (getTh))
      (cons 1 S)
      (cons 50 a)
      (cons 41 0.7)
      (cons 51 (DTR 18))
      (cons 7 (getvar "textstyle"))	      
      (cons 72 1)
      (cons 11 p)
      (cons 73 1)
    )
     )
  ) 
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (e / h i pvL k p1 p2 dist rad x_mp y_mp mp)
   (setq
     h (getth)
     i 0
     pvL (reverse (getvert e))
     k (1- (length pvL))      
   )  
 (repeat k
    (setq
       p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)	
x_mp (* (+ (car p1) (car p2)) 0.5)
       y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
    )          
      (if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))	   
 (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h) ))	   
      )
      (if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
 (progn	    
    (setq rad (+ rad pi))
    (Text_canh_TCA (rtos dist 2 2) mp rad)	   
 )
 (Text_canh_BCA (rtos dist 2 2) mp rad)	 
      )
    (setq i (1+ i))    
 );; repeat k;
)
;;;-------------------------------------------------------------------------------

[ssg 1.102]

Ssg hiểu rồi, cám ơn bạn!

Đây là "chương trình hợp tác" Chào Mừng Năm Mới 2009 của ssg và elleHCSC. Các bạn dùng, check thử và cho ý kiến để hoàn thiện thêm:

 

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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




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

;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

;;;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) 2 ntp)) (setq S ""))
   (setq txtL (list num (rtos (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) 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))
(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))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

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



;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a) ;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a) ;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (e / i pvL k p1 p2 dist rad x_mp y_mp mp)
(setq
i 0
pvL (reverse (getvert e))
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h) ))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
)
(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq i (1+ i))
);; repeat k;
)
;;;--------------------------

[thacvh 0]

Cảm ơn các bác đã chia sẻ tri thức của mình cho mọi người sử dụng. Mình cũng nhờ các bác mà giải quyết được một số vấn đề. Mình có 1 cái lisp dùng để ghi kích thứơc cạnh thửa đất trên bản đồ địa chinh liều mình gửi lên đây các bác xem sử dụng được không nhé, hiện tại mình đang sử dụng tốt.

(defun hhctd (pt bang dc / a ptm)

(command "ucs" "")

(setq a (/ (* bang 180) pi))

(setq ptm (list 0 dc))

(command "UCS" "O" pt)

(command "UCS" "z" a)

(setq ptm (trans ptm 1 0))

(command "UCS" "")

(setq ptm ptm)

)

(defun et( pt3 dcen ang dit ha / pp)

(setq pp (list (cons 0 "TEXT")(cons 8 "POLY")(cons 62 2)(cons 41 0.8)

(cons 51 0.0)(cons 7 "TXT")(cons 71 0)(cons 72 1)(cons 73 ha)

(cons 210 '(0.0 0.0 1.0))(cons 10 '(0.0 0.0))

(cons 11 pt3)(cons 40 dcen)(cons 1 dit)

(cons 50 ang)

))

(entmake pp)

)

(defun etm( pt3 dcen ang dit ha / pp)

(setq pp (list (cons 0 "TEXT")(cons 8 "POLY")(cons 62 50)(cons 41 0.8)

(cons 51 0.0)(cons 7 "TXT")(cons 71 0)(cons 72 1)(cons 73 ha)

(cons 210 '(0.0 0.0 1.0))(cons 10 '(0.0 0.0))

(cons 11 pt3)(cons 40 dcen)(cons 1 dit)

(cons 50 ang)

))

(entmake pp)

)

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

(defun reierror (s)

(if (/= s "Function cancelled")

(princ (strcat "Error: " s))

)

(setq *error* olderr)

(close fp)

)

(defun c:gnha1( / ee l ll ss el n i pt1 pt2 )

(setq olderr *error* *error* rierror)

(setq ee nil ss ())

(setq dcen (getvar"dimcen"))

(setq dc (+ (* dcen 0.32) dcen) )

(setq ee (bpoly (getpoint"\nchon tam diem:")))

(setq rr ee)

(if (/= ee nil)

(progn

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

(while (/= l "SEQEND")

(setq ll (cdr (assoc 10 el)))

(setq ll (list ll))

(setq ss (append ss ll))

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

)

(setq ll (nth 0 ss))

(setq ll (list ll))

(setq ss (append ss ll))

(setq n (length ss))

(setq i 0)

(setq n (- n 1))

(while (< i n)

(setq ha 1)

(setq pt1 (nth i ss))

(setq pt2 (nth (+ i 1) ss))

(setq pt3 (pt_mid pt1 pt2))

(setq dit (rtos (distance pt1 pt2) 2 2))

(setq ang (angle pt1 pt2))

(setq bang ang)

(if (and (< ang 5.289) (> ang 2.08)) (progn

(setq ha 3)

(setq pt3 (hhctd pt3 ang dc))

);end progn

(progn

(setq pt3 (hhctd pt3 ang dcen))

);end progn

)

(if (> ang 4.71)(setq ang (- ang pi)))

(if (and (<= ang 4.71)(> ang 2.09))(setq ang (+ ang pi)))

(et pt3 dcen ang dit ha)

(setq i (+ i 1))

);end while

); end progn

);end if

(command "erase" rr "")

(redraw)

(setq ee nil ss ())

(Princ)

)

(defun c:gnha( / ee l ll ss el n i pt1 pt2 )

(setq olderr *error* *error* rierror)

(setq ee nil ss ())

(setq dcen (getvar"dimcen"))

(setq dc (* dcen 0.32))

(setq ee (bpoly (getpoint"\nchon tam diem:")))

(setq rr ee)

(if (/= ee nil)

(progn

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

(while (/= l "SEQEND")

(setq ll (cdr (assoc 10 el)))

(setq ll (list ll))

(setq ss (append ss ll))

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

)

(setq ll (nth 0 ss))

(setq ll (list ll))

(setq ss (append ss ll))

(setq n (length ss))

(setq i 0)

(setq n (- n 1))

(while (< i n)

(setq ha 1)

(setq pt1 (nth i ss))

(setq pt2 (nth (+ i 1) ss))

(setq pt3 (pt_mid pt1 pt2))

(setq dit (rtos (distance pt1 pt2) 2 2))

(setq ang (angle pt1 pt2))

(setq bang ang)

(if (and (< ang 5.289) (> ang 2.08)) (progn

(setq ha 3)

(setq pt3 (hhctd pt3 ang dc))

);end progn

)

(if (> ang 4.71)(setq ang (- ang pi)))

(if (and (<= ang 4.71)(> ang 2.09))(setq ang (+ ang pi)))

(et pt3 dcen ang dit ha)

(setq i (+ i 1))

);end while

); end progn

);end if

(command "erase" rr "")

(redraw)

(setq ee nil ss ())

(Princ)

)

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

(defun taolp ( pt / ee l ll ss el n)

(setq ee nil ss ())

(setq ee (bpoly pt))

(setq rr ee)

(if (/= ee nil)

(progn

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

(while (/= l "SEQEND")

(setq ll (cdr (assoc 10 el)))

(setq ll (list ll))

(setq ss (append ss ll))

(setq ee (entnext ee))

(setq el (entget ee))

(setq l (cdr (assoc 0 el)))

)

(setq ll (nth 0 ss))

(setq ll (list ll))

(command "erase" rr "")

(setq ss (append ss ll))

); end progn

(setq ss nil)

);end if

)

 

 

(defun c:GKT1()

;;; (c:txt)

(setq olderr *error* *error* rierror)

(setq dem 0)

(setq dcen (getvar "DIMCEN"))

(setq ppt1 (getpoint "\nChon goc duoi: "))

(setq ppt2 (getcorner ppt1 "\nChon goc tren: "))

(setq $$19 (ssget "c" ppt1 ppt2 (list (cons 0 "LINE"))))

(setq l (sslength $$19))

(setq i 0)

(repeat l

(setq ss (ssname $$19 i))

(setq assolist (entget ss))

(setq pt1 (cdr (assoc 10 assolist)))

(setq pt2 (cdr (assoc 11 assolist)))

(setq pt3 (pt_mid pt1 pt2))

(setq dit (rtos (distance pt1 pt2) 2 2))

(setq ang (angle pt1 pt2))

(if (> ang 4.71)(setq ang (- ang pi)))

(if (and (<= ang 4.71)(> ang 2.09))(setq ang (+ ang pi)))

(etm pt3 dcen ang dit 1)

(setq i (1+ i))

)

(setq $$19 nil)

(command "insert" "gr" pt1 (/ dcen 3) "" "")

(command "insert" "gr" pt2 (/ dcen 3) "" "")

(princ)

)

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

; HAM TRA VE GIA TRI MID CUA HAI DIEM;;;;;;;

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

(defun pt_mid( pt1 pt2 / x1 x2 y1 y2 x3 y3 pt3)

(setq x1 (car pt1) y1 (cadr pt1))

(setq x2 (car pt2) y2 (cadr pt2))

(setq x3 (+ x1 (/ (- x2 x1) 2 )))

(setq y3 (+ y1 (/ (- y2 y1) 2 )))

(setq pt3 (list x3 y3))

)

(princ)

[tnmtpc 207]

Cảm ơn các bác đã chia sẻ tri thức của mình cho mọi người sử dụng. Mình cũng nhờ các bác mà giải quyết được một số vấn đề. Mình có 1 cái lisp dùng để ghi kích thứơc cạnh thửa đất trên bản đồ địa chinh liều mình gửi lên đây các bác xem sử dụng được không nhé, hiện tại mình đang sử dụng tốt.

Cám ơn bạn đã chia sẻ, dân địa chính cần cái này lắm, nhưng bạn post thiếu file gr.dwg nên chương trìng báo lỗi. Bạn hãy post file này lên đi. Thanks!