Đế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

#2681 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 23 November 2010 - 06:02 PM

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 x))))
(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 (<= i n)
(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 (<= i n)
(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é.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2682 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 November 2010 - 10:11 AM

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ề...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2683 lacvanhoa

lacvanhoa

    biết vẽ line

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

Đã gửi 24 November 2010 - 11:09 AM

Nhờ các bác trên diễn đàn xem giúp vấn đề này với ạ http://www.cadviet.c...s/3/mtext_5.dwg
  • 0

#2684 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 November 2010 - 12:03 PM

Nhờ các bác trên diễn đàn xem giúp vấn đề này với ạ http://www.cadviet.c...s/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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2685 phongthien

phongthien

    biết vẽ line

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

Đã gửi 24 November 2010 - 12:43 PM

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.c...es/3/dc63_1.dwg.
  • 0

#2686 phongthien

phongthien

    biết vẽ line

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

Đã gửi 24 November 2010 - 12:58 PM

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.c...es/3/captun.rar.
  • 0

#2687 lacvanhoa

lacvanhoa

    biết vẽ line

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

Đã gửi 24 November 2010 - 02:22 PM

Em có post lên thêm 1 số mtext nữa đó a xem giúp em nhe a bình http://www.cadviet.c...iles/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) )
  • 0

#2688 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 November 2010 - 02:33 PM

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.c...es/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 ) (< (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)
)

;;;;;;(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....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2689 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 November 2010 - 04:11 PM

Em có post lên thêm 1 số mtext nữa đó a xem giúp em nhe a bình http://www.cadviet.c...iles/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 .
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2690 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 November 2010 - 04:41 PM

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.c...es/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é.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2691 phongthien

phongthien

    biết vẽ line

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

Đã gửi 24 November 2010 - 09:45 PM

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

#2692 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 25 November 2010 - 07:47 AM

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

#2693 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 November 2010 - 08:02 AM

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.c...es/3/file_1.dwg
Cám Ơn các Bác nhiều !

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

#2694 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 25 November 2010 - 10:56 AM

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.c...?showtopic=9843
  • 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!

#2695 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 November 2010 - 11:27 AM

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.c...?showtopic=9843

Còn phần nối text nữa anh phamngoctukts giúp em với .
  • 0

#2696 nguoi_tho_mo

nguoi_tho_mo

    biết vẽ arc

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

Đã gửi 25 November 2010 - 11:50 AM

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

#2697 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 25 November 2010 - 12:22 PM

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).
  • 0

#2698 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 25 November 2010 - 01:07 PM

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

#2699 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

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

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

#2700 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 25 November 2010 - 02:10 PM

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

  • 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!