Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2621 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 18 November 2010 - 11:50 PM

giúp em vài vấn đề này với nhe mấy anh
có thể dùng lisp hoặc cách nào nhanh nhất nhe
vì số lượng bản đồ qui hoạch thì rất là lớn
tình hình là như vầy
http://www.cadviet.c.../3/aaaaaa_2.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe

Hề hề hề,
Chịu thôi bạn phongthien ơi, cái bản vẽ bạn post nên nào thấy có đướng line tím với trắng nào đâu hử bạn?????
Hề hề hề,...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2622 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 19 November 2010 - 07:57 AM

em có 1 file lisp của anh Thiep nhưng chạy thì nó báo lởi:
APPLOAD trichthua.lsp successfully loaded.
Command: ; error: malformed list on input
Mong được giúp đở..thank!
http://www.cadviet.c...3/trichthua.lsp

Chào kamezoko
Có lẽ chức năng download Lisp đã bị lỗi
Lỗi ở đây
(setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (:iluvyousmiley:

.....
Bạn xem topic này và tìm cách sửa nhé .
Chú ý đọc kỹ Bai viet so 36 của bác thiep
Chúc thành công
  • 1

#2623 phongthien

phongthien

    biết vẽ line

  • Members
  • PipPip
  • 23 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 November 2010 - 10:51 AM

Em gửi lại đây anh bình ơi!
http://www.cadviet.c...es/3/phanlo.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe
  • 0

#2624 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 19 November 2010 - 12:31 PM

Em gửi lại đây anh bình ơi!
http://www.cadviet.c...es/3/phanlo.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe

Hề hề hề,
Kết quả đownload:
Không tìm thấy file trên server!
Hề hề hề, khổ quá.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2625 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 19 November 2010 - 01:10 PM

Hề hề hề,
Kết quả đownload:
Không tìm thấy file trên server!
Hề hề hề, khổ quá.....

èo sever cadviet sao vậy nhỉ
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2626 phongthien

phongthien

    biết vẽ line

  • Members
  • PipPip
  • 23 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 November 2010 - 01:23 PM

sao bị gì hoài vậy
giúp em vài vấn đề này với nhe mấy anh
có thể dùng lisp hoặc cách nào nhanh nhất nhe
vì số lượng bản đồ qui hoạch thì rất là lớn
tình hình là như vầy:
http://www.cadviet.c...tle_block_1.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe
  • 0

#2627 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 19 November 2010 - 01:59 PM

em có 1 file lisp của anh Thiep nhưng chạy thì nó báo lởi:
APPLOAD trichthua.lsp successfully loaded.
Command: ; error: malformed list on input
Mong được giúp đở..thank!
http://www.cadviet.c...3/trichthua.lsp

Chào bạn Kamezoko, lisp trên bạn dowload bị thiếu nhiều dòng
Bạn qua bên này chép lại lisp trích thửa, Thiep đã up lên cho bạn Bluster, lisp sau này Thiep đã update cho phép người dùng trích thửa bằng hình chữ nhật, hình vuông, hình tròn.
http://www.cadviet.c...&...st&p=113512
Nhớ là CAD của bạn phải có Express Tool.
  • 1

#2628 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 19 November 2010 - 03:00 PM

có lẽ do em giải thích không rõ nên anh khó hiểu, em đã úp lại file,em đã vẽ một mặt cắt ngang tại vị trị em đã ghi chú trong bản vẽ,và đường chân công trình tức là đường giao mái với mặt đất như thế.nếu như em cắt ngang toàn tuyến và vẽ các mặt cắt ngang tại vị trí khác nhau rồi em nối các điểm giao với mặt đất đấy lại em sẽ được đường chân hoàn chỉnh của một mái đắp http://www.cadviet.c...s/3/vi_du_1.dwg mong anh giúp,nếu mà vẽ từng mặt cắt như thế rồi nối lại lâu quá,

Chào bạn ATL,
Về thuật toán để tìm cái đường chân đập của bạn thì không khó, nó tương đồng với bài toán tìm giao tuyến giữa mặt phẳng nghiêng của 2 mái đập với mặt địa hình. Tuy nhiên theo Thiep, để bài toán dễ giải quyết, bạn nên đưa các đường đồng mức lên đúng độ cao của nó, 2 line của tuyến đập dự kiến cũng phải có độ cao. Nghĩa là sẽ giải quyết bài toán này trong 3D. Hiện nay, các nhà trắc địa thường giao bản vẽ địa hình trên 3D, bạn up lại bản vẽ có 3D này, Thiep sẽ bỏ chút ít thời gian giúp bạn. Hiện nay Thiep rất ít thời gian rãnh rỗi, có thể bạn sẽ chờ lâu đó.
  • 0

#2629 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 19 November 2010 - 06:13 PM

Mò mãi mà không ra. Bác Gia Bạnh giúp em tạo cái bảng này bằng lisp của bác được không?
Hình đã gửi
Còn đây là file cad của em.
File cad

Các chỗ khác vẫn bình thường duy chỉ có cột W và H là khác. Block của em có tên là W x H.

Mình thấy có thể giúp bạn nhưng chưa rõ mục đích tạo bảng này của bạn ví dụ như đếm block và lập thành bảng hay chỉ vẻn vẹn là tạo bảng hay thôi. Mong bạn chỉ rõ hơn.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2630 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 19 November 2010 - 08:26 PM

sao bị gì hoài vậy
giúp em vài vấn đề này với nhe mấy anh
có thể dùng lisp hoặc cách nào nhanh nhất nhe
vì số lượng bản đồ qui hoạch thì rất là lớn
tình hình là như vầy:
http://www.cadviet.c...tle_block_1.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe

Mình mới viết được cho bạn như thế này. Lisp chạy hơi chậm bạn chịu khó đợi nhé. Bạn test thử rồi cho ý kiến để bổ xung. Do mình không có thời gian nên chưa nghiên cứu sâu được.

(defun c:nline ()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget "x" (list (cons 0 "LINE") (cons 8 "thua cly"))))
(setq kc (getreal "\nNhap khoang cach can noi cac line: "))
(setq i 0)
(while (< i (sslength ss))
(setq name1 (ssname ss i))
(setq ent1 (entget name1))
(setq ob1 (vlax-ename->vla-object name1))
(setq cor (vla-get-color ob1))
(setq p1 (cdr (assoc 10 ent1)))
(setq p2 (cdr (assoc 11 ent1)))
(setq j 0)
(while (< j (sslength ss))
(setq name2 (ssname ss j))
(setq ent2 (entget name2))
(setq ob2 (vlax-ename->vla-object name2))
(setq cor1 (vla-get-color ob2))
(setq p3 (cdr (assoc 10 ent2)))
(setq p4 (cdr (assoc 11 ent2)))
(setq d1 (distance p1 p3))
(setq d2 (distance p1 p4))
(setq d3 (distance p2 p3))
(setq d4 (distance p2 p4))
(entmake (list (cons 0 "CIRCLE") (cons 10 p3) (cons 40 (/ kc 2))))
(setq el1 (entlast))
(setq g1 (acet-geom-intersectwith name1 el1 1))
(entmake (list (cons 0 "CIRCLE") (cons 10 p4) (cons 40 (/ kc 2))))
(setq el2 (entlast))
(setq g2 (acet-geom-intersectwith name1 el2 1))
(if (and (< d1 kc) (= cor1 256))
(entmod (setq ent2 (subst (cons 10 p1) (assoc 10 ent2) ent2)))
)
(if (and (< d2 kc) (= cor1 256))
(entmod (setq ent2 (subst (cons 11 p1) (assoc 11 ent2) ent2)))
)
(if (and (< d3 kc) (= cor1 256))
(entmod (setq ent2 (subst (cons 10 p2) (assoc 10 ent2) ent2)))
)
(if (and (< d4 kc) (= cor1 256))
(entmod (setq ent2 (subst (cons 11 p2) (assoc 11 ent2) ent2)))
)
(if (and (= cor 3) (/= g1 nil) (= cor1 256) (= (length g1) 2))
(progn
(setq giao (car (acet-geom-intersectwith name1 name2 2)))
(if (= (acet-geom-intersectwith name1 name2 1) nil)
(entmod (setq ent2 (subst (cons 10 giao) (assoc 10 ent2) ent2)))
)
)
)
(if (and (= cor 3) (/= g2 nil) (= cor1 256) (= (length g2) 2))
(progn
(setq giao (car (acet-geom-intersectwith name1 name2 2)))
(if (= (acet-geom-intersectwith name1 name2 1) nil)
(entmod (setq ent2 (subst (cons 11 giao) (assoc 11 ent2) ent2)))
)
)
)
(entdel el1)
(entdel el2)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setvar "osmode" oldos)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2631 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 19 November 2010 - 08:30 PM

sao bị gì hoài vậy
giúp em vài vấn đề này với nhe mấy anh
có thể dùng lisp hoặc cách nào nhanh nhất nhe
vì số lượng bản đồ qui hoạch thì rất là lớn
tình hình là như vầy:
http://www.cadviet.c...tle_block_1.dwg
tự động tìm các khoảng hở giữa các đường line rồi cho bắn các đường đó đụng vào nhau
mà khi quét cả bản đồ thì chỉ các đường line màu tím bắn đụng đường màu xanh thôi nhe
còn đường màu trắng thì giữ nguyên
sau đó tính diện tích đồng loạt các thửa đó rùi xuất qua exell theo ba cột số thửa, loại đất, diện tích nhe
monh các anh cố gắn giúp đỡ dùm
cám ơn thật nhiều nhe

Chào bạn phongthien,
Bạn dùng thử cái này coi, có gì chưa ổn hãy post lên để mình xem lại.

(defun c:tkqh ( / sls ssl1 ssl2 p1 p2 p3 p4 els sst sld qhlst p sth st x y1 y2 plst ld dt )
(vl-load-com)
(command "undo" "be")
(setq sls (acet-ss-to-list (ssget (list (cons 0 "line") (cons 8 "thua cly"))))
ssl1 (list)
ssl2 (list)
)
(foreach x sls
(if (= (cdr (assoc 62 (entget x))) 3)
(setq ssl1 (append ssl1 (list x))))
(if (= (assoc 62 (entget x)) nil)
(setq ssl2 (append ssl2 (list x))))
)

(foreach y1 ssl1
(setq obj1 (vlax-ename->vla-object y1))
(foreach y2 ssl2
(setq els (entget y2)
p1 (cdr (assoc 10 els))
p2 (cdr (assoc 11 els))
p3 (vlax-curve-getclosestpointto obj1 p1)
p4 (vlax-curve-getclosestpointto obj1 p2)
)
(if (and (> (distance p1 p3) 0 ) (< (distance p1 p3 ) 5))
(setq els (subst (cons 10 p3) (assoc 10 els) els))
)
(if (and (> (distance p2 p4) 0 ) (< (distance p2 p4) 5))
(setq els (subst (cons 11 p4) (assoc 11 els) els))
)
(entmod els)
)
)

(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "sothua"))))
qhlst (list)
)

(foreach st sst
(setq p (cdr (assoc 10 (entget st)))
sth (cdr (assoc 1 (entget st)))
)
(command ".boundary" p "")
(setq plst (acet-geom-vertex-list (entlast))
sld (ssget "cp" plst (list (cons 0 "text") (cons 8 "loaidat")))
)
(if (/= sld nil)
(setq ld (cdr (assoc 1 (entget (ssname sld 0)))))
(setq ld "No")
)
(command "area" "o" (entlast))
(setq dt (getvar "area")
qhlst (append qhlst (list (list sth ld dt)))
)

(command "erase" (entlast) "" )
)
(command "undo" "e")
(writetoexcel qhlst)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add")
"Sheets")
"Item" 1)
"Cells"))
(setq row 3)
(foreach pt lst_data
(setq col 3)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col)))
(setq row (1+ row)) )
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()(if x (vlax-release-object x)))))))
(list xlCells xlApp))
(gc) (gc) )


Chúc bạn vui.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2632 phongthien

phongthien

    biết vẽ line

  • Members
  • PipPip
  • 23 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 November 2010 - 09:19 PM

đúng rồi đó anh bình, nhưng vầy nè anh bình
em chỉ để những đường bị hở màu xanh để anh biết những đường line đó bị hở thôi
ý em là tự tìm những khoảng hở đó rồi tự nối vào không phân biệt màu nào cả
Lisp của anh thì sao màu khác thì nó lại không nối
nối lại rồi thì nó bị dư râu ra nữa
vì em phải xuất những bản đồ qua famis nên cần phải bỏ râu và line không bị hở.
file bản đồ thì của người khác làm rồi đưa cho em nên giờ em phải tự dọn lại như vậy đó, mà làm thủ công thì chắc phải năm sau mới xong quá.anh giúp em hé.
còn tính diện tích thì anh có thể viết một lisp khác được hong anh.ví dụ như em kích vào thửa nào thì thửa đó mới xuất qua exell xhứ không xuất một cách đồng loạt.để em làm bảng tổng hợp theo thứ tự của riêng em(thửa 1 rồi đến thửa 5) vậy đó
Nếu được vậy thì em cám ơn thật nhiều nhe!!!
file mới đầy đủ hơn nè
http://www.cadviet.c...tle_block_3.dwg
  • 0

#2633 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 19 November 2010 - 09:34 PM

Chào bạn phongthien,
Bạn dùng thử cái này coi, có gì chưa ổn hãy post lên để mình xem lại.


(defun c:tkqh ( / sls ssl1 ssl2 p1 p2 p3 p4 els sst sld qhlst p sth st x y1 y2 plst ld dt )
(vl-load-com)
(command "undo" "be")
(setq sls (acet-ss-to-list (ssget (list (cons 0 "line") (cons 8 "thua cly"))))
ssl1 (list)
ssl2 (list)
)
(foreach x sls
(if (= (cdr (assoc 62 (entget x))) 3)
(setq ssl1 (append ssl1 (list x))))
(if (= (assoc 62 (entget x)) nil)
(setq ssl2 (append ssl2 (list x))))
)

(foreach y1 ssl1
(setq obj1 (vlax-ename->vla-object y1))
(foreach y2 ssl2
(setq els (entget y2)
p1 (cdr (assoc 10 els))
p2 (cdr (assoc 11 els))
p3 (vlax-curve-getclosestpointto obj1 p1)
p4 (vlax-curve-getclosestpointto obj1 p2)
)
(if (and (> (distance p1 p3) 0 ) (< (distance p1 p3 ) 5))
(setq els (subst (cons 10 p3) (assoc 10 els) els))
)
(if (and (> (distance p2 p4) 0 ) (< (distance p2 p4) 5))
(setq els (subst (cons 11 p4) (assoc 11 els) els))
)
(entmod els)
)
)

(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "sothua"))))
qhlst (list)
)

(foreach st sst
(setq p (cdr (assoc 10 (entget st)))
sth (cdr (assoc 1 (entget st)))
)
(command ".boundary" p "")
(setq plst (acet-geom-vertex-list (entlast))
sld (ssget "cp" plst (list (cons 0 "text") (cons 8 "loaidat")))
)
(if (/= sld nil)
(setq ld (cdr (assoc 1 (entget (ssname sld 0)))))
(setq ld "No")
)
(command "area" "o" (entlast))
(setq dt (getvar "area")
qhlst (append qhlst (list (list sth ld dt)))
)

(command "erase" (entlast) "" )
)
(command "undo" "e")
(writetoexcel qhlst)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add")
"Sheets")
"Item" 1)
"Cells"))
(setq row 3)
(foreach pt lst_data
(setq col 3)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col)))
(setq row (1+ row)) )
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()(if x (vlax-release-object x)))))))
(list xlCells xlApp))
(gc) (gc) )


Chúc bạn vui.

Chào bác Bình!
Lisp của bác chạy tốt nhưng đường line màu xanh bị thừa ra một đoạn. Sao em thử dùng (entget (car (entsel))) chọn đường line bất kì thì không thấy mã dxf 62 nhỉ mà dùng hàm (vla-get-color (vlax-ename->vla-object (car (entsel)))) thì nó toàn ra màu 256 bác nào có thể giải thích hộ vấn đề này được không.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2634 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 19 November 2010 - 09:53 PM

Chào bác Bình!
Lisp của bác chạy tốt nhưng đường line màu xanh bị thừa ra một đoạn. Sao em thử dùng (entget (car (entsel))) chọn đường line bất kì thì không thấy mã dxf 62 nhỉ mà dùng hàm (vla-get-color (vlax-ename->vla-object (car (entsel)))) thì nó toàn ra màu 256 bác nào có thể giải thích hộ vấn đề này được không.


Các mã DXF lấy đc từ hàm entget thì e thấy mã 62 này chỉ xuất hiện khi mình đổi màu của đối tượng đó thôi. Còn khi mà để màu theo kiểu bylayer... thì nó sẽ ko có. thế nên nhiều líp muốn đổi màu của 1 đối tượng thì phải kiểm tra xem nó có mã 62 chưa. nếu có thì dùng bình thường như các mã khác. Nếu chưa có thì dùng hàm cons để thêm mã 62 này vào trong cái list có đc từ hàm entget.
  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#2635 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 19 November 2010 - 10:20 PM

Các mã DXF lấy đc từ hàm entget thì e thấy mã 62 này chỉ xuất hiện khi mình đổi màu của đối tượng đó thôi. Còn khi mà để màu theo kiểu bylayer... thì nó sẽ ko có. thế nên nhiều líp muốn đổi màu của 1 đối tượng thì phải kiểm tra xem nó có mã 62 chưa. nếu có thì dùng bình thường như các mã khác. Nếu chưa có thì dùng hàm cons để thêm mã 62 này vào trong cái list có đc từ hàm entget.

À ra vậy. Thế thì màu 256 chắc là bylayer. Thank bạn.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2636 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 19 November 2010 - 10:26 PM

Chào bác Bình!
Lisp của bác chạy tốt nhưng đường line màu xanh bị thừa ra một đoạn. Sao em thử dùng (entget (car (entsel))) chọn đường line bất kì thì không thấy mã dxf 62 nhỉ mà dùng hàm (vla-get-color (vlax-ename->vla-object (car (entsel)))) thì nó toàn ra màu 256 bác nào có thể giải thích hộ vấn đề này được không.

Chào bác Phamngoctukts,
Màu 256 là màu được lấy theo bylayer, và khi đối tượng có màu là bylayer thì trong mã dxf của nó không còn mã 62 nữa bác ạ.
Còn cái line màu xanh là origin của bạn phongthien, chứ mình có làm gì nó đâu. Bác đọc lisp sẽ thấy mà....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2637 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 19 November 2010 - 11:10 PM

Chào bác Phamngoctukts,
Màu 256 là màu được lấy theo bylayer, và khi đối tượng có màu là bylayer thì trong mã dxf của nó không còn mã 62 nữa bác ạ.
Còn cái line màu xanh là origin của bạn phongthien, chứ mình có làm gì nó đâu. Bác đọc lisp sẽ thấy mà....

Em hiểu rồi bác ạ. Đường màu xanh thòi ra một đoạn là do bác entmod endpoint của thằng màu tím đến điểm giao của hai thằng còn lisp của em thì entmod endpoint của thằng màu tím đến endpoint của thằng màu xanh. Vì ssao Em dùng lisp của bác không thấy xuất sang exel được nhể.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2638 atl

atl

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 19 November 2010 - 11:33 PM

Chào bạn ATL,
Về thuật toán để tìm cái đường chân đập của bạn thì không khó, nó tương đồng với bài toán tìm giao tuyến giữa mặt phẳng nghiêng của 2 mái đập với mặt địa hình. Tuy nhiên theo Thiep, để bài toán dễ giải quyết, bạn nên đưa các đường đồng mức lên đúng độ cao của nó, 2 line của tuyến đập dự kiến cũng phải có độ cao. Nghĩa là sẽ giải quyết bài toán này trong 3D. Hiện nay, các nhà trắc địa thường giao bản vẽ địa hình trên 3D, bạn up lại bản vẽ có 3D này, Thiep sẽ bỏ chút ít thời gian giúp bạn. Hiện nay Thiep rất ít thời gian rãnh rỗi, có thể bạn sẽ chờ lâu đó.

cảm ơn thiep đã quan tâmkhông phải mình không muốn giao file địa hình 3d mà đây là file của khảo sát giao đấy,mà bình đồ mình toàn 2d không thôi,
  • 0

#2639 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 20 November 2010 - 12:08 AM

đúng rồi đó anh bình, nhưng vầy nè anh bình
em chỉ để những đường bị hở màu xanh để anh biết những đường line đó bị hở thôi
ý em là tự tìm những khoảng hở đó rồi tự nối vào không phân biệt màu nào cả
Lisp của anh thì sao màu khác thì nó lại không nối
nối lại rồi thì nó bị dư râu ra nữa
vì em phải xuất những bản đồ qua famis nên cần phải bỏ râu và line không bị hở.
file bản đồ thì của người khác làm rồi đưa cho em nên giờ em phải tự dọn lại như vậy đó, mà làm thủ công thì chắc phải năm sau mới xong quá.anh giúp em hé.
còn tính diện tích thì anh có thể viết một lisp khác được hong anh.ví dụ như em kích vào thửa nào thì thửa đó mới xuất qua exell xhứ không xuất một cách đồng loạt.để em làm bảng tổng hợp theo thứ tự của riêng em(thửa 1 rồi đến thửa 5) vậy đó
Nếu được vậy thì em cám ơn thật nhiều nhe!!!
file mới đầy đủ hơn nè
http://www.cadviet.c...tle_block_3.dwg

Hề hề hề,
Bạn dùng tạm cái này coi sao. Việc cắt râu có nhẽ phải tự làm tay , đặc biệt là ở các góc không vuông. Lisp này chỉ nối các khoảng hở nhỏ hơn 1 vì trong các thửa đất của bạn có thửa chỉ rộng 1,8 nên nếu cho phép nối khe hở lớn hơn có thể dẫn tới mất đi một số thửa bạn ạ. Nó cũng cho phép cắt râu ngắn hơn 1 ở các giao điểm chữ T, nhưng ở các góc chữ L thì chỉ cắt được khi là góc vuông thôi bạn nhé.
Bạn có thể chọn số thửa cần lấy diện tích bằng cách pick vào các text số thửa theo ý của bạn khi lisp yêu cần bạn chọn số thửa cần ghi diện tích. Kết quả sẽ xuất sang file excel đúng những thứ bạn cần.

(defun c:tkqh ( / sls ssl1 ssl2 p1 p2 p3 p4 els sst sld qhlst p sth st x y1 y2 plst ld dt oldos )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq sls (acet-ss-to-list (ssget (list (cons 0 "line") (cons 8 "thua cly"))))
ssl1 (list)
ssl2 (list)
)
(foreach x sls
(setq obj1 (vlax-ename->vla-object x))
(setq ssl2 (vl-remove x sls))
(foreach y2 ssl2
(setq els (entget y2)
p1 (cdr (assoc 10 els))
p2 (cdr (assoc 11 els))
p3 (vlax-curve-getclosestpointto obj1 p1)
p4 (vlax-curve-getclosestpointto obj1 p2)
)
(if (and (> (distance p1 p3) 0 ) (< (distance p1 p3 ) 1))
(setq els (subst (cons 10 p3) (assoc 10 els) els))
)
(if (and (> (distance p2 p4) 0 ) (< (distance p2 p4) 1))
(setq els (subst (cons 11 p4) (assoc 11 els) els))
)
(entmod els)
)
)

(alert "\n Chon cac thua can tinh dien tich theo so thua")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "sothua"))))
qhlst (list)
)

(foreach st sst
(setq p (cdr (assoc 10 (entget st)))
sth (cdr (assoc 1 (entget st)))
)
(command ".boundary" p "")
(setq plst (acet-geom-vertex-list (entlast))
sld (ssget "cp" plst (list (cons 0 "text") (cons 8 "loaidat")))
)
(if (/= sld nil)
(setq ld (cdr (assoc 1 (entget (ssname sld 0)))))
(setq ld "No")
)
(command "area" "o" (entlast))
(setq dt (getvar "area")
qhlst (append qhlst (list (list sth ld dt)))
)

(command "erase" (entlast) "" )
)
(setvar "osmode" oldos)
(command "undo" "e")
(writetoexcel qhlst)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add")
"Sheets")
"Item" 1)
"Cells"))
(setq row 3)
(foreach pt lst_data
(setq col 3)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col)))
(setq row (1+ row)) )
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()(if x (vlax-release-object x)))))))
(list xlCells xlApp))
(gc) (gc) )

Hy vọng nó sẽ có ích cho bạn phần nào...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2640 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 20 November 2010 - 12:23 AM

cảm ơn thiep đã quan tâmkhông phải mình không muốn giao file địa hình 3d mà đây là file của khảo sát giao đấy,mà bình đồ mình toàn 2d không thôi,

Chào bạn atl,
Bạn có thể nói rõ cách bạn dựng các mặt cắt dựa theo bình đồ được không. Hiện mình cũng đang bí chỗ này do chưa biết bạn nội suy các điểm trên mặt cắt như thế nào. Biết cách dựng mắt cắt của bạn thì việc vẽ cái đường chân công trình sẽ không khó lắm nữa bạn ạ. Mình có thể tự nội suy theo cái kiểu của mình nhưng sợ không phù hợp với cái bạn cần. Mặt khác các đường đồng mức của bạn trên bình đồ cũng không thể hiện rõ cao độ của nó nên hơi khó hình dung bạn ạ. Không nhẽ lại phải tự tính ra cái cao độ của các đường đồng mức này dựa trên các điểm đo đã có trên bình đồ hay sao hả bạn.???
Rất mong bạn trả lời.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.