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ị

- Mình có một vấn đề này cần các bạn viết lisp cho mình (xem hình vẽ nhé).

Capture.jpg

-Cụ thể cấu trúc lisp như sau:

+ Chọn vào các text ở hình 1

+ Nhập Bán kính đường tròn ( có luôn cả wipeout nhé)

+ Cho kết quả như hình 2

- A em thử xem giúp mình cái nhé, cám ơn nhiều :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

- Em không biết diễn đàn đã có bài nào về vấn đề này chưa? Nếu đã có thì nhờ mọi người giúp đỡ link, Nếu chưa em mong nhận được câu trả lời từ diễn đàn.

Em muốn tìm hiểu về lệnh "Pan". Dựa vào đâu mà khi thực hiện lệnh Pan, con trỏ cho chọn vị trí thứ nhất điểm I toạ độ (x1, y1) Rồi ta kéo rê đến vị trí thứ hai điểm II toạ độ (x2, y2) thì màn hình tịnh tiến đến vị trí mới. Em nhờ diễn đàn viết giúp 1 lisp (hàm pp), hàm yêu cầu pick điểm nguồn (điểm I)/toạ độ (x1,y1). Sau đó hàm yêu cầu pick điểm đích (điểm II)/nhập toạ độ (x2,y2). Sau đó hàm pp thực hiện chức năng "pan" sang vị trí mới.

Xin chân thành cảm ơn diễn đà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
- Mình có một vấn đề này cần các bạn viết lisp cho mình (xem hình vẽ nhé).

Capture.jpg

-Cụ thể cấu trúc lisp như sau:

+ Chọn vào các text ở hình 1

+ Nhập Bán kính đường tròn ( có luôn cả wipeout nhé)

+ Cho kết quả như hình 2

- A em thử xem giúp mình cái nhé, cám ơn nhiều :D

Thử cái này xem:

 

 

(Defun c:trt ( )

(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")

(command "undo" "be")

(Princ "\nHay chon doi tuong :")

(setq SS (ssget '((0 . "TEXT"))))

 

(setq bkt (getstring "\nBan kinh vong tron:"))

 

(setq i 0)

(setq N (sslength ss))

(while (< i N)

(setq TEXTENT (ssname SS i))

(setq luubatdiem (getvar "osmode"))

(setvar "osmode" 0)

(command "ucs" "object" textent)

(setq tbTB (textbox (list (cons -1 textent)))

ll (car tbTB)

ur (cadr tbTB)

ul (list (car ll) (cadr ur))

lr (list (car ur) (cadr ll))

)

 

(setq daitext (distance ul lr))

(setq goctext(angle ul lr))

(setq dainuatext (/ daitext 2))

(setq diemquay (polar ul goctext dainuatext))

 

(command ".circle" diemquay bkt)

(command ".polygon" "30" diemquay "" bkt)

(command ".wipeout" "" "last" "y")

(command ".copy" textent "" diemquay diemquay)

(command ".erase" "Previous" "")

(command "ucs" "p")

(setq i (1+ i))

(setvar "osmode" luubatdiem)

)

(command "undo" "end")

(Princ)

)

  • 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
- Em không biết diễn đàn đã có bài nào về vấn đề này chưa? Nếu đã có thì nhờ mọi người giúp đỡ link, Nếu chưa em mong nhận được câu trả lời từ diễn đàn.

Em muốn tìm hiểu về lệnh "Pan". Dựa vào đâu mà khi thực hiện lệnh Pan, con trỏ cho chọn vị trí thứ nhất điểm I toạ độ (x1, y1) Rồi ta kéo rê đến vị trí thứ hai điểm II toạ độ (x2, y2) thì màn hình tịnh tiến đến vị trí mới. Em nhờ diễn đàn viết giúp 1 lisp (hàm pp), hàm yêu cầu pick điểm nguồn (điểm I)/toạ độ (x1,y1). Sau đó hàm yêu cầu pick điểm đích (điểm II)/nhập toạ độ (x2,y2). Sau đó hàm pp thực hiện chức năng "pan" sang vị trí mới.

Xin chân thành cảm ơn diễn đàn.

Mình cũng chả biết nó dựa vào đâu nhưng lisp thì như này:

(defun c:ppan ( )

(setq a (getpoint "\nChon diem xuat phat: "))

(setq b (getpoint a"\nChon diem den: "))

(command ".pan" a b "")

(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

Mình rất thích lisp in MPL của bác Hoành wub.gif wub.gif

Rất mong bác sớm chỉnh sửa, bổ sung để có thể in được trong Layout.

Nếu version mới ra đời xin gửi cho mình 1 bản vào Email: ktdb@itcvn.vn cheers.gif cheers.gif

Xin 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

Trước hết xin cám ơn các bác đã quan tâm giúp đỡ.

Sở dĩ em cần làm vậy vì trong các bản vẽ hiện trạng dung lượng rất lớn (có khi đến cả 500MB CAD) edit từng block là điều rất khó vì nó có vài trăm block; vài chục layer, mỗi thằng định dạng một kiểu, nên em muốn tất cả các đối tượng về một layer, màu: bylayer của đối tượng gốc chứ không phải của layer chứa block, được vậy thì cám ơn các bác lắm.

Gửi các bác một file mẫu:

Em Up mãi không được bác nào thương tình dowload giúp em ở đây, file chỉ 1,5MB thôi:

https://www.yousendit.com/download/aHlUQ1ZtcWY4NVh2Wmc9PQ

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 anh ơi cho em hỏi.Em có viết lisp về lệnh CO thành C.Thao tác quen của em là chọn đối tượng rồi mới enter nhưng bây giờ như thế ko đc.gõ lệnh xong em lại phải chọn đối tường một lần nữa.Các anh có thể viết lại đoạn lisp mà chỉ cần chọn đối tượng và enter một lần là đc ko ạ?Em cám ơn 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

Không cần Lisp đâu, chắc là ai đó đã chỉnh mất phần sau rồi.

Option>Selection>Selection modes>Noun/Verb selection

Hãy đánh dấu vào ô đó 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

Ko.Ý e là muốn viết một cái lisp như thế để mình còn tiện mang đi chứ ko cần lisp thì nói làm j.viết một cái lisp mà lệnh CO sau khi chuyển thành C mình chỉ cần chọn đối tượng rồi enter là có thể di copy luôn ko cần phải chọn đối tượng thêm một lần nữa.

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ông hiểu ý bạn là gì.

Lisp chỉ cần dùng để làm những việc có tính chất quy luật lặp đi lặp lại để giảm bớt thời gian.

Chuyển CO thành C thực chất đều là lệnh tắt của lệnh COPY. Bạn nên nghiên cứu file Acad.pgp để biết cách tạo lệnh tắt.

Còn việc chọn đối tượng trước, lệnh sau thì chỉ cần chỉnh trong Option là được.

Tôi thấy viết Lisp cho việc này là không cần thiết, mặc dù viết rất đơn giả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

Nhờ các bác viết giúp lisp: thêm một vertex vào đường polyline.

Thông thường thì e phải dùng lệnh pedit\ edit vertex\ rồi phải chọn next hoặc previous sau đó mới chọn insert

Công việc này quá mất nhiều thao tác, bác nào có thể viết lisp thêm một vertex vào đường polyline bằng cách chọn 1 điểm là được ngay.

 

Cám ơn các bác 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
Nhờ các bác viết giúp lisp: thêm một vertex vào đường polyline.

Thông thường thì e phải dùng lệnh pedit\ edit vertex\ rồi phải chọn next hoặc previous sau đó mới chọn insert

Công việc này quá mất nhiều thao tác, bác nào có thể viết lisp thêm một vertex vào đường polyline bằng cách chọn 1 điểm là được ngay.

 

Cám ơn các bác nhiều

Sony chịu khó tìm kiếm 1 chút nhé :

Lisp đó đây : http://www.cadviet.com/forum/index.php?sho...15016&st=20

  • 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
Ko.Ý e là muốn viết một cái lisp như thế để mình còn tiện mang đi chứ ko cần lisp thì nói làm j.viết một cái lisp mà lệnh CO sau khi chuyển thành C mình chỉ cần chọn đối tượng rồi enter là có thể di copy luôn ko cần phải chọn đối tượng thêm một lần nữa.

(defun C:C (/ SS)
 (setq SS (ssget))
 (if SS
 (command "Copy" SS "" "M" pause )
 (command "Copy" "P" "" "M" pause ))
 );defun

(defun C:M (/ SS)
 (setq SS (ssget))
 (if SS
 (command "Move" SS "" pause)
 (command "Move" "P" "" pause))
 );defun

(defun C:R (/ SS)
 (setq SS (ssget))
 (if SS
 (command "Rotate" SS "" pause)
 (command "Rotate" "P" "" pause))
 );defun

(defun C:SC (/ SS)
 (setq SS (ssget))
 (if SS
 (command "Scale" SS "" pause)
 (command "Scale" "P" "" pause))
 );defun

Thêm cho bạn 3 lệnh nữa luôn. gõ lệnh, nếu không chọn đối tuợng mà enter thêm nhát nữa thì đối tuợng đuợc chọn để xử lý là đối tuợng đuợc chọn để xử lý cua lenh truớc đó (previous selection - giống như khi bạn gõ C rồi gõ P ấy) have fun!

Về vấn đề bạn gặp fải. có lẽ bạn đã thêm 1 hoặc nhiều hàm nào đó ngay trước (setq SS (ssget)). trường hợp này toàn bộ đối tượng mà bạn chọn trước khi gõ lệnh sẽ bị xóa khỏi bộ nhớ tạm và bạn fải chọn lại.

để giải quyết vấn đề này bạn tham khảo code sau:

(defun S_ENT (dongnhac / ss)
(prompt dongnhac)
(if (null (setq ss (ssget "I")))
(setq ss (ssget)))
ss
)

@hoa35ktxd: thay đổi thiết lập của máy người khác là điều không nên làm 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
@hoa35ktxd: thay đổi thiết lập của máy người khác là điều không nên làm bạn ạ.

Đúng vậy, tôi cũng rất ghét những phần mềm can thiệp sâu vào hệ thống, đặc biệt là thay đổi thói quen người dùng mà sau đó không trả lại trạng thái cũ cho người ta.

Trong việc này tôi thấy việc thay đổi đó không phải là việc cố hữu, hết phiên làm việc ta lại trả về trạng thái cũ được mà.

Nếu viết Lisp để giải quyết vấn đề này thì ta lại phải làm với tất cả các lệnh có liên quan đến Select Object, như thế thì vất vả quá.

Nhưng không nhất thiết phải theo ý tôi vì đó chưa chắc đã phải là ý hay nhất, tùy thói quen từng người vậy.

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
Trước hết xin cám ơn các bác đã quan tâm giúp đỡ.

Sở dĩ em cần làm vậy vì trong các bản vẽ hiện trạng dung lượng rất lớn (có khi đến cả 500MB CAD) edit từng block là điều rất khó vì nó có vài trăm block; vài chục layer, mỗi thằng định dạng một kiểu, nên em muốn tất cả các đối tượng về một layer, màu: bylayer của đối tượng gốc chứ không phải của layer chứa block, được vậy thì cám ơn các bác lắm.

Gửi các bác một file mẫu:

Em Up mãi không được bác nào thương tình dowload giúp em ở đây, file chỉ 1,5MB thôi:

https://www.yousendit.com/download/aHlUQ1ZtcWY4NVh2Wmc9PQ

Chào bạn Ksor Phong,

Bạn dùng thử lisp này nhé, Lisp chỉ đổi tất cả các đối tượng về cùng lớp mà bạn lựa chọn chứ chưa đổi màu các đối tượng có màu không phải là bylayer. Bạn dùng thử nếu thấy cần bổ sung gì thì hãy post lên nhé. Chúc bạn vui.

(defun c:chla (/ ss ln col n i en els en1 els1 col1 )
(command "undo" "be")
(setq ln (getstring "\n Nhap ten layer dich: ")
       col (cdr (assoc 62 (tblsearch "layer" ln)))
       ss (ssget)
       n (sslength ss)
       i 0)
(while (       (setq  en (ssname ss i)
               els (entget en))
      (if (= (cdr (assoc 0 els)) "INSERT") 
          (if (= (cdr (assoc 66 els)) 1)
          (progn
          (setq en1 (entnext en)
                  els1 (entget en1))
          (while (/= (cdr (assoc 0 els1)) "SEQEND")
                   (if (/= (assoc 62 els1) nil)
                      (progn
                      (setq ln1 (cdr(assoc 8 els1))
                              col1 (cdr (assoc 62 (tblsearch "layer" ln1)))
                              els1 (subst (cons 62 col1) (assoc 62 els1) els1)
                      ) 
                      )
                   )
                   (setq els1 (subst (cons 8 ln) (assoc 8 els1) els1))
                   (entmod els1)
                   (entupd en1)
                   (setq en1 (entnext en1)
                           els1 (entget en1))
          )
          )
          )
      )
      (setq els (subst (cons 8 ln) (assoc 8 els) els))
      (entmod els)
      (setq i (1+ i))
)
(command "undo" "e")
(princ)
)

  • 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

Mọi người ơi cho tớ hỏi ko biết do lisp hay do máy tớ hay do tớ ko biết sử dụng mà lisp tính diện tích tớ ko dùng đc.No đã hướng dẫn tích vào vùng cần tính diện tích rồi mà sau khi mình enter ko hiện ra j cả.Có ai giải quyết đc vẫn đề này ko.Cám ơn mọi ngườ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ọi người ơi cho tớ hỏi ko biết do lisp hay do máy tớ hay do tớ ko biết sử dụng mà lisp tính diện tích tớ ko dùng đc.No đã hướng dẫn tích vào vùng cần tính diện tích rồi mà sau khi mình enter ko hiện ra j cả.Có ai giải quyết đc vẫn đề này ko.Cám ơn mọi người!

 

Bạn thử lisp tính diện tích này nhé:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun c:DDD(); 
(setvar "cmdecho" 0) 
(setvar "DIMZIN" 0) 
(if (= Ty_le nil) 
(progn 
(setq Ty_le (getreal "\\nNhËp Tû LÖ <1000>:")) 
(if (= Ty_le nil)(setq Ty_le 1000.00)) 
) 
(progn 
(setq khaibaoTy_le (getstring (strcat "\\nTû LÖ = " (rtos Ty_le 2 0) " Cã Muèn Thay §æi Kh«ng ,C:"))) 
(if (= (strlen khaibaoTy_le) 0) (setq khaibaoTy_le "K")) 
(if (or (= khaibaoTy_le "k") (= khaibaoTy_le "K")) 
(progn 
(princ (strcat "\\nTû LÖ = " (rtos Ty_le 2 0))) 
) 
(if (or (= khaibaoTy_le "c") (= khaibaoTy_le "C")) 
(progn 
(setq Ty_le (getreal "\\nNhËp Tû LÖ <1000>:")) 
(if (= Ty_le nil)(setq Ty_le 1000.00)) 
) 
)	
) 
) 
) 
(if (= So_Le nil) 
(progn 
(setq So_Le (getint "\\nNhËp Sè LÎ DiÖn TÝch <2>:")) 
(if (= So_Le nil)(setq So_Le 2)) 
) 
(progn 
(setq khaibaoSo_Le (getstring (strcat "\\nSè LÎ DiÖn TÝch = " (rtos So_Le 2 0) " Cã Muèn Thay §æi Kh«ng ,C:"))) 
(if (= (strlen khaibaoSo_Le) 0) (setq khaibaoSo_Le "K")) 
(if (or (= khaibaoSo_Le "k") (= khaibaoSo_Le "K")) 
(progn 
(princ (strcat "\\nSè LÎ DiÖn TÝch = " (rtos So_Le 2 0))) 
) 
(if (or (= khaibaoSo_Le "c") (= khaibaoSo_Le "C")) 
(progn 
(setq So_Le (getint "\\nNhËp Sè LÎ DiÖn TÝch <2>:")) 
(if (= So_Le nil)(setq So_Le 2)) 
) 
)	
) 
) 
) 
(setq He_so (/ 1000 Ty_le)) 
(setq He_so2 (* He_so He_so)) 
(setq dtl 0) 
(setq ss (ssadd)) 
(setq oslast (getvar "OSMODE")) 
(command "osnap" "") 
(print) 
(print) 
(setq pt1 (getpoint "\\nChon Vung Kin Tinh Dien Tich : ")) 
(while (/= pt1 nil) 
(command "-boundary" pt1 "") 
(setq et (entlast)) 
(ssadd et ss) 
(command "area" "e" "last") 
(setq vsize ( /(getvar "VIEWSIZE") 50 )) 
(command "hatch" "ANSI31" vsize "0" "last" "") 
(setq et (entlast)) 
(ssadd et ss) 
(setq dtcon (getvar "AREA")) 
(setq dtl (+ dtcon dtl)) 
(print) 
(print) 
(setq pt1 (getpoint "\\nChon Vung Kin Tinh Dien Tich : ")) 
) 
(command "setvar" "OSMODE" oslast) 
(command "erase" ss "") 
(setq ss nil) 
(command "redraw") 
(setq dtl (/ (/ dtl He_so2) 1)) 
(setq en (car (entsel "Thay cho so : "))) 
(while (= en nil) 
(setq en (car (entsel "Thay cho so : "))) 
) 
(setq elst (entget en)) 
(setq elstold (assoc 1 elst)) 
(setq elstnew (cons 1 (rtos dtl 2 So_Le))) 
(setq elst (subst elstnew elstold elst)) 
(entmod elst) 
(setq elst nil) 
(setq dtl nil) 
(command "_change" en "" "p" "c" "1" "") 
(princ "\\nhttp:\\\\doanduyhung.googlepages.com") 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Lisp này xuất kết quả dựa vào 1 text hiện có. Tiện đây mọi người sửa lại lisp trên giúp mình kết quả xuất sẽ là con số trên dòng command nếu nhấn enter hoặc trên text nếu chon text. 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
Sony chịu khó tìm kiếm 1 chút nhé :

Lisp đó đây : http://www.cadviet.com/forum/index.php?sho...15016&st=20

 

Theo đường link của bác, e tìm thấy cái bác viết rất hay là NBPL. Nhưng liệu chỉ cần chèn vertex thôi (không dùng Break sau đó Join lại) được k bác....Vì e đang sử dụng phần mềm, nó nhận dạng 1 đường pline, nếu mình break và joint lại thì nó sẽ k hiểu đối tượng này.

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
Theo đường link của bác, e tìm thấy cái bác viết rất hay là NBPL. Nhưng liệu chỉ cần chèn vertex thôi (không dùng Break sau đó Join lại) được k bác....Vì e đang sử dụng phần mềm, nó nhận dạng 1 đường pline, nếu mình break và joint lại thì nó sẽ k hiểu đối tượng này.

Tue_NV thật sự rất buồn khi bạn không đọc kỹ các bài viết ở đường Link mà Tue_NV đã đưa.

Chủ đề đó có 4 trang. Nó nằm ở trang thứ 2 chứ đâu???

Bạn không đọc kỹ lại còn post 2 bài viết ở 2 topic khác nhau. Vậy là vi phạm nội quy của diễn đàn.

Thiệt là buồn quá :D

  • 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
Tue_NV thật sự rất buồn khi bạn không đọc kỹ các bài viết ở đường Link mà Tue_NV đã đưa.

Chủ đề đó có 4 trang. Nó nằm ở trang thứ 2 chứ đâu???

Bạn không đọc kỹ lại còn post 2 bài viết ở 2 topic khác nhau. Vậy là vi phạm nội quy của diễn đàn.

Thiệt là buồn quá :D

đồng ý với ý kiến của bác, nhưng các lisp khác k hiểu sao tôi k chạy được, đường pline vẫn còn nguyên, k thêm được điểm nào. Ví dụ như:

như lisp ADV, hay là IV của Nacata, hay lisp addvertex.lsp cũng k chạy được . Chỉ có lisp của bác là chạy được, và e cũng đã lục hết cả 4 trang rồi. E đang sử dụng Cad2010

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 thử lisp tính diện tích này nhé:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun c:DDD(); 
(setvar "cmdecho" 0) 
(setvar "DIMZIN" 0) 
(if (= Ty_le nil) 
(progn 
(setq Ty_le (getreal "\\nNhËp Tû LÖ :")) 
(if (= Ty_le nil)(setq Ty_le 1000.00)) 
) 
(progn 
(setq khaibaoTy_le (getstring (strcat "\\nTû LÖ = " (rtos Ty_le 2 0) " Cã Muèn Thay §æi Kh«ng ,C:"))) 
(if (= (strlen khaibaoTy_le) 0) (setq khaibaoTy_le "K")) 
(if (or (= khaibaoTy_le "k") (= khaibaoTy_le "K")) 
(progn 
(princ (strcat "\\nTû LÖ = " (rtos Ty_le 2 0))) 
) 
(if (or (= khaibaoTy_le "c") (= khaibaoTy_le "C")) 
(progn 
(setq Ty_le (getreal "\\nNhËp Tû LÖ :")) 
(if (= Ty_le nil)(setq Ty_le 1000.00)) 
) 
)	
) 
) 
) 
(if (= So_Le nil) 
(progn 
(setq So_Le (getint "\\nNhËp Sè LÎ DiÖn TÝch :")) 
(if (= So_Le nil)(setq So_Le 2)) 
) 
(progn 
(setq khaibaoSo_Le (getstring (strcat "\\nSè LÎ DiÖn TÝch = " (rtos So_Le 2 0) " Cã Muèn Thay §æi Kh«ng ,C:"))) 
(if (= (strlen khaibaoSo_Le) 0) (setq khaibaoSo_Le "K")) 
(if (or (= khaibaoSo_Le "k") (= khaibaoSo_Le "K")) 
(progn 
(princ (strcat "\\nSè LÎ DiÖn TÝch = " (rtos So_Le 2 0))) 
) 
(if (or (= khaibaoSo_Le "c") (= khaibaoSo_Le "C")) 
(progn 
(setq So_Le (getint "\\nNhËp Sè LÎ DiÖn TÝch :")) 
(if (= So_Le nil)(setq So_Le 2)) 
) 
)	
) 
) 
) 
(setq He_so (/ 1000 Ty_le)) 
(setq He_so2 (* He_so He_so)) 
(setq dtl 0) 
(setq ss (ssadd)) 
(setq oslast (getvar "OSMODE")) 
(command "osnap" "") 
(print) 
(print) 
(setq pt1 (getpoint "\\nChon Vung Kin Tinh Dien Tich : ")) 
(while (/= pt1 nil) 
(command "-boundary" pt1 "") 
(setq et (entlast)) 
(ssadd et ss) 
(command "area" "e" "last") 
(setq vsize ( /(getvar "VIEWSIZE") 50 )) 
(command "hatch" "ANSI31" vsize "0" "last" "") 
(setq et (entlast)) 
(ssadd et ss) 
(setq dtcon (getvar "AREA")) 
(setq dtl (+ dtcon dtl)) 
(print) 
(print) 
(setq pt1 (getpoint "\\nChon Vung Kin Tinh Dien Tich : ")) 
) 
(command "setvar" "OSMODE" oslast) 
(command "erase" ss "") 
(setq ss nil) 
(command "redraw") 
(setq dtl (/ (/ dtl He_so2) 1)) 
(setq en (car (entsel "Thay cho so : "))) 
(while (= en nil) 
(setq en (car (entsel "Thay cho so : "))) 
) 
(setq elst (entget en)) 
(setq elstold (assoc 1 elst)) 
(setq elstnew (cons 1 (rtos dtl 2 So_Le))) 
(setq elst (subst elstnew elstold elst)) 
(entmod elst) 
(setq elst nil) 
(setq dtl nil) 
(command "_change" en "" "p" "c" "1" "") 
(princ "\\nhttp:\\\\doanduyhung.googlepages.com") 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Lisp này xuất kết quả dựa vào 1 text hiện có. Tiện đây mọi người sửa lại lisp trên giúp mình kết quả xuất sẽ là con số trên dòng command nếu nhấn enter hoặc trên text nếu chon text. Cám ơn.

Chào bạn ToTo08,

Mình chưa chạy thử lisp bạn gửi, song với yêu cầu bổ sung việc xuất kết quả của bạn mình nghĩ bạn có thể thử như sau:

1/- Thay đoạn code xuất kết quả:

(while (= en nil)

(setq en (car (entsel "Thay cho so : ")))

)

(setq elst (entget en))

(setq elstold (assoc 1 elst))

(setq elstnew (cons 1 (rtos dtl 2 So_Le)))

(setq elst (subst elstnew elstold elst))

(entmod elst)

(setq elst nil)

(setq dtl nil)

(command "_change" en "" "p" "c" "1" "")

(princ "\\nhttp:\\\\doanduyhung.googlepages.com")

bằng đoạn code sau:

(if (= en nil)

(princ '\n (rtos dtl 2 So_le)")

(progn

(setq elst (entget en))

(if (= (cdr(assoc 0 elst)) "TEXT")

(progn

(setq elstold (assoc 1 elst))

(setq elstnew (cons 1 (rtos dtl 2 So_Le)))

(setq elst (subst elstnew elstold elst))

(entmod elst)

(setq elst nil)

(setq dtl nil)

(command "_change" en "" "p" "c" "1" "")

(princ "\\nhttp:\\\\doanduyhung.googlepages.com"))

(princ '\n (rtos dtl 2 So_le)") )))

Trong đoạn lisp sửa ở trên mình có bổ sung thêm việc kiểm tra xem liệu đối tượng chọn có phải là text hay không, Nếu đúng thì sẽ thay bàng giá trị mới còn nếu không thì sẽ trả giá tri text mới ra dòng command.

Hy vọng trúng ý bạn. Chúc bạn vui.

2/- Mặc dù chưa chạy thử nhưng mình thấy cái lisp trên của bạn viết khá rườm rà và nhiều đoạn code có thể rút gọn được. Rất mong bạn kiểm tra lại để lisp đơn giản và dễ hiểu hơn.

Chúc bạn vui.

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

Mình chưa chạy thử lisp bạn gửi, song với yêu cầu bổ sung việc xuất kết quả của bạn mình nghĩ bạn có thể thử như sau:

1/- Thay đoạn code xuất kết quả:

Trong đoạn lisp sửa ở trên mình có bổ sung thêm việc kiểm tra xem liệu đối tượng chọn có phải là text hay không, Nếu đúng thì sẽ thay bàng giá trị mới còn nếu không thì sẽ trả giá tri text mới ra dòng command.

Hy vọng trúng ý bạn. Chúc bạn vui.

2/- Mặc dù chưa chạy thử nhưng mình thấy cái lisp trên của bạn viết khá rườm rà và nhiều đoạn code có thể rút gọn được. Rất mong bạn kiểm tra lại để lisp đơn giản và dễ hiểu hơn.

Chúc bạn vui.

 

Chào bạn phamthanhbinh, mình làm theo cách của bạn lúc load lisp báo lỗi ; error: extra right paren on input và kết quả xuất ra text không nhảy số. Bạn kiểm tra lại giúp mình. Đây là lisp mình sưu tầm được, mình thấy lisp rất hay nhưng chưa có nhiều thời gian để hoc lisp, 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
Chào bạn Ksor Phong,

Bạn dùng thử lisp này nhé, Lisp chỉ đổi tất cả các đối tượng về cùng lớp mà bạn lựa chọn chứ chưa đổi màu các đối tượng có màu không phải là bylayer. Bạn dùng thử nếu thấy cần bổ sung gì thì hãy post lên nhé. Chúc bạn vui.

(defun c:chla (/ ss ln col n i en els en1 els1 col1 )
(command "undo" "be")
(setq ln (getstring "\n Nhap ten layer dich: ")
       col (cdr (assoc 62 (tblsearch "layer" ln)))
       ss (ssget)
       n (sslength ss)
       i 0)
(while (< i n)
      (setq  en (ssname ss i)
               els (entget en))
      (if (= (cdr (assoc 0 els)) "INSERT") 
          (if (= (cdr (assoc 66 els)) 1)
          (progn
          (setq en1 (entnext en)
                  els1 (entget en1))
          (while (/= (cdr (assoc 0 els1)) "SEQEND")
                   (if (/= (assoc 62 els1) nil)
                      (progn
                      (setq ln1 (cdr(assoc 8 els1))
                              col1 (cdr (assoc 62 (tblsearch "layer" ln1)))
                              els1 (subst (cons 62 col1) (assoc 62 els1) els1)
                      ) 
                      )
                   )
                   (setq els1 (subst (cons 8 ln) (assoc 8 els1) els1))
                   (entmod els1)
                   (entupd en1)
                   (setq en1 (entnext en1)
                           els1 (entget en1))
          )
          )
          )
      )
      (setq els (subst (cons 8 ln) (assoc 8 els) els))
      (entmod els)
      (setq i (1+ i))
)
(command "undo" "e")
(princ)
)

Cám ơn sếp đã quan tâm giúp đỡ, tuy nhiên là cái Lsp này chưa ăn thua sếp à, các cái block trong block và màu trong block vẫn chưa điều khiển được, sếp nghĩ giúp em thêm tý nữa, tkssss

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.

×