Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

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

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

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.com/upfiles/3/ansi_c_title_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

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
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.com/upfiles/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.com/forum/index.php?s=&...st&p=113512

Nhớ là CAD của bạn phải có Express Tool.

  • Vote tăng 1

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
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.com/upfiles/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 đó.

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

0000_3.jpg

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.

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
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.com/upfiles/3/ansi_c_title_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)
 )

  • Vote tăng 1

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
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.com/upfiles/3/ansi_c_title_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 ) (                   (setq els (subst (cons 10 p3) (assoc 10 els) els))
              )
              (if (and (> (distance p2 p4) 0 ) (                   (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.

  • Vote tăng 2

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

đú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.com/upfiles/3/ansi_c_title_block_3.dwg

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

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

  • Vote tăng 1

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

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
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à....

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
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ể.

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

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
đú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.com/upfiles/3/ansi_c_title_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 ) (                   (setq els (subst (cons 10 p3) (assoc 10 els) els))
              )
              (if (and (> (distance p2 p4) 0 ) (                   (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...

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

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
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ể.

Nó có xuất đó nhưng hơi chậm nếu như bác chưa mở phần mềm Excel ra trước khi chạy lisp bác ạ. Kết quả sẽ nằm trong một file excel mới toe chứ không nằm trong các file đã mở trước.

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

Chào các bác!

Mình chưa rành về cad mấy, mình có một số vấn đề mong các bác giúp dùm. mình có upload file đính kèm đây http://www.cadviet.com/upfiles/3/mtext_1.dwg

Đối tượng trong file của mình là mtext sao mình explode thì không còn đọc được nữa, trong đoạn mtext của mình có cả số lẫn chữ mình miốn tách chữ ra riêng số riêng. Bác nào biết xin giúp mình với

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
Chào các bác!

Mình chưa rành về cad mấy, mình có một số vấn đề mong các bác giúp dùm. mình có upload file đính kèm đây http://www.cadviet.com/upfiles/3/mtext_1.dwg

Đối tượng trong file của mình là mtext sao mình explode thì không còn đọc được nữa, trong đoạn mtext của mình có cả số lẫn chữ mình miốn tách chữ ra riêng số riêng. Bác nào biết xin giúp mình với

Lý do mà bạn explode ra nhưng chữ không đọc được nữa là do bạn sử dụng 2 Font chữ trong cùng 1 Mtext mà Text lại là 1 font chữ duy nhất

Mtext thì bạn viết toàn bằng font .Vnarial

riêng chữ (trong từ Nguyễn, chữ ườ (trong từ Hường) lại viết bằng Font Arial

Bạn xem lại nhé

  • Vote tăng 1

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
Lý do mà bạn explode ra nhưng chữ không đọc được nữa là do bạn sử dụng 2 Font chữ trong cùng 1 Mtext mà Text lại là 1 font chữ duy nhất

Mtext thì bạn viết toàn bằng font .Vnarial

riêng chữ (trong từ Nguyễn, chữ ườ (trong từ Hường) lại viết bằng Font Arial

Bạn xem lại nhé

Hề hề hề,

Bác Tue_nv ơi,

Như bạn ấy đã nói là bạn ấy chưa rành lắm về CAD, mà cái vụ font bạn ấy dùng thực chất là cái font VNARIAL.TIF bác ạ. Do cái font này nó là font cải tiến từ hai cái font bác nói để có thể gõ được tiếng Việt. Bây giò bảo bạn ấy sửa lại font chắc không nổi rồi. Bác có thể mách nước có cách dùng font nào cho Mtext để viết tiếng Việt mà khi explode nó không bị mất cái tiếng Việt ấy đi không ạ. Mình cũng đang bí rị cái chỗ này, chửa biết làm sao. Thử sửa cái text của bạn ấy thành font arial tất thì nó lại chả ra tiếng việt nữa. Thế mới khổ chứ bác ạ.

Mong bác chỉ dẫn giùm.

Cám ơn bác trước.

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
Hề hề hề,

Bác Tue_nv ơi,

Như bạn ấy đã nói là bạn ấy chưa rành lắm về CAD, mà cái vụ font bạn ấy dùng thực chất là cái font VNARIAL.TIF bác ạ. Do cái font này nó là font cải tiến từ hai cái font bác nói để có thể gõ được tiếng Việt. Bây giò bảo bạn ấy sửa lại font chắc không nổi rồi. Bác có thể mách nước có cách dùng font nào cho Mtext để viết tiếng Việt mà khi explode nó không bị mất cái tiếng Việt ấy đi không ạ. Mình cũng đang bí rị cái chỗ này, chửa biết làm sao. Thử sửa cái text của bạn ấy thành font arial tất thì nó lại chả ra tiếng việt nữa. Thế mới khổ chứ bác ạ.

Mong bác chỉ dẫn giùm.

Cám ơn bác trước.

Chỉ có 1 cách là sửa thủ công nó về 1 font duy nhất thôi bác ạ.

Chuyển về Arial hay .Vnarial đều được

Và bác chú ý phải sửa cả Style của nó sang đúng kiểu font mà bác sẽ gõ

 

Chúc bác vui.

  • Vote tăng 1

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

Xin chào cả nhà

Em nhờ các bác viết giúp em lisp vẽ đường bao xung viền một chi tiết nhé (đường màu vàng minh họa)

Đường này là một đối tượng kín hoặc block để có thể lực chọn copy dễ dàng.

Em cám ơn nhiều

 

untitled_31.jpg

http://www.cadviet.com/upfiles/3/file.dwg

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
Xin chào cả nhà

Em nhờ các bác viết giúp em lisp vẽ đường bao xung viền một chi tiết nhé (đường màu vàng minh họa)

Đường này là một đối tượng kín hoặc block để có thể lực chọn copy dễ dàng.

Em cám ơn nhiều

Nếu với bài toán trên của bạn với điều kiện là các điểm mút của các đoạn màu blue ( tạo nên đường bao màu vàng) chạm nhau tạo thành Đường kín thì việc giải bài toán sẽ đơn giản hơn(chấp nhận luôn nếu đối tượng là Block nếu nó thỏa mãn điều kiện mà Tue_NV nêu ra.

Nhưng ở đây các điểm mút của bạn không tạo thành PLINE kín sẽ trở nên rất khó xác định đấy. :iluvyousmiley:

  • Vote tăng 1

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
Nếu với bài toán trên của bạn với điều kiện là các điểm mút của các đoạn màu blue ( tạo nên đường bao màu vàng) chạm nhau tạo thành Đường kín thì việc giải bài toán sẽ đơn giản hơn(chấp nhận luôn nếu đối tượng là Block nếu nó thỏa mãn điều kiện mà Tue_NV nêu ra.

Nhưng ở đây các điểm mút của bạn không tạo thành PLINE kín sẽ trở nên rất khó xác định đấy. :iluvyousmiley:

Cảm ơn anh Tue_nv

File trên là mẫu ví vụ, thường thường thì điểm nút là viền kín, còn nếu không cứ chỗ nào kín thì đường bao bám theo, đường thẳng thò ra (ví dụ đường tâm .. sẽ được bỏ qua ).

đối tựng tạo ra là block cũng được (mầu mặc định cũng ko sao không nhất thiết phải là mầu vàng) miễn là có thế lựa chọn riêng để tách khỏi hình blue ban đầu

em chưa biết về lisp. nếu có thể giải quyết bài toán theo cách này ko anh:

1.tạo đường bao của các vùng kín

2.Cộng các đường bao vừa được tạo (nếu đường bao giao nhau) để thành đường bao có diện tích lớn nhât >>> kết quả của bài toán nhưng chắc chương trình sẽ nặng

3.nếu đường bao ko giao nhau thì để nguyên (áp dụng cho lựa chọn nhiều đối tượng cùng lúc)

Cảm ơn anh đã giúp đỡ

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
Xin chào cả nhà

Em nhờ các bác viết giúp em lisp vẽ đường bao xung viền một chi tiết nhé (đường màu vàng minh họa)

Đường này là một đối tượng kín hoặc block để có thể lực chọn copy dễ dàng.

Em cám ơn nhiều

 

untitled_31.jpg

http://www.cadviet.com/upfiles/3/file.dwg

Bạn dùng thử cái này xem có đúng ý bạn không nhé. Chú ý hình của bạn phải như bác Tue_VN đã nói ở trên.

(defun c:bao ()
 (vl-load-com)
 (setq ss (ssget))
 (if (= (tblsearch "block" "b_temp") nil)
   (command "block" "b_temp" "0,0" ss "")
   (command "block" "b_temp" "y" "0,0" ss "")
   )
 (command "-insert" "b_temp" "0,0" "" "" "")
 (setq rec (acet-ent-geomextents (setq el (entlast))))
 (setq p1 (car rec))
 (setq p2 (cadr rec))
 (setq p1 (polar p1 (+ (/ pi 4) pi) 50))
 (setq p2 (polar p2 (/ pi 4) 50))
 (setq p (polar p1 (/ pi 4) 25))
 (command "rectang" p1 p2)
 (setq el1 (entlast))
 (command "boundary" p ""
   (if (/= (getvar "cmdactive") 0)
     (alert "khong tao duoc duong bao ban hay kiem tra lai hinh ve")
     )
   )
 (command "erase" el1 "")
 (setq ss (ssget "w" p1 p2 (list (cons 0 "LWPOLYLINE"))))
 (setq ss (acet-ss-to-list ss))
 (setq lar (list))
 (foreach n ss
   (setq dt (dientich n))
   (setq lar (append (list (list dt n)) lar))
   )
 (setq lar (vl-sort lar '(lambda (x y)
			 (> (car x) (car y))
		       )
	     )
)
 (setq rm (cadr (caddr lar)))
 (Setq ss (vl-remove rm ss))
 (setq ss (acet-list-to-ss ss))
 (command "erase" ss "")
 (acet-explode el)
 )
(defun dientich (name / are ob ll)
 (command "region" name "")
 (setq ob (vlax-ename->vla-object (setq ll (entlast))))
 (setq are (vla-get-area ob))
 (command "undo" 1)
 are
 )

  • Vote tăng 2

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
Cảm ơn anh Tue_nv

File trên là mẫu ví vụ, thường thường thì điểm nút là viền kín, còn nếu không cứ chỗ nào kín thì đường bao bám theo, đường thẳng thò ra (ví dụ đường tâm .. sẽ được bỏ qua ).

đối tựng tạo ra là block cũng được (mầu mặc định cũng ko sao không nhất thiết phải là mầu vàng) miễn là có thế lựa chọn riêng để tách khỏi hình blue ban đầu

em chưa biết về lisp. nếu có thể giải quyết bài toán theo cách này ko anh:

1.tạo đường bao của các vùng kín

2.Cộng các đường bao vừa được tạo (nếu đường bao giao nhau) để thành đường bao có diện tích lớn nhât >>> kết quả của bài toán nhưng chắc chương trình sẽ nặng

3.nếu đường bao ko giao nhau thì để nguyên (áp dụng cho lựa chọn nhiều đối tượng cùng lúc)

Cảm ơn anh đã giúp đỡ

Chào bạn nguoithomo cùng bạn phamngoctu

Đọc qua code của bạn Tue_NVthấy ý tưởng của bạn giống ý của Tue_NV đấy

Tức là ý như thế này :

1. Giả sử có 1 hình A cần vẽ đường bao

2. Ta vẽ thêm 1 đa giác kín sao cho đa giác kín này nằm ngoài hình A cần vẽ này.

3. Sử dụng lệnh Bo để tạo 1 đa giác kín với điểm pick nằm giữa miền tạo bởi đa giác kín với hình A

=> Như vậy đường bao ngoài hình A sẽ được xác định qua lệnh Boundary này

4. Xoá cái đa giác kín đi.

 

Cái đa giác kín mà bạn Tú xác định là hình chữ nhật nằm ngoài cái hình cần xác định đường bao

Với cách xác định đa giác kín là hình chữ nhật thì trong 1 số trường hợp là không ổn vì điểm pick p rất có thể không nằm giữa miền tạo bởi hình chữ nhật và hình cần xác định đường bao mà có thể nằm giữa "miền" khác

  • Vote tăng 1

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×