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

#1881 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 21 September 2010 - 01:29 PM

Em là người rất mê vẽ Cad và luôn muốn làm bản vẽ thật phong phú và đẹp mắt.e xem các bản vẽ dưới dạng file ảnh của mọi người thật đẹp nhưng cũng không biết làm sao để làm đựơc như thế.Cách xuất bản vẽ sang file ảnh thì e biết nhưng cách tô màu cho các chi tiết thì e không rõ lắm.e up lên một bản như thế các bác xem hộ.mong được sự giúp đỡ của các bác! http://www.cadviet.c...3/ho_boi1nt.jpg

Cái này là xuất thành ảnh xong đổ màu bằng photoshop bạn ạ.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1882 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 21 September 2010 - 03:05 PM

-Nhờ mọi người ngâm cứu lisp này giúp mình với , do khi chạy nova ( phần mềm thiết đường ) cao độ mia ở mặt cắt ngang chạy ra nó nhiều quá dẫn đến không nhìn được , mời mọi người xem hình ảnh ( mình cũng up luôn cả bản cad lên để mọi người tiện ngâm cứu).
-Hình ảnh đây Hình đã gửi
-Vấn đề của mình đặt ra là làm sao biến hình A thành hình B một cách nhanh nhất(xóa bớt cọc mia thừa và ghi lại khoảng cách mia).
-Mình xin đưa đa cấu trúc lisp như sau:
+ Tên lệnh HCM (hiệu chỉnh mia)
+ Chọn điểm đầu (ta chọnđiểm 1 trong hình A)
+ Chọn điểm cuối (ta chọnđiểm 2 trong hình A)
+ Chọn text ghi khoảng cách ( ta chọn vào text 1.10 (màu đỏ ở hình A)> nó cho kết quả là 1.99 (màu đỏ ở hình :(
+ Sau khi điền kết quả xong nó tự xóa luôn các cọc và các text(cọc màu ghi , text ở giữa 2 đi màu vàng ) ở giữa 2 điểm 1 và 2 mà ta chọn ban đầu
-Mong anh em xem giúp , có gì mình viết trên đây mà mọi người chưa rõ ý của mình thì mình sẽ nói rõ thêm . Chân thành cám ơn
-Đây là bản cad http://www.cadviet.c...3/cadviet_1.dwg

Chào bạn Ba5chngoctung,
Bạn xài thử cái này xem đã đúng ý chưa nhé.
Có vài điều lưu ý bạn khi dùng lisp này là:
1/- Việc chọn điể đầu và điểm cuối của bạn phải được thực hiện đúng trên đường chuẩn như bạn đã đánh dấu.
2/- Việc chọn text cần thay thế bạn phải chọn các text nằm dọc theo các cọc màu ghi của bạn chứ không chọn các text nằm ngang vuông góc với cọc bạn nhé.
3/- Lisp này chỉ chạy đúng với cấu trúc hình vẽ như cái file bạn đã upload. Cụ thể là các khoảng cách giữa các đường line ngang màu xanh của bạn phải là 2 và chiều cao các text cũng đúng y boong như vậy bạn nhé.
4/- Nếu bạn thay đổi cái cấu trúc hình này thì lisp sẽ chạy ra cái kết quả không như ý muốn. Sở dĩ vậy là do mình bố trí text căn cứ vào chiều cao hiện tại của nó và cái khoảng hở của các đường line màu xanh bạn ạ. Nếu cần thiết bạn có thể tự thay đổi các kích thước này trong lisp cho phù hợp.

Lisp đây:

(defun c:HCM ( / p1 p2 p3 p4 p5 p6 p7 p8 p11 ss1 ss2 ss3 en els pt txt)
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint "\n Chon diem cuoi")
p3 (list (car p1) (- (cadr p1) 8) (caddr p1))
p4 (list (- (car p2) 0.01) (- (cadr p2) 7.99) (caddr p2))
p5 (list (car p1) (- (cadr p1) 4) (caddr p1))
p6 (list (- (car p2) 0.01) (- (cadr p2) ) (caddr p2))
p7 (list (+ (car p1) 0.01) (- (cadr p1) 6.01) (caddr p1))
p8 (list (car p2) (- (cadr p2) 6) (caddr p2))
p11 (list (+ (car p1) 0.01) (cadr p1) (caddr p1))
ss1 (ssget "c" p11 p6 (list (cons 8 "LINEDONGTN")))
ss2 (ssget "w" p5 p8 (list (cons 0 "TEXT")))
ss3 (ssget "c" p7 p4 (list (cons 0 "TEXT,LINE")))
en (car (entsel "\n Chon text can thay the"))
els (entget en)
pt (cdr (assoc 11 els))
pt (list (+ (car pt) 0.8) (- (cadr pt) 0.8) (caddr pt))
txt (rtos (- (car p2) (car p1)) 2 2)
ss3 (ssdel en ss3)
)
(command "erase" ss1 ss2 ss3 "")
(setq els (subst (cons 1 txt) (assoc 1 els) els)
els ( subst (cons 50 0) (assoc 50 els) els)
els (subst (cons 11 pt) (assoc 11 els) els)
)
(entmod els)
(entupd en)
(command "undo" "e")
(princ)
)


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

#1883 tuananhlt02

tuananhlt02

    Chưa sử dụng CAD

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

Đã gửi 21 September 2010 - 03:06 PM

Các anh Hoành, anh Tuệ, anh ssg.... hay anh nào rảnh làm ơn viết hộ em cái lisp này nha. Trước ở cơ quan cũ của em có ông dùng cái lisp này, ông ấy vẽ trước hết tim ( trục ) rồi đánh lệnh 1 cái là nó tự động offset ra thành nét tường rồi tự trim, fillet hết như thế này. Các thông số cần chọn là: đường tim, chọn loại tường ( 220, 110, 330)
Hình đã gửi
Có cái lisp này thì anh em kiến trúc vẽ mặt bằng rất nhanh.
EM xin cám ơn các anh nhiều.
  • 0

#1884 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 21 September 2010 - 03:19 PM

các bác có bít tại sao lệnh fi bị lỗi ko.có cách nào khắc phụ nó ko.mong các bác giúp đỡ em.day la file do
http://www.cadviet.c...thp21092010.dwg

Lệnh fi không bị lỗi mà lỗi có nhẽ do cái thằng CAD của bạn nó phá bĩnh thôi. File bạn gửi mình mở ra filtẻ ngon lành mà. Hề hề hề.....
Có nhẽ bạn nên mời chuyên gia phần mềm từ Autodesk sang may ra mới trị được, hề hề hề, nhưng mà hơi tốn xìn à nha. Còn như không thế thì bạn thử Ghost lại máy coi sao. 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.

#1885 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 21 September 2010 - 04:29 PM

Cảm ơn 2 bạn rất nhiều,mình đã vỡ ra nhiều rồi^^.Mình sẽ tiếp tục dự định ban đầu :(
Cho mình hỏi là nếu hỏi đi hỏi lại thế này thì có làm loãng topic không?Vì ở đây còn rất nhiều request chưa được đáp ứng.Mình định lập 2pic cho những người mới bắt đầu về LSP hỏi những câu ngô nghê như vừa rồi,có lẽ tiện hơn ^^

Chết tôi rồi,
Xin lỗi bạn ketxu nhé. Mình chỉ bạn sai rồi. Hàm command trong lisp luôn trả về giá trị là nil. Vậy nên nếu bạn làm như mình chỉ:
(setq hat (command "hatch" ..... )) thì biến hat luôn là nil bạn ạ. Tương tự với dòng code (setq dim1 (command "dimension" ......)).
Vì thế bạn không xài như cách mình chỉ dược mà là phải dùng như bác Phamngoctukts nói mới đúng. Tức là ngay sau mỗi lệnh (command " hatch".......) bạn dùng hàm ( setq ........) tỷ như: (setq hat (entlast)) bạn nhé.
Một lần nữa xin lỗi bạn vì đã chỉ bậy. Hề hề hề, chung quy chỉ tại cái tội nghĩ ẩu, mong bạn tha lỗi......
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1886 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 21 September 2010 - 04:38 PM

Các anh Hoành, anh Tuệ, anh ssg.... hay anh nào rảnh làm ơn viết hộ em cái lisp này nha. Trước ở cơ quan cũ của em có ông dùng cái lisp này, ông ấy vẽ trước hết tim ( trục ) rồi đánh lệnh 1 cái là nó tự động offset ra thành nét tường rồi tự trim, fillet hết như thế này. Các thông số cần chọn là: đường tim, chọn loại tường ( 220, 110, 330)
Hình đã gửi
Có cái lisp này thì anh em kiến trúc vẽ mặt bằng rất nhanh.
EM xin cám ơn các anh nhiều.


Cái này dùng ACA là tốt nhất
Nhưng để vẽ MB nhanh thì cũng chẳng để làm gì.
Hãy tập vẽ 3D, sau đó xuất về 2D (MB, MĐ, MC,..)
Đó mới là cách hay!
  • 1

#1887 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 21 September 2010 - 04:55 PM

Các anh Hoành, anh Tuệ, anh ssg.... hay anh nào rảnh làm ơn viết hộ em cái lisp này nha. Trước ở cơ quan cũ của em có ông dùng cái lisp này, ông ấy vẽ trước hết tim ( trục ) rồi đánh lệnh 1 cái là nó tự động offset ra thành nét tường rồi tự trim, fillet hết như thế này. Các thông số cần chọn là: đường tim, chọn loại tường ( 220, 110, 330)
Hình đã gửi
Có cái lisp này thì anh em kiến trúc vẽ mặt bằng rất nhanh.
EM xin cám ơn các anh nhiều.

Với code này bạn đã ofset được tuờng sang hai bên còn trim với filet có lẽ phải nhờ các cao thủ khác.

(defun c:vetuong ()
(setq old_layer (getvar "clayer"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setvar "clayer" "tuong")
(setq ss (ssget '((0 . "line"))))
(setq i 0)
(setq day (getint "\nnhap chieu day tuong:"))
(while (< i (sslength ss))
(setq ent (entget (ssname ss i))
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l" "")
(setq i (1+ i))
)
(setvar "clayer" 0ld_layer)
)

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

#1888 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

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

Đã gửi 21 September 2010 - 04:58 PM

Lệnh fi không bị lỗi mà lỗi có nhẽ do cái thằng CAD của bạn nó phá bĩnh thôi. File bạn gửi mình mở ra filtẻ ngon lành mà. Hề hề hề.....
Có nhẽ bạn nên mời chuyên gia phần mềm từ Autodesk sang may ra mới trị được, hề hề hề, nhưng mà hơi tốn xìn à nha. Còn như không thế thì bạn thử Ghost lại máy coi sao. Hề hề hề.....

Ở bản vẽ khác thì em dùng đc lệnh fi.nhưng ở bản vẽ em gủi lên thì ko làm đc.Em nghĩ rằng bản vẽ đó có lỗi gì chăng.mong bác giúp em.Em cám ơn các bác nhiều
  • 0

#1889 18011985

18011985

    biết lệnh properties

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

Đã gửi 21 September 2010 - 06:31 PM

Ở bản vẽ khác thì em dùng đc lệnh fi.nhưng ở bản vẽ em gủi lên thì ko làm đc.Em nghĩ rằng bản vẽ đó có lỗi gì chăng.mong bác giúp em.Em cám ơn các bác nhiều

Bạn có chỉnh sửa lệnh không chứ Fillet và Filter đều sử dụng được mà mình vẫn dùng được cả 2 lệnh đó trên bản vẽ của bạn.
  • 2
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

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

#1890 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 September 2010 - 11:12 PM

Chết tôi rồi,
Xin lỗi bạn ketxu nhé. Mình chỉ bạn sai rồi. Hàm command trong lisp luôn trả về giá trị là nil. Vậy nên nếu bạn làm như mình chỉ:
(setq hat (command "hatch" ..... )) thì biến hat luôn là nil bạn ạ. Tương tự với dòng code (setq dim1 (command "dimension" ......)).
Vì thế bạn không xài như cách mình chỉ dược mà là phải dùng như bác Phamngoctukts nói mới đúng. Tức là ngay sau mỗi lệnh (command " hatch".......) bạn dùng hàm ( setq ........) tỷ như: (setq hat (entlast)) bạn nhé.
Một lần nữa xin lỗi bạn vì đã chỉ bậy. Hề hề hề, chung quy chỉ tại cái tội nghĩ ẩu, mong bạn tha lỗi......

Mình cũng thử cách của bạn ngay lúc đầu,thấy nó báo NIL cũng ngờ ngợ,đang định hỏi lại thì bạn đã cho mình biết đáp án rồi.Lại có thêm 1 điều lưu ý mình chưa biết.Tks bạn nhiều ^^ Hì hì..Đúng là vạn sự khởi đầu nan
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#1891 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 22 September 2010 - 06:48 AM

Nhờ các bạn viết giúp tôi lisp với nội dung:
- link giá trị text (TextOverride) của dim, khi thay đổi giá trị text của dim đích thì text dim nguồn cũng thay đổi (giống như lisp LinkT)
Xin cảm ơn

Hình đã gửi

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

Dựa vào code của anh gia_bach, Tue_NV chỉnh lại 1 chút cho phù hợp với yêu cầu của bạn vtd_xd.
Banj vtd_xd thử nhé :

(defun c:LinkD (/ ss objlst obj_reactor); Link DIMENSION
(if (setq ss (ssget '((0 . "DIMENSION"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(setq obj_reactor (vlr-object-reactor objlst nil '((:vlr-modified . callback))))
)
)
)
(defun callback (notifier-object obj_reactor parameter-list / objlist newT)
(setq objlist (vlr-owners obj_reactor))
(setq newT (vla-get-TextOverride notifier-object))
(foreach obj objlist
(if (/= (vla-get-TextOverride obj) newT)
(vla-put-TextOverride obj newT)
)
)
)

  • 1

#1892 vtd_xd

vtd_xd

    biết vẽ circle

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

Đã gửi 22 September 2010 - 08:31 AM

Dựa vào code của anh gia_bach, Tue_NV chỉnh lại 1 chút cho phù hợp với yêu cầu của bạn vtd_xd.
Banj vtd_xd thử nhé :


(defun c:LinkD (/ ss objlst obj_reactor); Link DIMENSION
(if (setq ss (ssget '((0 . "DIMENSION"))) )
(progn
(vl-load-com)
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(setq obj_reactor (vlr-object-reactor objlst nil '((:vlr-modified . callback))))
)
)
)
(defun callback (notifier-object obj_reactor parameter-list / objlist newT)
(setq objlist (vlr-owners obj_reactor))
(setq newT (vla-get-TextOverride notifier-object))
(foreach obj objlist
(if (/= (vla-get-TextOverride obj) newT)
(vla-put-TextOverride obj newT)
)
)
)


Cám ơn bạn Tue_VN nhé
  • 0
Chuc vui ve

#1893 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 22 September 2010 - 04:43 PM

Các anh Hoành, anh Tuệ, anh ssg.... hay anh nào rảnh làm ơn viết hộ em cái lisp này nha. Trước ở cơ quan cũ của em có ông dùng cái lisp này, ông ấy vẽ trước hết tim ( trục ) rồi đánh lệnh 1 cái là nó tự động offset ra thành nét tường rồi tự trim, fillet hết như thế này. Các thông số cần chọn là: đường tim, chọn loại tường ( 220, 110, 330)
Hình đã gửi
Có cái lisp này thì anh em kiến trúc vẽ mặt bằng rất nhanh.
EM xin cám ơn các anh nhiều.

Tiếp tục phát triển ý của bạn mình đã làm được thế này rồi. Chú ý nét tim phải là layer _tim.
Hình đã gửi
Còn việc fillet các cạnh ngoài cùng mình đang chưa biết làm thế nào (chỗ vòng tròn đỏ). Bạn nào có thể chí giúp mình vấn đề này không?

(defun c:vetuong ()
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setvar "clayer" "tuong")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (getint "\nnhap chieu day tuong:"))
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
)
(command "trim" ssml "" "f" pt1 pt2 "" "")
(setq j (1+ j))
)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
)

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

#1894 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2010 - 06:03 PM

Có thể quét qua đỉnh mút các line rồi thực hiện lệnh fillet đối với 2 line có đỉnh mút cách nhau đúng 1 khoảng bằng căn bậc 2 của 2 lần bình phương bề rộng tường được k ạ ? Hoặc cách khác là quét qua tất cả các line,kiểm tra xem đầu line nào không bị trùng với đầu line khác(tọa độ x,y không lặp) thì vẽ ra 1 đoạn thẳng bằng bề rộng tường theo hướng của line,được không a?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#1895 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2010 - 06:06 PM

Á,trong code của bác chưa có đoạn kiểm tra khoảng cách giữa 2 tim trục thì phải.n có lẽ không cần thiết^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#1896 bachngoctung

bachngoctung

    biết lệnh copy

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

Đã gửi 22 September 2010 - 10:49 PM

Bachngoctung thử cái này nhé :



(defun vtt(/ oldos)
  (setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(princ "\n Chon 1 cung Arc :")
(if (null (setq ss (ssget ":S" '((0 . "ARC"))) ))
(alert "\n Khong co cung Arc nao duoc chon ")
(progn
(setq ent (ssname ss 0))
    (setq tam (cdr(assoc 10 (entget ent))))
(setq D (cdr(assoc 40 (entget ent))));bankinh
    (setq dd (vlax-curve-getstartpoint ent))
    (setq dc (vlax-curve-getendpoint ent))
    (setq p1 (polar dd (+ (/ pi 2) (angle dd tam)) 1))
    (setq p2 (polar dc (+ (/ pi 2) (angle dc tam)) 1))
    (if (setq a (inters dd p1 dc p2 nil))
      (progn
        (vl-cmdf "line" dd a "")
        (vl-cmdf "line" dc a "")
(setq c (/ (* 180 (abs (- (angle dd a) (angle dc a)))) pi))
      )
    )
))
  (setvar "osmode" oldos)
(princ)
)
;;;;;;;;
(defun C:TS (/ ro CC CAT MD CD C D N L do ph O M I H J AA RR KK TT PP ss)
(SETVAR "CMDECHO" 0)
(command "-Style" "TS DUONG CONG" "arial" "0" "1" "0" "n" "")
(command "-Layer" "n" "TS DUONG CONG" "c" "222" "TS DUONG CONG" "lw" "0.2" "TS DUONG CONG" "")
(command "-Layer" "s" "TS DUONG CONG" "" "")
(setq CC (getpoint "\nCHON TAM CUA DUONG TRON / Enter ket thuc "))
(setq CAT (getreal "\nDUONG KINH DUONG TRON: "))
(while CC
(command ".circle" CC "d" CAT) (vtt)
(if ss (progn
(setq L (strcat "{\\fSymbol|b0|i0|c2|p18;a}" "="
(itoa (setq do (fix c)) ) "%%d"
(itoa (setq ph (fix (* 60 (- c do))))) "'"
(itoa (fix (* 60 (- (* 60 (- c do)) ph)))) "''"
)
)
(setq N (rtos D 2 2))
(setq H (COS (/ (/ (* C PI) 180) 2))) ;CONG THUC TINH GIA TRI COS(A/2)
(setq O (/ (SIN (/ (/ (* C PI) 180) 2)) (COS (/ (/ (* C PI) 180) 2)))) ;CONG THUC TINH GIA TRI TAN(A/2)
(setq M (rtos (* O D) 2 2)) ;CONG THUC TINH GIA TRI T
(setq I (rtos (* D (- (/ 1 H) 1)) 2 2)) ;CONG THUC TINH GIA TRI P
(setq J (rtos (/ (* D C PI) 180) 2 2)) ;CONG THUC TINH GIA TRI K
(setq AA L) ;GIA TRI A
(setq RR (strcat "R=" N)) ;GIA TRI R
(setq KK (strcat "K=" J)) ;GIA TRI K
(setq TT (strcat "T=" M)) ;GIA TRI T
(setq PP (strcat "P=" I)) ;GIA TRI P
(setq MD (/ CAT 10))
(setq CD (list (car CC) (+ (cadr CC) (/ CAT 3.1))))
(command ".text" "m" CD MD 0.0 AA) (setq e (entlast)) ;TEXT GIA TRI A
(command ".text" "" RR) ;TEXT GIA TRI R
(command ".text" "" KK) ;TEXT GIA TRI K
(command ".text" "" TT) ;TEXT GIA TRI T
(command ".text" "" PP) ;TEXT GIA TRI P
(command "txt2mtxt" e "")
(setq CC (getpoint "\nCHON TAM CUA DUONG TRON: "))
))
) ;dong WHILE
(SETVAR "CMDECHO" 1)
(PRINC)
) ;KET THUC DEFUN

-Cám ơn Bạn Tue_nv đã quan tâm nhé, nhờ Tue chỉnh lại lisp theo như hình ảnh mình up lên đây nhé:
- Cụ thể : + Tue chỉnh lại cho mình số đo góc anpha
+ Chỉnh cho dòng text chứa số đo góc anpha có Width factor= 0.7 nhé (mục đích là muốn cho nó vừa gọn vào vòng tròn Tue à)
-Cám ơn Tue nhé
Hình đã gửi
  • 0

#1897 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 22 September 2010 - 11:22 PM

Các anh Hoành, anh Tuệ, anh ssg.... hay anh nào rảnh làm ơn viết hộ em cái lisp này nha. Trước ở cơ quan cũ của em có ông dùng cái lisp này, ông ấy vẽ trước hết tim ( trục ) rồi đánh lệnh 1 cái là nó tự động offset ra thành nét tường rồi tự trim, fillet hết như thế này. Các thông số cần chọn là: đường tim, chọn loại tường ( 220, 110, 330)
Hình đã gửi
Có cái lisp này thì anh em kiến trúc vẽ mặt bằng rất nhanh.
EM xin cám ơn các anh nhiều.

Cuối cùng thì mình cũng viết xong lisp này cho bạn rồi này. Chúc bạn vui và làm việc hiệu quả.

(defun c:vetuong ()
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" "c" "0" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (getint "\nnhap chieu day tuong:"))
(setq cg (fix (/ (* (sqrt 2) day) 2)))
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
)
(command "trim" ssml "" "f" pt1 pt2 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (= (fix d1) cg) (= (fix d2) cg) (= (fix d3) cg) (= (fix d4) cg))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
)

Cám ơn bạn ketxu đã gợi ý để mình hoàn thành lisp.
BS: nét của bạn phải là layer "_tim" nếu không lisp sẽ bị sai.
  • 2
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!

#1898 bachngoctung

bachngoctung

    biết lệnh copy

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

Đã gửi 22 September 2010 - 11:24 PM

Chào bạn Ba5chngoctung,
Bạn xài thử cái này xem đã đúng ý chưa nhé.
Có vài điều lưu ý bạn khi dùng lisp này là:
1/- Việc chọn điể đầu và điểm cuối của bạn phải được thực hiện đúng trên đường chuẩn như bạn đã đánh dấu.
2/- Việc chọn text cần thay thế bạn phải chọn các text nằm dọc theo các cọc màu ghi của bạn chứ không chọn các text nằm ngang vuông góc với cọc bạn nhé.
3/- Lisp này chỉ chạy đúng với cấu trúc hình vẽ như cái file bạn đã upload. Cụ thể là các khoảng cách giữa các đường line ngang màu xanh của bạn phải là 2 và chiều cao các text cũng đúng y boong như vậy bạn nhé.
4/- Nếu bạn thay đổi cái cấu trúc hình này thì lisp sẽ chạy ra cái kết quả không như ý muốn. Sở dĩ vậy là do mình bố trí text căn cứ vào chiều cao hiện tại của nó và cái khoảng hở của các đường line màu xanh bạn ạ. Nếu cần thiết bạn có thể tự thay đổi các kích thước này trong lisp cho phù hợp.

Lisp đây:


(defun c:HCM ( / p1 p2 p3 p4 p5 p6 p7 p8 p11 ss1 ss2 ss3 en els pt txt)
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint "\n Chon diem cuoi")
p3 (list (car p1) (- (cadr p1) 8) (caddr p1))
p4 (list (- (car p2) 0.01) (- (cadr p2) 7.99) (caddr p2))
p5 (list (car p1) (- (cadr p1) 4) (caddr p1))
p6 (list (- (car p2) 0.01) (- (cadr p2) ) (caddr p2))
p7 (list (+ (car p1) 0.01) (- (cadr p1) 6.01) (caddr p1))
p8 (list (car p2) (- (cadr p2) 6) (caddr p2))
p11 (list (+ (car p1) 0.01) (cadr p1) (caddr p1))
ss1 (ssget "c" p11 p6 (list (cons 8 "LINEDONGTN")))
ss2 (ssget "w" p5 p8 (list (cons 0 "TEXT")))
ss3 (ssget "c" p7 p4 (list (cons 0 "TEXT,LINE")))
en (car (entsel "\n Chon text can thay the"))
els (entget en)
pt (cdr (assoc 11 els))
pt (list (+ (car pt) 0.8) (- (cadr pt) 0.8) (caddr pt))
txt (rtos (- (car p2) (car p1)) 2 2)
ss3 (ssdel en ss3)
)
(command "erase" ss1 ss2 ss3 "")
(setq els (subst (cons 1 txt) (assoc 1 els) els)
els ( subst (cons 50 0) (assoc 50 els) els)
els (subst (cons 11 pt) (assoc 11 els) els)
)
(entmod els)
(entupd en)
(command "undo" "e")
(princ)
)


Chúc bạn vui.

- Cám ơn PhamThanhBinh mình đã thử lisp mà bạn gửi cho mình thấy có một số bất cập sau:
+ Khi thử đối với các điểm 1 và 2 (của hình A) thì cho ra gần đúng kết quả như hình B khác mỗi là 2 đường thằng màu xanh nằm ngang phía dưới cũng bị xóa luôn theo
+ Khi thử với các điểm bất kỳ khác thì thấy nó cho kết quả là xóa luôn cọc ở điểm đầu và cọc ở điểm cuối khi mình chọn , đồng thời cũng xáo luôn cả 2 đường thằng màu xanh nằm ngang phía dưới
- Mà bạn PhamThanhBinh này : trong hình ảnh mình đưa lên đó cái cọc 1 và 2 mình đánh số và khoanh tròn chỉ là để cho bạn dễ nhìn và dễ hình dung thôi chứ bản vẽ ban đầu ko có.
- Mình đã thử và nhận thấy nếu cứ để vòng tròn ở hai điểm đầu và cuối thì nó ko xóa đi cọc đầu và cọc cuối còn ko có vòng tròn đó thì nó xóa luôn cọc đầu và cuối. Mong PhamThanhBinh xem lại và chỉnh lại cho mình nhé. Cám ơn nha
  • 0

#1899 843824

843824

    biết vẽ circle

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

Đã gửi 22 September 2010 - 11:47 PM

Các anh ơi - hôm nay em lại xin phiền các anh chút : em xin lisp nho nhỏ này
( đây là lisp thứ 2 em xin trong diễn đàn rồi ) hì hì

lisp ten : cong text theo cap so cong
Thuật toán là như vầy :
1. Đầu tiên sẽ tạo 1 text và copy text này ra các nơi vị trí muốn bố trí text ( ví dụ giá trị ban đầu text là 00 )
2.bấm lệnh của lisp
3. Xử lý như thế này các anh ạ :
+ Lisp sẽ hỏi chọn những text muốn cộng theo cấp số cộng này - sau đó em sẽ khối chọn những text cần
+ Lisp hỏi : nhập giá trị số đầu tiên - VD em sẽ nhập là : 10
+ Lisp hỏi : nhập giá trị số gia - VD em sẽ nhập là : 5
+ Lisp hỏi : chọn chiều cộng ( có 2 chiều là X hoặc Y nghĩa là cộng theo vị trí text trái phải hay trên dưới ) - VD em chọn : Y
+ Lisp hỏi : Chọn vị trí text đầu tiên - VD em chọn text có vị trí ở dưới cùng ( theo trục Y )
===> lisp sẽ thực hiện và ra kết quả : các text sẽ tự động thay đổi giá trị
VD em có 4 text : thì text bên dưới cùng sẽ là từ 00 ---> 10
tiếp theo các số ở trên nó : 00 ---> 15 ; 00 ---> 20 ; 00 ---> 25
==> kết quả : 10 ; 15 ; 20 ; 25 sẽ hiện lên màn hình

Các anh xem file cad đính kèm của em nhé ( Cad 2007 ) , em có giải thích chi tiết luôn :
http://www.mediafire...amb9uoyi6y59sk9
  • 0

#1900 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 01:17 AM

Cuối cùng thì mình cũng viết xong lisp này cho bạn rồi này. Chúc bạn vui và làm việc hiệu quả.

Cám ơn bạn ketxu đã gợi ý để mình hoàn thành lisp.
BS: nét của bạn phải là layer "_tim" nếu không lisp sẽ bị sai.

2 bác,vì lúc đưa ý kến e lấy trường hợp cụ thể mà bạn ấy yêu cầu là các cạnh tim trục vuông góc với nhau(đa số),nên khoảng cách fix luôn như vậy.Còn nếu trục tim chéó đi thì không thể dùng kcách cố định như vậy được.Có lẽ phải cho nó nằm trong khoảng từ 0 đến bề rộng tường.:(
Nhưng dù sao với yêu cầu ban đầu của bạn ấy thì lisp chạy quá mượt.Tks bác vì lisp công phu này
À,e xin ý kiến là bề rộng tường nếu getint thì với trường hợp vẽ có tỉ lệ khác 1:1 thì user hơi khổ ^^.Nếu có hàm nhỏ để user thay đổi tỉ lệ vẽ,khi nhận giá trị int thì chia cho tỉ lệ cũng được.
Và Khi user chọn các đường tim thì lấy luôn layer name của đối tượng để làm đối số cho các lệnh layer on,off phía sau.Như vậy thiì chỉ cần yêu cầu user vẽ tất cả các đường tim chung 1 layer
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC