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ị

phongthien    0

phongthien là gió trời đó anh Bình à

không phải phong thiến mà cũng không phải phong thiện đâu

có cách nào giải quyết giúp em với bạn hoa với anh

em với bạn lacvanhoa làm chung bản đồ nè. Chuyển BĐQuy hoạch sang bản đồ địa chính.

huhu

nếu ngồi đánh lại tên chắc chết quá anh

kíu em 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

Em không biết gì về lisp. Mong các bác đừng cười chê. Em có file này muốn nhờ các bác trên diễn đàn giúp đỡ em với. Em được bạn cho 1 file lisp tính diện tích nhưng mỗi lần chọn vùng cần tính lại phải nhập chiều cao chữ. Nhờ các bác bổ sung giúp để nó mặc định được chiều cao là 0.1, 0.5 hoặc 1 cũng được. Nội dung thế này ạ:

 

(defun c:dtm()

(defun ctext (diem gt / lst)

(setq lst

(list

(cons 0 "TEXT")

(cons 1 gt)

(cons 10 diem)

(cons 40 (getdist p "\nChieu cao chu: "))

)

)

(entmake lst)

)

(defun dtdoituong (entdt /)

(command ".area" "o" entdt)

(command ".erase" entdt "")

(getvar "area")

)

(defun getbound(p)

(setq ent (entlast))

(command ".boundary" "A" "B" "E" "I" "Y" "" p "")

(setq ent1 (entlast))

(cond

((eq ent ent1) nil)

(t ent1)

)

)

(princ "\ncadviet.com")

(setq

p (getpoint "\nVao diem can tinh dien tich: ")

entpl (getbound p)

)

(if entpl

(ctext p (rtos (dtdoituong entpl)))

(alert "Diem ban chon khong kin!")

)

(princ)

)

 

(princ "\ndtm - cadviet.com")

(princ)

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
phamngoctukts    708
Em không biết gì về lisp. Mong các bác đừng cười chê. Em có file này muốn nhờ các bác trên diễn đàn giúp đỡ em với. Em được bạn cho 1 file lisp tính diện tích nhưng mỗi lần chọn vùng cần tính lại phải nhập chiều cao chữ. Nhờ các bác bổ sung giúp để nó mặc định được chiều cao là 0.1, 0.5 hoặc 1 cũng được. Nội dung thế này ạ:

 

(defun c:dtm()

(defun ctext (diem gt / lst)

(setq lst

(list

(cons 0 "TEXT")

(cons 1 gt)

(cons 10 diem)

(cons 40 (getdist p "\nChieu cao chu: "))

)

)

(entmake lst)

)

(defun dtdoituong (entdt /)

(command ".area" "o" entdt)

(command ".erase" entdt "")

(getvar "area")

)

(defun getbound(p)

(setq ent (entlast))

(command ".boundary" "A" "B" "E" "I" "Y" "" p "")

(setq ent1 (entlast))

(cond

((eq ent ent1) nil)

(t ent1)

)

)

(princ "\ncadviet.com")

(setq

p (getpoint "\nVao diem can tinh dien tich: ")

entpl (getbound p)

)

(if entpl

(ctext p (rtos (dtdoituong entpl)))

(alert "Diem ban chon khong kin!")

)

(princ)

)

 

(princ "\ndtm - cadviet.com")

(princ)

Bạn thay dòng này (cons 40 (getdist p "\nChieu cao chu: ")) -> (cons 40 0.5) để có cao chữ là 0.5 hoặc bạn có thể thay số bất kì.

  • 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
lacvanhoa    0

Mong được các bác cao thủ trên diễn đàn xem giúp em. file em toàn là mtext nhưng lại explode thì không còn đọc được chũ gì nữa. Kết quả em muốn sau cùng là text 3 đối tượng của text thuộc 3 lớp khác nhau, 3 lớp đó tên gì màu gì cũng được hết.dùng lisp hay chương trình úng dụng nào các bác biết chỉ giáo dùm mà có thể xuất text đó qua excel nằm trong 3 cột khác nhau.

em thì chưa rành về cad nhiều, hỏi bạn bè đồng nghiệp cũng pó tay, các bác biết chỉ giúp em 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
lacvanhoa    0

Mong được các bác cao thủ trên diễn đàn xem giúp em. file em toàn là mtext nhưng lại explode thì không còn đọc được chũ gì nữa. Kết quả em muốn sau cùng là text 3 đối tượng của text thuộc 3 lớp khác nhau, 3 lớp đó tên gì màu gì cũng được hết.dùng lisp hay chương trình úng dụng nào các bác biết chỉ giáo dùm mà có thể xuất text đó qua excel nằm trong 3 cột khác nhau.

em thì chưa rành về cad nhiều, hỏi bạn bè đồng nghiệp cũng pó tay, các bác biết chỉ giúp em với.

EM QUÊN UPLOAD FILE NỮA, FILE CỦA EM NÈ http://www.cadviet.com/upfiles/3/2311_1.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
phamthanhbinh    3.123
phongthien là gió trời đó anh Bình à

không phải phong thiến mà cũng không phải phong thiện đâu

có cách nào giải quyết giúp em với bạn hoa với anh

em với bạn lacvanhoa làm chung bản đồ nè. Chuyển BĐQuy hoạch sang bản đồ địa chính.

huhu

nếu ngồi đánh lại tên chắc chết quá anh

kíu em với!!!!!!

Hề hề hề,

Ây da, khổ quá, lần mò mãi mới nghĩ ra được cái củ chuối này. Các bạn xài thử và cho ý kiến để mình hoàn thiện nó nhé.

Vấn đề khó khăn nhất ở đây là cái font tiếng Việt của các bạn. Trong Mtext thì nó cho ghi cả các mã font, nhưng sang Text thì nó chả hiểu cái mã font là chi. Vì thế khi nổ thành text thì nó chỉ còn là các ký tự. Mình chịu chết không mò ra được cái quy luật để chuyển các ký tự trong mã text tiếng Việt. Cũng may là trên bản vẽ của bạn lacvanhoa gửi có text tiếng việt cùng một style với mtext. Vì thế mình làm kiểu củ chuối là lấy các mã text trong text nhập vào mã text trong mtext bị nổ ra thế là được. Tuy nhiên vì bạn lacvanhoa chỉ gửi có mỗi cái text đã chuyễn là nguyễn kim hường nên mình chỉ biết có hai mã là mã của chữ ễ và chữ ườ, còn các mã khác thì tịt ngóm nên cái lisp này mới chỉ thành công với các trường hợp text có chứa chữ ễ và chữ ườ thôi. Các trường hợp khác thì các bạn gửi mình các text khác mình mới làm tiếp được. Cái kiểu này quả là rất củ chuối vì trong tiếng việt có bao nhiêu là trường hợp bỏ dấu, và như vậy thì phải có đủ các mã ấy mới ăn thua. Tuy nhiên bí quá thì phải cố rặn ra vậy nên mình mới nghĩ được đến đây. Có ai khác có cách hay hơn thì tốt quá. Mình cứ gửi lên để các bạn tham khảo và xài tạm cho đỡ sốt ruột vậy. Hề hề hề.....

(defun c:mt2t ()
(setq sst (acet-ss-to-list (ssget (list (cons 0 "mtext") (cons 1 "* - * - *")))))
(setq oldcol (getvar "clayer"))
(foreach et sst
     (setq elt (entget et)
             txt (cdr (assoc 1 elt))
             p1 (cdr (assoc 10 elt))
             h (cdr (assoc 40 elt))
             p2 (polar p1 0 8)
             p3 (polar p1 0 70)
     )
     (tach txt)
     (command "erase" et "")
     (setvar "clayer" "sothua")
     (entmake (list (cons 0 "mtext") (cons 100 "AcDbEntity") (cons 8 "sothua")
                          (cons 100 "AcDbMText") (cons 1 t1) (cons 10 p1) (cons 40 h)
                          (cons 7 "moi") (cons 50 0)
                   )
     )
     (command "explode" (entlast) "")
     (setvar "clayer" "tenCSD") 
     (entmake (list (cons 0 "mtext") (cons 100 "AcDbEntity") (cons 8 "tenCSD")
                          (cons 100 "AcDbMText") (cons 1 t2) (cons 10 p2) (cons 40 h)
                          (cons 7 "moi") (cons 50 0)
                   )
     )
     (setq plst (acet-ent-geomextents (entlast)))
     (command "explode" (entlast) "")
     (setq tlst (acet-ss-to-list (ssget "c" (car plst) (cadr plst) (list (cons 0 "text")))))
     (setq tlst (vl-sort tlst '(lambda (x y) (                                                            (car (cdr (assoc 10 (entget y))))
                                                        )
                                    )
                   )
     )
     (setq text "")
     (foreach tex tlst
            (setq els (entget tex)
                    te (cdr (assoc 1 els))
            )
            (if (= te "\\U+1EC5") 
               ;;;;;;;;;(entmod (setq els (subst (cons 1 "Ô" ) (assoc 1 els) els)))
                (setq te "Ô")
            )
            (if (= te "\\U+01B0\\U+1EDD") 
               ;;;;;;;;;;(entmod (setq els (subst (cons 1 "­ê" ) (assoc 1 els) els)))
                (setq te "­ê" )
            )
            (command "erase" tex "")
            (setq text (strcat text te))
            (entmake (list (cons 0 "text") (cons 100 "AcDbEntity") (cons 8 "tenCSD")
                                 (cons 100 "AcDbText") (cons 1 text) (cons 10 p2) (cons 40 h)
                                 (cons 7 "moi") (cons 50 0)
                           )
             )

     )
     (setvar "clayer" "dientich")
     (entmake (list (cons 0 "mtext") (cons 100 "AcDbEntity") (cons 8 "dientich")
                          (cons 100 "AcDbMText") (cons 1 t3) (cons 10 p3) (cons 40 h)
                          (cons 7 "moi") (cons 50 0)
                   )
     )
     (command "explode" (entlast) "")
     (setvar "clayer" oldcol )
)
)










;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tach (txt)
(setq ;;;;;;;;;;;;;;;;;;;;;;;;;;txt (cdr (assoc 1 (entget (car (entsel)))))
       i 1
      n (strlen txt)
      k nil
) 
(while (         (setq kt (substr txt i 1))
        (if (= kt "-")
            (progn
                    (setq k i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
       t2 (substr txt (+ k 2) n)
)
(setq n (strlen t2)
       i 1
       m nil
)
(while ( (setq kt (substr t2 i 1))
        (if (= kt "-")
            (progn
                    (setq m i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if m
  (progn
  (setq t3 (substr t2 (+ m 2) n))
  (setq t2 (substr t2 1 (- m 2)))
  )
)
)
)

)

PS: Về vị trí của các text sau khi chạy lisp nó chưa thẳng hàng là do cái việc căn text của thằng Mtext ấy mà. Xử lý cho nó thẳng lại không quá khó nhưng do chưa biết các Mtext ban đầu có thống nhất kiểu căn text không nên mình chưa chỉnh sửa. Mặt khác mình cũng chưa xét tới trường hợp các Mtext nằm xiên khoai hay nằm đứng. Điều này cũng có thể giải quyết được nếu như các bạn chấp nhận xơi cái củ chuối của mình. Hề hề hề. Đây mới chỉ là cái ý tưởng giải quyết vấn đề chứ chưa phải cái kết quả cuối cùng, mong các bạn chớ giận cái củ chuối này của mình . Ý tưởng chưa hay, xong mình cũng chưa tìm ra giải pháp nào hữu hiệu hơn, Mong các bạn thông cảm.

Khi chạy thử, hãy chọn các mtext có chữ ễ và chữ ườ chạy trước để kiểm tra nhé. Mtext nằm kiểu chi nó cũng chạy ra text nằm ngang phè phè, đừng có cười 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
phamthanhbinh    3.123
Em đánh toàn bộ là font chữ TCVN3 đó anh bình ơi!

em thấy trên diễn đàn có lisp tách 1 text thành 3 đoạn theo ba lớp đó

nhưng em muốn vừa tách vừa chuyển từ mtext sang text luôn

vì em giao bản đồ bên microstation nên khi chuyển sang thì mtext nó bị lỗi giống như khi explode ra vậy.

huhu

anh thử lại lần nữa giúp em nhe

hoặc có cách nào qua microstation mà không bị lỗi font chữ hong anh

nếu bí quá thì có thể explode mtext ra thành text mà không bị lỗi font chữ cũng được nữa anh Bình ơi!

mong anh giúp em. Xin chân thành cám ơn

hihihi!!!!

Hề hề hề,

Đúng là có lisp tách text thành 3 lớp nhưng là của bác KS PhanThanhTu. Bác ấy dùng dvb gì đó, mình chưa đủ khả năng để hiểu nó bạn ạ. Còn mình thì chỉ mới vọc vạch được một tí lisp thôi. Thú thực là mình cũng đang bí cái vụ này vì chưa biết cách tạo các text mà lại chứa cái font tiếng Việt của bạn. Giá như không có cái tiếng Việt thì mình đã sướng rồi. Khổ thế....

Mình vẫn đang mày mò, mong bạn thông cảm, chớ có giận nghen. Từ từ chắc sẽ có cách mà, nóng quá dễ hỏng ăn lắm. Hề hề hề...

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.123
Nhờ các bác trên diễn đàn xem giúp vấn đề này với ạ http://www.cadviet.com/upfiles/3/mtext_5.dwg

Chào bạn lacvanhoa,

Bạn hãy tham khảo cái lisp mình viết cho bạn phongthien nhé. Bài viết số 2698 của topic này. Bạn chỉ cần đổi tên các lớp trong lisp đó thành tên các lớp của bạn là OK mà. Ví dụ lớp chứa line là "GIAITHICH" thay vì "thua cly".

Riêng về giá trị diện tích thì bạn phongthien yêu cầu là giá trị thực đo của thửa đất, nếu bạn muốn lấy giá trị của text sẵn có thì bạn có thể tự bổ sung dựa trên cái lisp của mình hay pót lên mình sẽ sửa giúp.

 

Bạn hãy thử cái lisp chuyển Mtext thành text của mình và cho ý kiến nhé.

Thực ra mình bắt đầu nản vì cái bản vẽ 2311_1 mà bạn post ngày hôm qua lại có định dạng mtext khác hẳn với các bản vẽ trước mà mỗi kiểu định dạng lại có cấu trúc mã khác nhau. Do vậy nếu muốn làm được điều này theo cái cách của mình sẽ rất mất công và phải am hiểu về thuật mã hóa trong các dạng font khác nhau của CAD. Điều này với mình quả là không dễ dàng chi.

Vậy nên nếu bạn đồng ý thì mình chỉ có thể giúp bạn hoàn thành cho một dạng font VNARIAL của bạn mà thôi, còn các dạng font khác nếu muốn bạn phải tự làm dựa theo cái nguyên tắc mà mình đã làm.

Với font VNARIAL, bạn hãy post tất cả các dạng Mtext mà bạn cần chuyển đổi và các text kết quả bạn cần có lên để mình lọc các ký tự mã hóa ra mới được. Bởi vì với cái font này không hiểu mình ngu chỗ nào mà mình không sao có thể gõ cho nó thành tiếng Việt được, mà bạn lại gõ rất dễ dàng như vậy. Mình đã chuyển đổi các kiểu gõ từ vni qua telex và cả viqr nữa đều bó tay.

Vậy bạn hãy giúp mình nha.

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
phongthien    0

Theo em nghĩ nếu có thể xuất dữ liệu sothua, loại đất, diện tích thực tế của thửa đất thì cũng được anh Bình ơi.

vì sản phẩm phải giao là bảng tổng hợp và bảng so sanh, bản đồ giải thửa

nếu anh có thể xuất các dữ kiệu đó sang exel theo hang và cột nhất định thì em không cần phải xài đến microstation làm gì nữa

Nhưng cái lisp anh gửi cho em thì có lúc xài được có lúc nó lỗi à anh ơi. Với bản đồ quá lớn khoảng 200 thửa thì nó không làm được chuyện đó.anh có cách nào cải thiện nó lại cho hoàn chỉnh thêm nhé.

"Được voi thì đòi tiên" hé anh bình, anh có thể xuất thêm cột diện tích em đã ghi trên bảng đồ luôn hong anh

hihi!!!nếu em có đòi hỏi quá thì anh cũng đừng giận em nhé.Nếu được vậy thì em có thể hoàn thành bản đồ trong tết và có thể hưởng một cái tết thật ngon lành hihih

file kèm:

http://www.cadviet.com/upfiles/3/dc63_1.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
phongthien    0

Với font VNARIAL, bạn hãy post tất cả các dạng Mtext mà bạn cần chuyển đổi và các text kết quả bạn cần có lên để mình lọc các ký tự mã hóa ra mới được. Bởi vì với cái font này không hiểu mình ngu chỗ nào mà mình không sao có thể gõ cho nó thành tiếng Việt được, mà bạn lại gõ rất dễ dàng như vậy. Mình đã chuyển đổi các kiểu gõ từ vni qua telex và cả viqr nữa đều bó tay.

Vậy bạn hãy giúp mình nha.

 

em có chụp vài tấm hình cách gõ font .VNARIALH nè

anh coi rồi gõ thử và tìm cách khắc phục líp mình nhe

http://www.cadviet.com/upfiles/3/captun.rar.

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
lacvanhoa    0

Em có post lên thêm 1 số mtext nữa đó a xem giúp em nhe a bình http://www.cadviet.com/upfiles/3/2411.dwg

Làm ơn thì làm ơn cho chót nhe anh bình, nhờ anh sửa lại đoạn lisp để lấy text sẵn có trên bản vẽ dùm em nge. Còn nếu được cả 2 vừa là giá trị thực đo vừa là text sẵn có thì tuyệt vời trên cả tuyện vời luôn.

;; free lisp from cadviet.com

 

 

(defun c:tkqh ( / sls ssl1 ssl2 p1 p2 p3 p4 els sst sld qhlst p sth st x y1 y2 plst ld dt oldos scd cd )

(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")))

scd (ssget "cp" plst (list (cons 0 "text") (cons 8 "tenCSD")))

)

(if (/= sld nil)

(setq ld (cdr (assoc 1 (entget (ssname sld 0)))))

(setq ld "No")

)

(if (/= scd nil)

(setq cd (cdr (assoc 1 (entget (ssname scd 0)))))

(setq cd "Nobody")

)

(command "area" "o" (entlast))

(setq dt (getvar "area")

qhlst (append qhlst (list (list sth cd 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) )

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.123
Theo em nghĩ nếu có thể xuất dữ liệu sothua, loại đất, diện tích thực tế của thửa đất thì cũng được anh Bình ơi.

vì sản phẩm phải giao là bảng tổng hợp và bảng so sanh, bản đồ giải thửa

nếu anh có thể xuất các dữ kiệu đó sang exel theo hang và cột nhất định thì em không cần phải xài đến microstation làm gì nữa

Nhưng cái lisp anh gửi cho em thì có lúc xài được có lúc nó lỗi à anh ơi. Với bản đồ quá lớn khoảng 200 thửa thì nó không làm được chuyện đó.anh có cách nào cải thiện nó lại cho hoàn chỉnh thêm nhé.

"Được voi thì đòi tiên" hé anh bình, anh có thể xuất thêm cột diện tích em đã ghi trên bảng đồ luôn hong anh

hihi!!!nếu em có đòi hỏi quá thì anh cũng đừng giận em nhé.Nếu được vậy thì em có thể hoàn thành bản đồ trong tết và có thể hưởng một cái tết thật ngon lành hihih

file kèm:

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

Chào bạn Gió trời,

1/- Mình bổ sung lại cái lisp cho bạn và sắp xếp lại trật tự các cột trong Excel theo đúng cái bảng bạn đã post.

2/- Do trong lisp sử dụng hàm boundary nên khi chạy lisp bạn lưu ý phải zoom bản vẽ vùng cần xác định sao cho tất cả các đường biên của các thửa đất cần xác định đều được nhìn thấy hết. Mình đã thử với lệnh zoom extension như bác Tuệ hướng dẫn thì có trường hợp bị lỗi do cái vùng cần bao quá nhỏ, nhất là với các bản đồ quá lớn. Do vậy mình nghĩ tốt hơn là bạn zoom về từng vùng đủ lớn để chạy lisp, vừa quan sát vừa kiểm tra được thửa nào đã được thống kê và thửa nào chưa để tránh nhầm lần hay trùng lắp các thửa, đồng thời nó cũng làm cho lisp chạy nhanh hơn đỡ mất thời gian xử lý các dữ liệu thừa.

Với các bản vẽ lớn, bạn nên chia thành các vùng nhỏ để chạy vì nếu để quá lớn lệnh boudary dễ bị lỗi như đã nói trên.

3/- Nếu bạn không cần xuất qua MicroStations nữa thì có cần thiết phải chuyển Mtext thành Text nữa không vì nếu để Mtext thì việc tách các Mtext này thành các Mtext nhỏ sẽ đơn giản hơn nhiều lần cái việc buộc nó phải thành Text bạn ạ.

4/- Bạn nên thống nhất tên các lớp trong các bản vẽ cùng loại. Điều đó sẽ giúp bạn quản lý và sữ dụng bản vẽ tốt hơn. Tỷ như cái bản vẽ dc63_1 bạn mới post lên thì lớp "tenCSD" bị đổi thành "ten csd", lớp "dientich" thành lớp "dien tich giay chung nhan". Do vậy nên nếu bạn dùng lisp của mình sẽ phải thay đổ lại các tên lớp này trong lệnh lisp bạn ạ. Nó vừa gây khó khăn cho mình khi làm lisp vừa gây khó cho bạn khi sử dụng.

Hiện tại cái lisp này chỉ chạy đúng với cái bản vẽ dc63_1 này thôi nhé. Các bản khác mình không đảm bảo do cái cách quản lý bản vẽ của bạn. Nó đã được sửa nên dùng với các bản vẽ lần trước của bạn thì bạn phải thay đổi lại tên lớp trong các lệnh lisp cho phù hợp.

Lisp ấy đây:

(defun c:tkqh ( / sls ssl1 ssl2 p1 p2 p3 p4 els sst sld qhlst p sth st x y1 y2 plst ld dt oldos scd cd sgc cn)
(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)
)

;;;;;;(command "zoom" "e")
(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")))
               scd (ssget "cp" plst (list (cons 0 "text") (cons 8 "ten CSD")))
               sgc (ssget "cp" plst (list (cons 0 "text") (cons 8 "dien tich giay chung nhan")))
       )
       (if (/= sld nil)
           (setq ld (cdr (assoc 1 (entget (ssname sld 0)))))
           (setq ld "No")
       )
        (if (/= scd nil)
           (setq cd (cdr (assoc 1 (entget (ssname scd 0)))))
           (setq cd "Nobody")
       )
       (if (/= sgc nil)
           (setq cn (cdr (assoc 1 (entget (ssname sgc 0)))))
           (setq cn "Nocertification")
       )
       (command "area" "o" (entlast))
       (setq dt (getvar "area")
               qhlst (append qhlst (list (list cd sth ld cn dt)))
       )

       (command "erase" (entlast) "" )
)
;;;;;;;;;(command "zoom" "p")
(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) ) 

 

Chúc bạn ăn Tết ngon miệ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
phamthanhbinh    3.123
Em có post lên thêm 1 số mtext nữa đó a xem giúp em nhe a bình http://www.cadviet.com/upfiles/3/2411.dwg

Làm ơn thì làm ơn cho chót nhe anh bình, nhờ anh sửa lại đoạn lisp để lấy text sẵn có trên bản vẽ dùm em nge. Còn nếu được cả 2 vừa là giá trị thực đo vừa là text sẵn có thì tuyệt vời trên cả tuyện vời luôn.

Chào bạn lacvanhoa,

Mình hiểu những khó khăn của bạn khi phải nhận cái nhiệm vụ như vầy. Song quả thực là mình thấy khó, do các bản vẽ của bạn gửi lên chả thống nhất gì cả, font chữ thì lung tung, hầm bà lằng, cách nhập cũng chà thông nhất thằng có gạch ngang thằng không. Các Mtext có thằng khi explode ra thì vỡ thành nhiều text, có thằng thì chả vỡ mà cứ ra nguyên một text thôi. Vì thế để nhận dạng Mtext nào cần sửa và Mtext nào không cần là cực kỳ khó khăn.

Việc chuyển từ Mtext thành Text có đầy đủ tiếng Việt là khá khó khăn như mình đã nói ở các bài trước, nếu chỉ chuyển thành các Mtext rời thì sẽ đơn giản hơn.

Do vậy nếu có thể sử dụng Mtext thì nên tận dụng nó bạn ạ. Ví dụ bạn không dùng Mirostation có được không???

Sau khi bạn đã ra được cái bảng như bạn đã post thì dùng cái lisp mình viết cho bạn PhongThien sẽ dễ dàng xuất vào Excel và dùng Excel quản lý có tốt hơn không??? (tất nhiên là sẽ phải chỉnh sửa chút xíu như mình đã nói trong bài trước, cái lisp mới đã có cả diện tích lấy từ text và diện tích đo thực tế từ bản vẽ)

Hiện tại nếu bạn bắt buộc phải chuyển tất cả Mtext thành Text thì việc đầu tiên cần làm là bạn phải thống nhất tất cả các Mtext về một kiểu định dạng thôi, cả về font cũng như kiểu nhập text.

Khi đó mới có thể làm tiếp được bạn ạ. Có thể lấy về cùng một định dạng như bản vẽ mtext2 mà bạn đã post. Như vậy sẽ tốt hơn vì mình không phải làm lại từ đầu.

Để làm tiếp mình cần có các mtext với các nội dung khác nhau đã được chuyển về định dạng như trên và các text tương ứng với cùng font đó.

Mong bạn thông cả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
phamthanhbinh    3.123
Với font VNARIAL, bạn hãy post tất cả các dạng Mtext mà bạn cần chuyển đổi và các text kết quả bạn cần có lên để mình lọc các ký tự mã hóa ra mới được. Bởi vì với cái font này không hiểu mình ngu chỗ nào mà mình không sao có thể gõ cho nó thành tiếng Việt được, mà bạn lại gõ rất dễ dàng như vậy. Mình đã chuyển đổi các kiểu gõ từ vni qua telex và cả viqr nữa đều bó tay.

Vậy bạn hãy giúp mình nha.

 

em có chụp vài tấm hình cách gõ font .VNARIALH nè

anh coi rồi gõ thử và tìm cách khắc phục líp mình nhe

http://www.cadviet.com/upfiles/3/captun.rar.

Hề hề hề,

Có nhẽ tại cái unikey của mình rồi, của mình chỉ là 4.0 mà của các bạn là 7.0 . Do đó mình gõ đủ mọi kiểu đều không được mặc dù đã chọn bảng mả là TCVN3 và kiểu gõ VNI như bạn chỉ dẫn. Ví dụ gõ Phạm Thanh Bình thì nó ra là: p¹hm thanh ×bnh

Vậy là th....u....a....

Các bạn chịu khó gõ lại rồi gửi cho mình 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
phongthien    0

lisp chỉ chạy được số lượng thửa giới hạn thôi. em phải ghép các file exel lại với nhau nữa

dù sao cũng cám ơn anh Bình rất nhiều. Với lisp này em có thể rút ngắn thời gian công việc hàng trăm lần đó.

hihihi. nếu có cơ hội dược thì em sẽ dẫn anh 1 chầu nhậu.hihi

à mà anh Bình ở đâu vậy anh.Không biết có gần em không nhĩ

em và bạn lacvanhoa cám ơn mấy anh đã chỉ giáo tụi em rất nhiều.Khi nào tìm ra phương pháp thì gửi lên diễn đàn cho em nhe anh

em đã làm phiền anh nhiều quá.Có lẽ em không post các Mtext lên cho anh được vì số lượng rất lớn, không đủ dung lượng diễn đàn cho phép.em mượn thêm người nhà ngồi gõ lại rùi.phải xong trong tết nên không thể đợi được nữa. Anh đừng buồn em nhe. hihihihi

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    10

Mình cần một lisp copy tăng / giãm theo điều kiện số gia nhập vào. xong ta chọn text số sẻ tăng giãm khi ta chọn điểm chèn vảo.

Mong được các anh giúp. Cám ơ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
Em Có file cad ko hiểu sao có 1 đối tượng ko xoá đc mong các pro giúp em với.Và có đối tượng text bị tách rời em muốn các anh gộp nó lại giúp em. đây là file đó.

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

Cám Ơn các Bác nhiều !

KO có ai giúp em ......

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
phamngoctukts    708
Em Có file cad ko hiểu sao có 1 đối tượng ko xoá đc mong các pro giúp em với

Cám Ơn các Bác nhiều !

Các đối tượng đó là proxy nên bạn không xoa được.

Bạn tham khảo trong bài này: http://www.cadviet.com/forum/index.php?showtopic=9843

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

Chào anh phamngoctukts

Nay em mới ở quên lên

Trước tiên em cảm ơn anh đã giúp em viết lisp này.

Em đã test với nhiều hình khác nhau, nhưng chưa thấy tạo ra đường bao xung quanh viền (như đường mầu vàng). anh cho em xin bản vẽ mà anh đã tạo đương bao để em biết đường ứng dụng nhé

Cảm ơn anh

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
hdt4151    1

Các bạn giúp mình viết 1 lisp này nhé (có thử tìm trong 4r nhưng chưa thấy), trong file cad có các đường line và polyline, break line va polyline tại giao điểm, xuất ra tọa độ của tất cả các điểm có trong hình (điểm đầu, cuối của các line, polyline sau khi break - xóa các điểm trùng nhau).

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
phamngoctukts    708
Chào anh phamngoctukts

Nay em mới ở quên lên

Trước tiên em cảm ơn anh đã giúp em viết lisp này.

Em đã test với nhiều hình khác nhau, nhưng chưa thấy tạo ra đường bao xung quanh viền (như đường mầu vàng). anh cho em xin bản vẽ mà anh đã tạo đương bao để em biết đường ứng dụng nhé

Cảm ơn anh

Test trong chính cái file mà bạn gửi lên đó. Bạn chú ý là xung quanh đối tượng mà bạn chọn không có đối tượng thừa nào. bạn thử move cái hình đó ra ngoài và dùng lisp xem.

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
phamngoctukts    708
Các bạn giúp mình viết 1 lisp này nhé (có thử tìm trong 4r nhưng chưa thấy), trong file cad có các đường line và polyline, break line va polyline tại giao điểm, xuất ra tọa độ của tất cả các điểm có trong hình (điểm đầu, cuối của các line, polyline sau khi break - xóa các điểm trùng nhau).

Hình như cái này mình viết cho bạn rồi mà. Bạn lấy cái cũ ra sào nấu một tý là được thôi 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
phamngoctukts    708
Còn phần nối text nữa anh phamngoctukts giúp em với .

Của bạn đây. Chúc bạn làm việc hiệu quả.

(defun c:ntext ()
 (setq ss (ssget "x" '((0 . "TEXT"))))
 (setq i 0)
 (setq lst (acet-ss-to-list ss))
 (while (< i (length lst))
   (setq name (nth i lst))
   (setq ent (entget name))
   (setq p1 (cdr (assoc 11 ent)))
   (setq nd1 (cdr (assoc 1 ent)))
   (foreach n lst
     (setq p2 (cdr (assoc 10 (entget n))))
     (setq nd2 (cdr (assoc 1 (entget n))))
     (if (equal p1 p2 0.01)
(progn
  (entmod (subst (cons 1 (strcat nd1 nd2)) (assoc 1 ent) ent))
  (entdel n)
  )
)
     )
   (setq i (1+ 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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×