Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

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

e xin 1 lisp lọc riêng số và chữ thuộc cùng 1layer, có các thuộc tính giống nhau. Đơn giản thế thôi ạ, xin các bro ra tay dùm

  • 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

chào nvc

......

2.Bạn chạy thử Lisp chọn các đối tượng cùng màu

Lisp chỉ chọn đối tuợng theo màu, việc copy, move, ChangeLayer , ... tùy bạn xử lý.

file: sbc.lsp

(defun c:sbc (/ ent col layers lay_lst filter ss);Select By Color

(defun get_layer(col / tbl lay_lst)

(setq tbl (tblnext "LAYER" T) lay_lst (list))

(while tbl

(if (= col (cdr (assoc 62 tbl)))

(setq lay_lst (cons (cdr(assoc 2 tbl)) lay_lst)) )

(setq tbl (tblnext "LAYER" ))

)

lay_lst

)

(if (setq ent (entsel "\nSelect object for color filter."))

(progn

(or (setq col (cdr(assoc 62 (entget (car ent)))))

(setq col (cdr (assoc 62

(tblsearch "layer"

(cdr (assoc 8 (entget (car ent)))))))); color is ByLayer, get layer color

)

(setq layers ""

lay_lst (get_layer col)) ; danh sach layer co mau "col"

(foreach lay lay_lst

(setq layers (strcat layers lay ",")))

(setq layers (substr layers 1 (1- (strlen layers)))); remove the last

(prompt (strcat "\n Chon doi tuong hay ENTER de chon tat ca doi tuong co color[ " (itoa col) " ]"))

(if layers ;; tao bo loc

(setq filter (append

(cons '(-4 . " )="" (list(cons="" 62="" col)))""> (list '(-4 . " )""> (cons 8 layers)

'(62 . 256) ; ByLayer

'(-4 . "AND>")

'(-4 . "OR>")

)))

(setq filter (list (cons 62 col)))

)

(sssetfirst nil)

(if (null (setq ss (ssget filter))) (setq ss (ssget "_X" filter)) )

(if (> (sslength ss) 0)

(progn

(prompt (strcat "\nChon duoc " (itoa (sslength ss))

" doi tuong co color[ " (itoa col) " ]"))

(sssetfirst nil ss)

))

))

(princ)

)

 

@ gia_bach

Bạn làm ơn xem lại lisp này hộ mình,khi load thì cad nhận nhưng khi sử dụng thì báo là :

function definition: CONS= và CAD không thực hiện lệnh.

Mình nghĩ chắc bị 1 lỗi nhỏ nào đấy.

Thank

  • Vote tăng 2
  • Vote giảm 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
e xin 1 lisp lọc riêng số và chữ thuộc cùng 1layer, có các thuộc tính giống nhau. Đơn giản thế thôi ạ, xin các bro ra tay dùm

 

Mong các lisper ra tay giúp cho ạ, à có thêm chức năng chuyển số (hoặc chữ) sang layer khác thì càng tốt ạ. E muốn tách riêng 2 thứ để quản lý cho dễ ^^~

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 làm ơn xem lại lisp này hộ mình,khi load thì cad nhận nhưng khi sử dụng thì báo là :

function definition: CONS= và CAD không thực hiện lệnh.

Mình nghĩ chắc bị 1 lỗi nhỏ nào đấy.

Thank

Chào nvc

Do có lỗi trong Insert Code Box

Gửi bạn link dowload trực tiếp Lisp chọn các đối tượng cùng màu

download here

  • 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
Chào nvc

Do có lỗi trong Insert Code Box

Gửi bạn link dowload trực tiếp Lisp chọn các đối tượng cùng màu

download here

 

 

Tôi thấy ban viêt rất hay! bạn co the viet thêm phần chọn các đối tượng có cùng linetype ra nữa 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
Tôi thấy ban viêt rất hay! bạn co the viet thêm phần chọn các đối tượng có cùng linetype ra nữa không?

Chào chandatn

Cập nhật Lisp chọn các đối tượng theo màu hay linetype

download here

  • Vote tăng 3

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

Bạn hãy tạo 1 ví dụ bảng excel chứa dữ liệu, gồm n cột, trong đó phải có 4 cột: tên node, X, Y, Z. Dữ liệu có hàng chục điểm như bạn nói hoặc nhiều hơn nữa. Upload lên, và Thiep sẽ gửi cho bạn 1 lisp tạo đường 3Dpolyline.

Còn ý tưởng 2: có phải bạn muốn nói thêm node trên polyline không? chứ các node tự động chuyển đến là sao?

Chỉ thêm text độ cao tại vị trí thêm node trên polyline hay thêm text toàn bộ các node của polyline?

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 chandatn

Cập nhật Lisp chọn các đối tượng theo màu hay linetype

download here

 

Cám ơn bạn đã phản hồi rất nhanh. Trình độ lisp cuả minh gà quá nên đọc vào nhưng ko hiểu được nhiều!

  • Vote giảm 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

Chào bạn Tuệ bạn có lisp chuyển file số liệu thành đường 3d polyline rất hay, nhưng công việc của tớ rất nhàm chán là phải tạo đường 3d polyline thành đường 2d polyline từ nền hiện trạng khi công tác trắc địa tức là bản bình đồ hiện trạng họ đưa cho khi làm mặt cắt địa hình thì mình phải nhìn vào bản hiện trạng đó để sử lý số liệu tức là mình cần biến đường 2d p thành 3d p mà phải dựa vào số liệu bình đồ tức là số liệu cao độ để làm đường đứt gẫy địa hình các bạn viết các lisp trên cũng gần đúng ý mình rồi nhưng mình muốn các bạn tạo cho mình một lisp như thế này mình đưa bản vẽ lên:

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

Cám ơn sự nhiệt tình của các 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

Các huynh giúp đệ 1 cái Lisp như sau được không?

Trong file text: data.txt đệ định dạng như sau:

 

Diem 1 (tab) 1 (tab) 6 (tab) 0 (tab) 8 (tab) 0 (tab) 12

Diem 2 (tab) 1 (tab) 5 (tab) 0 (tab) 7 (tab) 5 (tab) 2

......

 

( (tab) ở hàng trên là dấu TAB để ngăn cách các giá trị)

 

Bây giờ em cần 1 LISP có tác dụng đọc từng hàng text trên, tìm trên toàn vùng chọn (hoặc trên toàn bản vẽ cũng được) Diem 1 và thay giá trị các text phía dưới lần lượt như hình minh họa.

(trong đó Diem 1 và các text phía dưới là các hàng của 1 Mtext)

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 Tuệ bạn có lisp chuyển file số liệu thành đường 3d polyline rất hay, nhưng công việc của tớ rất nhàm chán là phải tạo đường 3d polyline thành đường 2d polyline từ nền hiện trạng khi công tác trắc địa tức là bản bình đồ hiện trạng họ đưa cho khi làm mặt cắt địa hình thì mình phải nhìn vào bản hiện trạng đó để sử lý số liệu tức là mình cần biến đường 2d p thành 3d p mà phải dựa vào số liệu bình đồ tức là số liệu cao độ để làm đường đứt gẫy địa hình các bạn viết các lisp trên cũng gần đúng ý mình rồi nhưng mình muốn các bạn tạo cho mình một lisp như thế này mình đưa bản vẽ lên:

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

Cám ơn sự nhiệt tình của các bạn.

Chào Tuynh

Code sau Tue_NV viết lại theo ý của bạn. Bạn chạy thử nhé :

(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x ss oldos)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))
(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '() ss (ssadd))
(setq cao (getdist "\n Chon chieu cao chu :"))

(while ((setq p (vlax-curve-getPointAtParam curve i))
(setq lstdiem (append lstdiem (list p)))
(wtxt (rtos (caddr p) 2 2) p 0 cao)
(setq ss (ssadd (entlast) ss))
(setq i (1+ i))
)

(setq i 0)
(foreach x lstdiem
(setq z (getdist x (strcat "\n Nhap cao do cho diem nay  : ") ))
(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))
(wtxt (rtos z 2 2) (list (car x) (cadr x) z) 0 cao)
(entdel (ssname ss i))
(setq i (1+ i))
)

(command "3dpoly")
(foreach y lstpoint (command y))
(command "")
(entdel curve)
(setvar "osmode" oldos)
(princ)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) 
(cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 2) (cons 73 1) (cons 50 ang) 
(cons 40 h) (cons 41 0.8))
)
)

:s_big:

 

Các huynh giúp đệ 1 cái Lisp như sau được không?

Trong file text: data.txt đệ định dạng như sau:

 

Diem 1 (tab) 1 (tab) 6 (tab) 0 (tab) 8 (tab) 0 (tab) 12

Diem 2 (tab) 1 (tab) 5 (tab) 0 (tab) 7 (tab) 5 (tab) 2

......

 

( (tab) ở hàng trên là dấu TAB để ngăn cách các giá trị)

 

Bây giờ em cần 1 LISP có tác dụng đọc từng hàng text trên, tìm trên toàn vùng chọn (hoặc trên toàn bản vẽ cũng được) Diem 1 và thay giá trị các text phía dưới lần lượt như hình minh họa.

(trong đó Diem 1 và các text phía dưới là các hàng của 1 Mtext)

@duongthanh85 : Bạn nên upload file .dwg và nói rõ hơn. Vì có thể mình chưa hiểu hết điều bạn nói

  • 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ám ơn Tuệ nhé lisp bạn chỉnh cho mình chạy ok thực sự cảm ơn sự nhiệt tình của Tuệ và các thành viên trong diễn đàn đã giúp đỡ mình lisp đó của bạn chạy đúng như ý tớ. Nhưng khi mình làm thì nảy sinh một vấn đề là khi mình chỉnh lại cao độ đường 3d polyline thì phải chạy lại lisp ý mình muốn thế này khi chỉnh lại cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text là cao độ đường 3d polyline cũng thay đổi theo không cần vào PROPERTIES hay chạy lại lisp nữa, mình muốn hiện cao độ ở dạng text có ý là như vậy. Nhưng thực sự lisp của bạn đã giúp tớ rất nhiều. Cám ơn bạn nhé :s_big:

  • Vote giảm 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 bạn ơi! mình có mấy cái lisp này mình sưu tầm được nhưng chưa đúng ý mình, nhờ các bạn sửa lại dùm mình tí.

- Lisp thông số cống:nhờ các bạn sửa lại sao cho độ dốc cống bằng nghịch đảo của đường kính cống (đường kính tự mình nhập) (độ dốc lấy theo đơn vị phần ngàn ví dụ với đường kính là 400 thì độ dốc là 2.5) (hiện nay độ dốc cống đang mặc định là 0.0035 )

- Lisp thông số điện:

+ thì bỏ mũi tên đi (ko cần vẽ mũi tên)

+ bỏ ko cần ghi chiều dài luôn

+ tiết diện dây tự mình nhập (hiện nay mình nhập bất cứ số nào cũng mặc định là M-(3x240))

Chi tiết rõ hơn phiền các bạn xem bản vẽ mình gửi kèm nhé!

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

http://www.cadviet.com/upfiles/2/filelisp.rar

Cảm ơn mọi người rất nhiề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
Cám ơn Tuệ nhé lisp bạn chỉnh cho mình chạy ok thực sự cảm ơn sự nhiệt tình của Tuệ và các thành viên trong diễn đàn đã giúp đỡ mình lisp đó của bạn chạy đúng như ý tớ. Nhưng khi mình làm thì nảy sinh một vấn đề là khi mình chỉnh lại cao độ đường 3d polyline thì phải chạy lại lisp ý mình muốn thế này khi chỉnh lại cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text là cao độ đường 3d polyline cũng thay đổi theo không cần vào PROPERTIES hay chạy lại lisp nữa, mình muốn hiện cao độ ở dạng text có ý là như vậy. Nhưng thực sự lisp của bạn đã giúp tớ rất nhiều. Cám ơn bạn nhé :s_big:

Cảm ơn Tuệ, Thiep bận rộn cả ngày hôm qua, Tuệ đã tiếp tay rất nhanh cho Tuynh.

Thiep chỉ gợi ý Tue rằng có 1 hàm trong thư viện Express tools tạo POLYLINE rất nhanh, đó là: acet-pline-make.

Còn lisp trên, Tuynh hãy đợi Tue_NV sẽ thêm vòng lặp để chọn đối tượng đến khi enter thì 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

Mình tìm trên diễn đàn cái lisp ghi toa độ mà chưa tìm được cái đúng ý mình, Nhờ các bác sửa giúp mình cái lisp này với, hiện mình đang dùng nhưng lại có 2 điểm bấc tiện thế này:

1. Nó tự động lưu file .tdo vào nơi nào đó tuỳ thích, có lúc tìm hoài chẳng thấy luôn.

2. Mỗi lần kích điểm thì phải đặtt tên điểm, mình muốn nó tự đông nhảy từ 1 sau đó lên 2 rồi 3.4.5.6...

Mình up file không được đành coppy code lê nhé:

(defun c:gtd()

(setq file (getstring T "Ten file toa do : "))

(setq tenf (strcat file ".tdo"))

(setq f (open tenf "a"))

(setq ST1 (getstring "Ten diem : "))

(setq pt1 (getpoint "Toa do diem : "))

(while (/= pt1 nil)

(print)

(setq x1 (car pt1) y1 (cadr pt1))

(setq xx1 (rtos x1 2 4) yy1 (rtos y1 2 4))

(write-line (strcat ST1 "\t" xx1 "\t" yy1) f)

(setq ST1 (getstring "Ten diem : "))

(setq pt1 (getpoint "Toa do diem : "))

)

(close f)

(princ)

)

(prompt "\nTD : Ghi toa do diem ra file")

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

File cad và file data.txt

http://www.cadviet.com/upfiles/2/caddata.zip

 

 

@Anh Tuệ:

Em có đổi một chút vấn đề để tùy biến mạnh hơn, Ý tưởng của em như sau:

 

Trong file text các hàng dữ liệu ngăn cách bởi dấu tab, đầu tiên là tên điểm (VD: "Diem 1")

 

02Sep081140.jpg

 

Bây giờ em mong được giúp làm 1 lisp:

- Đọc lần lượt từng hàng trong file text.

- Tách ra thành các chuỗi (các chuỗi trong hàng được ngăn cách bởi dấu tab - xem file data.txt đính kèm)

- Tìm trên toàn bản vẽ xem mtext nào có dòng đầu trùng với chuỗi đầu tiên (VD: tìm mtext có dòng đầu là "Diem 1")

- ghi lần lượt các chuỗi vừa tách vào các hàng tiếp theo của mtext đó.

- Tiếp tục với hàng tiếp theo trong data.txt (như trong file đính kèm là Diem 2)

 

+ Nếu không tìm thấy thì bỏ qua dòng text đó và nhảy xuống dòng tiếp theo trong file data.txt

 

03Sep081141.jpg

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ình tìm trên diễn đàn cái lisp ghi toa độ mà chưa tìm được cái đúng ý mình, Nhờ các bác sửa giúp mình cái lisp này với, hiện mình đang dùng nhưng lại có 2 điểm bấc tiện thế này:

1. Nó tự động lưu file .tdo vào nơi nào đó tuỳ thích, có lúc tìm hoài chẳng thấy luôn.

2. Mỗi lần kích điểm thì phải đặtt tên điểm, mình muốn nó tự đông nhảy từ 1 sau đó lên 2 rồi 3.4.5.6...

.....

Chào CongHoan, Thiep muốn tìm lại lisp gtd.lsp mà Hoan load được là của tác giả nào mà không thấy. Hoan chỉ giùm nhé

Bây giờ Thiep chỉnh lại lisp ấy đây:

(defun c:gtd (/ ST fn f x1 y1)
 (setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))
 (setq f (open fn "a"))
 (setq ST 1)
 (while (setq pt (getpoint "Toa do diem : "))
   (setq x1 (rtos (car pt) 2 4)
  y1 (rtos (cadr pt) 2 4))
   (write-line (strcat (itoa ST) "\t" x1 "\t" y1) f)
   (setq ST (1+ ST))
   (terpri)
 )
 (close f)
 (print)
)

  • 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ác bạn ơi! mình có mấy cái lisp này mình sưu tầm được nhưng chưa đúng ý mình, nhờ các bạn sửa lại dùm mình tí.

- Lisp thông số cống:nhờ các bạn sửa lại sao cho độ dốc cống bằng nghịch đảo của đường kính cống (đường kính tự mình nhập) (độ dốc lấy theo đơn vị phần ngàn ví dụ với đường kính là 400 thì độ dốc là 2.5) (hiện nay độ dốc cống đang mặc định là 0.0035 )

- Lisp thông số điện:

+ thì bỏ mũi tên đi (ko cần vẽ mũi tên)

+ bỏ ko cần ghi chiều dài luôn

+ tiết diện dây tự mình nhập (hiện nay mình nhập bất cứ số nào cũng mặc định là M-(3x240))

Chi tiết rõ hơn phiền các bạn xem bản vẽ mình gửi kèm nhé!

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

http://www.cadviet.com/upfiles/2/filelisp.rar

Cảm ơn mọi người rất nhiều!

có ai giúp mình với!

  • Vote tăng 1
  • Vote giảm 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
File cad và file data.txt

http://www.cadviet.com/upfiles/2/caddata.zip

@Anh Tuệ:

Em có đổi một chút vấn đề để tùy biến mạnh hơn, Ý tưởng của em như sau:

Trong file text các hàng dữ liệu ngăn cách bởi dấu tab, đầu tiên là tên điểm (VD: "Diem 1")

Bây giờ em mong được giúp làm 1 lisp:

- Đọc lần lượt từng hàng trong file text.

- Tách ra thành các chuỗi (các chuỗi trong hàng được ngăn cách bởi dấu tab - xem file data.txt đính kèm)

- Tìm trên toàn bản vẽ xem mtext nào có dòng đầu trùng với chuỗi đầu tiên (VD: tìm mtext có dòng đầu là "Diem 1")

- ghi lần lượt các chuỗi vừa tách vào các hàng tiếp theo của mtext đó.

- Tiếp tục với hàng tiếp theo trong data.txt (như trong file đính kèm là Diem 2)

 

+ Nếu không tìm thấy thì bỏ qua dòng text đó và nhảy xuống dòng tiếp theo trong file data.txt

Bạn dùng đoạn Lisp sau :

Trong đoạn Code có sử dụng hàm con POS của anh Hoành và hàm REPLACESTRING của anh giabach

Tue_NV xin mạn phép sử dụng 2 hàm con này để giúp cho bạn duongthanh85.

Cảm ơn anh Hoành và anh giabach

(defun c:imp( / tfile f st td ss st vt chuoidau1 chuoithay i sn ent)
  (setq tfile (getfiled "Ten file" "" "txt" 6))
  (if tfile (progn
    (setq f (open tfile "r"))
   (setq ss (ssget '((0 . "MTEXT"))) i 0)

    (while (setq st (read-line f))
(setq vt (pos "\t" st))
       (setq chuoidau1 (substr st 1 (- vt 1)))
       (setq chuoithay (replacestring st "\t" "\\P"))

       (while (          (setq sn (ssname ss i))
          (setq ent (entget sn))
          (setq chuoidau2 (cdr(assoc 1 ent)))       

        (if (= chuoidau1 chuoidau2) 
              (setq ent (entmod (subst (cons 1 chuoithay) (assoc 1 ent) ent)))
        )
          (setq i (1+ i))
      )
  (setq i 0 ss (ssget "P"))
    )
    (close f)
  
  ))
)
;
(defun pos (sub st / l1 l2 index)
   (setq index	1
  l1	(strlen sub)
  l2	(strlen st)
   )
   (while
     (and (       (setq index (1+ index))
   )
   (if	(= sub (substr st index l1))
     index
     nil
   )
 )
;
(defun ReplaceString (str str1 str2 / m)
 (setq m 0)
 (while (setq m (vl-string-search str1 str m))
   (setq str (vl-string-subst str2 str1 str m))
   (setq m (1+ m))
   ) ;_ end of while
 str
 ) ;_ end of defun

  • 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ác bạn ơi! mình có mấy cái lisp này mình sưu tầm được nhưng chưa đúng ý mình, nhờ các bạn sửa lại dùm mình tí.

- Lisp thông số cống:nhờ các bạn sửa lại sao cho độ dốc cống bằng nghịch đảo của đường kính cống (đường kính tự mình nhập) (độ dốc lấy theo đơn vị phần ngàn ví dụ với đường kính là 400 thì độ dốc là 2.5) (hiện nay độ dốc cống đang mặc định là 0.0035 )

- Lisp thông số điện:

+ thì bỏ mũi tên đi (ko cần vẽ mũi tên)

+ bỏ ko cần ghi chiều dài luôn

+ tiết diện dây tự mình nhập (hiện nay mình nhập bất cứ số nào cũng mặc định là M-(3x240))

Chi tiết rõ hơn phiền các bạn xem bản vẽ mình gửi kèm nhé!

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

http://www.cadviet.com/upfiles/2/filelisp.rar

Cảm ơn mọi người rất nhiều!

Chào TruongThanh, nhìn chung, tác giả của 2 lisp bạn sưu tầm không chịu khó chỉnh sửa, ví dụ muốn tạo Layer có tên "ahs-tnt-TSC" nhưng không tạo, các tham số đường kính không đưa vào text. 2 lisp trên mình đã chỉnh sửa cho bạn:

(defun C:Tn ()
(vl-load-com)
(setq *layer*	(vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
 (setvar "cmdecho" 0)
 (setvar "orthomode" 0)
 (setvar "gridmode" 0)
 (setvar "snapmode" 0)
 (setvar "osmode" 0)
 (if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
   (progn
     (setq lay (vla-add *layer* "ahs-tnt-TSC"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "CONTINUOUS")
   )
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "ahs-tnt-TSC"))
     (vla-put-color lay acWhite)
     (vla-put-Linetype lay "CONTINUOUS")
   )
 )
(setvar "clayer" "ahs-tnt-TSC")
  (command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" "")
(setq SS (ssget '((0 . "lwpolyline"))))
 (setq	dk	(cond (dk)
	      (300)
	)
 )
 (setq olddk dk)
 (setq	dk	(getreal (strcat "\nNhap tiet dien day <"
			 (rtos olddk 2 1)
			 "> : "
		 )
	)
 )
 (if (null dk)
   (setq dk olddk)
 )
 (setq	chu (cond	(chu)
		(3)
	  )
 )
 (setq oldchu chu)
 	  (setq N 0)
 (repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq   len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)); chieu dai polyline
	PC (vlax-curve-getendpoint obj); dien cuoi
	PD (vlax-curve-getstartpoint obj); diem dau
)
;lay gia tri toa do cua diem dau
(setq PDx (car PD)
     PDY (cadr PD)
  )
;lay gia tri toa do cua diem cuoi
(setq PCx (car PC)
     PCY (cadr PC)
  )
(If (< PDx PCx)
 (progn
   (setq goc (angle PD PC)
  ang (cvunit goc "radians" "degrees")
	  p1 (polar PD goc (/ len 2))
	  p2 (polar p1 (+ (/ pi 2) goc) chu)
  p3 (polar p1 (+ (/ pi 2) goc) (- 0 chu))
  p4 (polar p3 goc (/ (* 1 -16.25) chu))
  p5 (polar p4 goc (/ (* 1 25) chu))
  p6 (polar p5 goc (/ (* 1 7.5) chu))
 dodoc (/ 1000 dk) 
	)
   ; ghi gia tri va ve mui ten
(command ".text" "j" "mc" p2 chu ang (strcat "Ø" (rtos dk 2 0) " - L" (rtos len 2 0) " - i" (rtos dodoc 2 2))
 ".pline" p4 "w" 0.5 0.5 p5 "w" 2 0 p6 "")
);dong progn
 (progn
   (setq goc1 (angle PC PD)
  ang1 (cvunit goc1 "radians" "degrees")
	  p1_1 (polar PD goc1 (- 0 (/ len 2)))
	  p2_1 (polar p1_1 (+ (/ pi 2) goc1) chu)
  p3_1 (polar p1_1 (+ (/ pi 2) goc1) (- 0 chu))
  p4_1 (polar p3_1 goc1 (/ (* 1 16.25) chu))
  p5_1 (polar p4_1 goc1 (/ (* 1 -25) chu))
  p6_1 (polar p5_1 goc1 (/ (* 1 -7.5) chu))
	)
   ; ghi gia tri va ve mui ten
(command ".text" "j" "mc" p2_1 chu ang1 (strcat "Ø" (rtos dk 2 0) " - L" (rtos len 2 0) " - i" (rtos dodoc 2 2))
 ".pline" p4_1 "w" 0.5 0.5 p5_1 "w" 2 0 p6_1 "")
   )
     );dong if
   (setq N (1+ N))
       ); dong vong lap repeat
 (princ)
 ;mo bat diem
           (setvar "osmode" 7)
)

(defun C:tsd ()
(vl-load-com)
 ;tat bat diem
 (setvar "cmdecho" 0)
 (setvar "orthomode" 0)
 (setvar "gridmode" 0)
 (setvar "snapmode" 0)
 (setvar "osmode" 0)
 (setq *layer*	(vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
 (if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
   (progn
     (setq lay (vla-add *layer* "ahs-tnt-TSC"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "CONTINUOUS")
   )
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "ahs-tnt-TSC"))
     (vla-put-color lay acWhite)
     (vla-put-Linetype lay "CONTINUOUS")
   )
 )
 (setvar "clayer" "ahs-tnt-TSC")
 (command  ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" "")
(setq SS (ssget '((0 . "lwpolyline"))))
 (setq	dk	(cond (dk)
	      (300)
	)
 )
 (setq olddk dk)
 (setq	dk	(getreal (strcat "\nNhap tiet dien day <"
			 (rtos olddk 2 1)
			 "> : "
		 )
	)
 )
 (if (null dk)
   (setq dk olddk)
 )
 (setq	chu (cond	(chu)
		(3)
	  )
 )
 (setq oldchu chu)
 (setq	chu (getreal (strcat "\nChon chieu cao chu <"
			   (rtos oldchu 2 1)
			   "> : "
		   )
	  )
 )
 (if (null chu)
   (setq chu oldchu)
 )
 (setq N 0); gia tri ban dau
 (repeat (sslength SS)
   (setq ent (ssname SS N))
   (setq obj (vlax-ename->vla-object ent))
   (setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
				; chieu dai polyline
  PC  (vlax-curve-getendpoint obj) ; dien cuoi
  PD  (vlax-curve-getstartpoint obj) ; diem dau
   )
				;lay gia tri toa do cua diem dau
   (setq PDx (car PD)
  PDY (cadr PD)
   )
				;lay gia tri toa do cua diem cuoi
   (setq PCx (car PC)
  PCY (cadr PC)
   )
   (If	(< PDx PCx)
     (progn
(setq goc (angle PD PC)
      ang (cvunit goc "radians" "degrees")
      p1  (polar PD goc (/ len 2))
      p2  (polar p1 (+ (/ pi 2) goc) chu)
      p3  (polar p1 (+ (/ pi 2) goc) (- 0 chu))
      p4  (polar p3 goc -16.25)
      p5  (polar p4 goc 25)
      p6  (polar p5 goc 7.5)
)
				; ghi gia tri va ve mui ten
(command ".text"
	 "j"
	 "mc"
	 p2
	 chu
	 ang
	 (strcat "M-(3x" (rtos dk 2 0) ")" "-L" (rtos len 2 0) "m")
)
     )					;dong progn
     (progn
(setq goc1 (angle PC PD)
      ang1 (cvunit goc1 "radians" "degrees")
      p1_1 (polar PD goc1 (- 0 (/ len 2)))
      p2_1 (polar p1_1 (+ (/ pi 2) goc1) chu)
      p3_1 (polar p1_1 (+ (/ pi 2) goc1) (- 0 chu))
      p4_1 (polar p3_1 goc1 16.25)
      p5_1 (polar p4_1 goc1 -25)
      p6_1 (polar p5_1 goc1 -7.5)
)
				; ghi gia tri va ve mui ten
(command ".text"
	 "j"
	 "mc"
	 p2_1
	 chu
	 ang1
	 (strcat "M-(3x" (rtos dk 2 0) ")" "-L" (rtos len 2 0) "m")
)
     )
   )					;dong if
   (setq N (1+ N))
 )					; dong vong lap repeat
 (princ)
 ;mo bat diem
           (setvar "osmode" 7)
); dong cong thuc

  • 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
Chào TruongThanh, nhìn chung, tác giả của 2 lisp bạn sưu tầm không chịu khó chỉnh sửa, ví dụ muốn tạo Layer có tên "ahs-tnt-TSC" nhưng không tạo, các tham số đường kính không đưa vào text. 2 lisp trên mình đã chỉnh sửa cho bạn:

Cảm ơn Thiep nhiều lắm!nhưng vẫn còn 1 số vướng mắc:

1)Lisp TN:

-Lisp TN thì bị mất phần nhập chiều cao chữ và mũi tên vẫn chưa giống mũi tên của LISP thông số điện của mình gửi.

-Chữ FI (đường kính) bị lỗi (mình dùng font Arial)

 

2)Lisp TSD:

- Bỏ ko cần ghi chiều dài

- Và chia làm 2 trường hợp dùm mình với

+Trường hợp 1 như ban đầu (chỉ việc bỏ chiều dài thôi)

+Trường hợp 2 có dạng 2xM-(3xXXX + 1xYYY)

XXX:mình tự nhập với câu lệnh là:"Nhập tiết diện đầu:"

YYY: mình tự nhập với câu lệnh là: "Nhập tiết diện sau:"

Mong Thiep giúp dùm mình nhé!cảm ơn sự quan tâm nhiệt tình của bạn!

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

P/S:cho mình hỏi tí:

- Khi load lisp lên thì báo lỗi:

Command: tn

Unknown command "TN". Press F1 for help.

Unknown command "TN". Press F1 for help.

Làm máy mình bị treo 1 hồi. :s_big:

  • Vote giảm 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ảm ơn Tuệ, Thiep bận rộn cả ngày hôm qua, Tuệ đã tiếp tay rất nhanh cho Tuynh.

Thiep chỉ gợi ý Tue rằng có 1 hàm trong thư viện Express tools tạo POLYLINE rất nhanh, đó là: acet-pline-make.

Còn lisp trên, Tuynh hãy đợi Tue_NV sẽ thêm vòng lặp để chọn đối tượng đến khi enter thì thôi

Cảm ơn các pác đã nhiệt tình giúp đỡ, mình vẫn tiếp tục nhờ các pác giúp cho là khi mình chỉnh sửa cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text (cao độ mình đã nhập khi lần đầu chạy lisp) và đường 3d polyline có cao độ thay đổi theo khi chỉnh sửa text

  • Vote giảm 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 mọi người...Mình đã có Lisp để nối LINE, ARC thành POLYLINE. Nhưng trong bản Cad của mình có cả những hình đựơc vẽ nên từ SPLINE và PLINE. Bi giờ muốn nó thành POLYLINE thì lại phải BO rất là mất công. Bạn nào có thể viết cho mình cái LISP để thực hiện lệnh biến SPLINE , PLINE thành POLYLINE được ko? Mình xin chân thành cảm ơn ! Chúc diễn đàn ngày càng phát triển

  • Vote giảm 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.

×