Viết Lisp theo yêu cầu

[nguyenkhoadung98 2]

Dùng MText với lisp thì ko nên vì kết quả nhiều khi ko theo ý muốn (như thế này chẳng hạn {\f.VnArialH|b0|i0|c0|p34;T\f.VnArial|b0|i0|c0|p34;B1-L1/13A} )

Bạn có thể dùng lisp với Dtext kết hợp với lệnh convert Dtext sang Mtext (txt2mtxt)

thanks snowmen rất nhiều !!! các bạn cho hỏi thêm là : bây h công việc của mình cần dùng nhiều đến2 lệnh offset (O) và ME và thường phải dùng cùng nhau. Ví dụ như khi mình OFFSET 1 đường thằng thì sau đó là phải ME 1 block lên trên đường vừa OFFSET xong, vậy liệu có lisp nào cho phép kết hợp 2 lệnh trên trong 1 lệnh kô ( tạm gọi là lệnh OM).vừa OFFSET và ME 1 block lên đường vừa OFFSET, rất cảm ơn các bạn

[romeo1982 19]

Bạn có thể post yêu cầu về autolisp ở topic này.

Bác Hoành ơi em cần 1 cái líp như thế này: khi copy hoặc offset,array thì vật tạo mới được gán layer hiện hành, cám ơn bác

[nguyenkhoadung98 2]

Bác Hoành ơi em cần 1 cái líp như thế này: khi copy hoặc offset,array thì vật tạo mới được gán layer hiện hành, cám ơn bác

ở đấy có rồi này

(defun C:ol ( / ent os od )

 

(command "_offset" pause "")

 

(princ "Select object to offset or <Exit>:")

(setq ent(entsel))

 

(while ent

(setq os(getpoint "\nSpecify point on side to offset:"))

(if(=(getvar "OFFSETDIST")-1)

(setq od "t")

(setq od (getvar "OFFSETDIST"))

)

(command "_offset" od (car ent) os "")

(command "_change" (entlast) "" "p" "la" (getvar "clayer") "c" (getvar "cecolor") "lt" (getvar "celtype") "")

(setq ent(entsel))

)

 

)

[hoanghuy 2]

Bác Hoanh giúp mình cách đổi tên block bằng mã lisp được không? Cảm ơn bác nhiều.

[nguyenkhoadung98 2]

snowman cho mình hỏi thêm là cái lisp bạn cho mình để đánh số cột đèn dung rất tốt,mình muốn hỏi thêm là bạn có thể cải tiến nó để sao cho khi mình sửa 1 1 cái ví dụ sửa cái T1-L1/1A thành T1-L1/T4 thì nhữg cái còn lại như T1-L1/2A,T1-L1/3A,T1-L1/4A,T1-L1/5A.....tự sửa thành T1-L1/5A,T1-L1/6A,T1-L1/7A,T1-L1/8A,T1-L1/9A,T1-L1/10A....,nếu đòi hỏi quá đáng mong bạn bỏ wa :leluoi:

[Snowman 92]

snowman cho mình hỏi thêm là cái lisp bạn cho mình để đánh số cột đèn dung rất tốt,mình muốn hỏi thêm là bạn có thể cải tiến nó để sao cho khi mình sửa 1 1 cái ví dụ sửa cái T1-L1/1A thành T1-L1/T4 thì nhữg cái còn lại như T1-L1/2A,T1-L1/3A,T1-L1/4A,T1-L1/5A.....tự sửa thành T1-L1/5A,T1-L1/6A,T1-L1/7A,T1-L1/8A,T1-L1/9A,T1-L1/10A....,nếu đòi hỏi quá đáng mong bạn bỏ wa :leluoi:

Yêu cầu của bạn có thể đáp ứng được nhưng đòi hỏi trình độ... ISO cao, cần fải có thời gian để viết một "soft" nho nhỏ mới dáp dứng đầy đủ được.

Tôi chỉ có đoạn code đánh số tăng dần trong đó số nằm giữa một text, giữ nguyên x ký tự phía trước và y ký tự phía sau.

Lệnh CIT, bạn hãy làm theo thông báo từ dòng lệnh, chú ý đếm chính xác số ký tự cần giữ lại fía trước và sau text.

Chọn các text tiếp theo để điền số mới (ko thể chọn hàng loạt được)

;;;====================================================================
=====
(defun bocchu (ss1 c)
 (setq ob (entget (ssname ss1 c)))
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)
(defun Txtnum (num)
 (if (> num 0)
   (strcat "+" (rtos num 2 0))
   (rtos num 2 0)
 )
)
;;;=================================
(defun Txtint (num)
 (rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr)
 (setq txtstr (assoc 1 Ob))
 (setq newstr (cons 1 newstr))
 (entmod (subst newstr txtstr Ob))
)
(defun chonchu (dongnhac)
 (prompt dongnhac)
 (ssget
   '((-4 . "<OR") (0 . "text") (0 . "mtext") (-4 . "OR>"))
 )
)

(defun chon1chu	(dongnhac / obj objtype)
 (if (setq obj (nentsel dongnhac))
   (setq obj (entget (car obj))
  objtype (cdr (assoc 0 obj))
  )
   )
 (if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
   (setq obj obj)
   )
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))

(defun boc1chu (ob)
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)


;;;=============================================================================
====================
(defun c:cit (/ sstxt)
 (command "undo" "mark")

 (if (= Ostr nil)
   (setq Ostr "\nNhap So thu tu bat dau <>...: "
   )
 )
 (if (= nil
 (setq Numkey
	(getint
	  "\nNhap so ky tu phia truoc can giu lai: <enter for 0> "
	)
 )
     )
   (setq Numkey 0)
 )
 (if (= nil
 (setq Numkey1
	(getint
	  "\nNhap so ky tu phia sau can giu lai: <enter for 0> "
	)
 )
     )
   (setq Numkey1 0)
 )
 (while (/= (setq ss1 (chon1chu "\nChon 1 text can thay doi so thu tu ..."))
     nil
 )
   (progn
     (setq sstxt   (boc1chu ss1)
    Oldftxt (substr sstxt 1 Numkey)
    Oldetxt (substr sstxt (1+ (- (strlen sstxt) Numkey1)))

     )				
     (if (/= (setq num2 (getint Ostr)) nil)
(setq
  numadd num2
  Ostr	 (strcat "\nNhap so thu tu bat dau <"
		 (rtos (1+ numadd) 2 0)
		 "> : "
	 )
)
(setq numadd (1+ numadd)
      Ostr   (strcat "\nNhap so thu tu bat dau <"
		     (rtos (1+ numadd) 2 0)
		     "> : "
	     )
)
     )
     (setq num numadd)

     (setq st (txtint num))

     (thaychu ss1 (strcat oldftxt st oldetxt))
     (princ)
   )
 )
)
;;;============================================

[nguyenkhoadung98 2]

Yêu cầu của bạn có thể đáp ứng được nhưng đòi hỏi trình độ... ISO cao, cần fải có thời gian để viết một "soft" nho nhỏ mới dáp dứng đầy đủ được.

Tôi chỉ có đoạn code đánh số tăng dần trong đó số nằm giữa một text, giữ nguyên x ký tự phía trước và y ký tự phía sau.

Lệnh CIT, bạn hãy làm theo thông báo từ dòng lệnh, chú ý đếm chính xác số ký tự cần giữ lại fía trước và sau text.

Chọn các text tiếp theo để điền số mới (ko thể chọn hàng loạt được)

;;;====================================================================
=====
(defun bocchu (ss1 c)
 (setq ob (entget (ssname ss1 c)))
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)
(defun Txtnum (num)
 (if (> num 0)
   (strcat "+" (rtos num 2 0))
   (rtos num 2 0)
 )
)
;;;=================================
(defun Txtint (num)
 (rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr)
 (setq txtstr (assoc 1 Ob))
 (setq newstr (cons 1 newstr))
 (entmod (subst newstr txtstr Ob))
)
(defun chonchu (dongnhac)
 (prompt dongnhac)
 (ssget
   '((-4 . "<OR") (0 . "text") (0 . "mtext") (-4 . "OR>"))
 )
)

(defun chon1chu	(dongnhac / obj objtype)
 (if (setq obj (nentsel dongnhac))
   (setq obj (entget (car obj))
  objtype (cdr (assoc 0 obj))
  )
   )
 (if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
   (setq obj obj)
   )
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))

(defun boc1chu (ob)
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)


;;;=============================================================================
====================
(defun c:cit (/ sstxt)
 (command "undo" "mark")

 (if (= Ostr nil)
   (setq Ostr "\nNhap So thu tu bat dau <>...: "
   )
 )
 (if (= nil
 (setq Numkey
	(getint
	  "\nNhap so ky tu phia truoc can giu lai: <enter for 0> "
	)
 )
     )
   (setq Numkey 0)
 )
 (if (= nil
 (setq Numkey1
	(getint
	  "\nNhap so ky tu phia sau can giu lai: <enter for 0> "
	)
 )
     )
   (setq Numkey1 0)
 )
 (while (/= (setq ss1 (chon1chu "\nChon 1 text can thay doi so thu tu ..."))
     nil
 )
   (progn
     (setq sstxt   (boc1chu ss1)
    Oldftxt (substr sstxt 1 Numkey)
    Oldetxt (substr sstxt (1+ (- (strlen sstxt) Numkey1)))

     )				
     (if (/= (setq num2 (getint Ostr)) nil)
(setq
  numadd num2
  Ostr	 (strcat "\nNhap so thu tu bat dau <"
		 (rtos (1+ numadd) 2 0)
		 "> : "
	 )
)
(setq numadd (1+ numadd)
      Ostr   (strcat "\nNhap so thu tu bat dau <"
		     (rtos (1+ numadd) 2 0)
		     "> : "
	     )
)
     )
     (setq num numadd)

     (setq st (txtint num))

     (thaychu ss1 (strcat oldftxt st oldetxt))
     (princ)
   )
 )
)
;;;============================================

thanks kiu snowmen

[connaivang 1]

Bác Hoành hay bác nào đó trên diễn đàn giúp em việc này với. Em đang rất cần mà. Cảm ơn các bác nhiều.

 

 

Bác Hoành và các bác khác trên diễn đàn ơi. Sao không có ai quan tâm đến em vậy. Thật là buồn quá!!!

Có ai giúp em với!!!

[MANHHUNGXDA 458]

Bác Hoành và các bác khác trên diễn đàn ơi. Sao không có ai quan tâm đến em vậy. Thật là buồn quá!!!

Có ai giúp em với!!!

Bài viết của bạn nó tản mạn quá

Bạn có thể nói lại yêu cầu của bạn

Mình sẽ giúp!

[connaivang 1]

Chào bác Nguyễn Hoành.

Rất cảm ơn bác về sự giúp đỡ nhiệt tình của bác. Như người ta vẫn bảo "được voi đòi tiên". Không biết bác có nghĩ như vậy và có cảm thấy khó chịu không nếu em có thêm một yêu cầu giúp đỡ như thế này.

Cái lệnh TCHU của bác em dùng đã cảm thấy rất tốt. Nhưng lệnh này em dùng khá thường xuyên. Em muốn cắt giảm một số thao tác của nó cho phù hợp với công việc của mình nhưng lại không biết chỉnh sửa ở đâu. Em muốn bác sửa lại lệnh trên thành một autolisp nhỏ với những thay đổi như sau:

Lệnh t1 tương tự như lệnh trên nhưng mặc định ở dòng T/S là viết thêm text ở phía trước dòng text.

Lênh t2 tương tự như lệnh t1, chỉ khác là ta chỉ cần insert thêm một kí tự duy nhất vào phía trước dòng text (Có nghĩa là sau khi nhập một kí tự,ta gõ space sẽ tương đương gõ enter)

Bác cố gắng giúp đỡ kẻ ngu muội này nhé.

Xin cảm ơn bác trước.

 

Cảm ơn bác MANHHUNG đã có ý muốn giúp đỡ. Yêu cầu của em đã được nêu ra khá lâu, xin được trích lại. nếu có gì chưa rõ nghĩa, xin được bác chỉ giáo.

Cảm ơn bác rất, rất nhiều.

[Nguyen Hoanh 4.663]

Cảm ơn bác MANHHUNG đã có ý muốn giúp đỡ. Yêu cầu của em đã được nêu ra khá lâu, xin được trích lại. nếu có gì chưa rõ nghĩa, xin được bác chỉ giáo.

Cảm ơn bác rất, rất nhiều.

Lệnh T1 và T2 của bạn đây:

(defun c:t1() (Themchu t))
(defun c:t2() (Themchu nil))

(defun Themchu (enter / ss truoc chuthem)
 (defun them1 (ent / tt old1 new1 gt)
   (setq
     tt   (entget ent)
     old1 (assoc 1 tt)
     gt   (cdr old1)
     gt   (cond
     (truoc (strcat chuthem gt))
     (t (strcat gt chuthem))
   )

     new1
   (cons 1 gt)
     tt
   (subst new1 old1 tt)
   )
   (entmod tt)
   (entupd ent)
 )
 (setq	ss	(ssget '((0 . "TEXT")))
truoc   t
chuthem	(getstring enter "\nChu them: ")
 )
 (sudung them1 ss)
 (princ)
)

(defun sudung (ham ss / sodt index entdt soapp)
 (setq	sodt  (cond
	(ss (sslength ss))
	(t 0)
      )
soapp 0
index 0
 )
 (repeat sodt
   (setq entdt	(ssname ss index)
  index	(1+ index)
   )
   (if	(ham entdt)
     (setq soapp (1+ soapp))
   )
 )
 soapp
)

[connaivang 1]

Cảm ơn sự giúp đỡ nhiệt tình của bác. Em sẽ thử hai lệnh này ngay bây giờ.

[connaivang 1]

Lệnh T1 và T2 của bạn đây:

 

Em thực hiện được rồi. Nó rất có ích cho công việc của em. Em không biết nói gì hơn, chỉ biết cảm ơn bác rất nhiều.

[smilingman82 2]

nhờ các bác PRO 1 tí nhá ,,, mình cần 1 lisp xuất ra toạ độ các đỉnh của 1 đường poline >>xuất ra tệp *.txt.....trình tự thế này:

- Chọn đuờng Poliline (có thể là line , poligonal thì càng tốt...)

- Líp sẽ tự động xuất ra toạ độ các đỉnh của đường Poliline dưới dạng tệp TXT ( Ví dụ tệp TXT có dạng:

12,5,6

13,2,7

trong đó 12;13là toạ độ X - 5;2 là toạ độ Y - 6;7 là toạ độ Z; toạ độ so với Gốc 0,0,0)

Cám ơn các bác

[nguyenkhoadung98 2]

bác Hoang có thể cho e xin cái lisp dùng phim tắt (phím tab cha han) để chuyển các cửa sổ của cad đc kô,đỡ phải ấn vào window rồi chọn bản mình muốn xem, cảm ơn bác nhiều

[Snowman 92]

nhờ các bác PRO 1 tí nhá ,,, mình cần 1 lisp xuất ra toạ độ các đỉnh của 1 đường poline >>xuất ra tệp *.txt.....trình tự thế này:

- Chọn đuờng Poliline (có thể là line , poligonal thì càng tốt...)

- Líp sẽ tự động xuất ra toạ độ các đỉnh của đường Poliline dưới dạng tệp TXT ( Ví dụ tệp TXT có dạng:

12,5,6

13,2,7

trong đó 12;13là toạ độ X - 5;2 là toạ độ Y - 6;7 là toạ độ Z; toạ độ so với Gốc 0,0,0)

Cám ơn các bác

Bạn có thể tham khảo ở đây:

http://www.cadviet.com/forum/index.php?sho...ost&p=32849

 

 

bác Hoang có thể cho e xin cái lisp dùng phim tắt (phím tab cha han) để chuyển các cửa sổ của cad đc kô,đỡ phải ấn vào window rồi chọn bản mình muốn xem, cảm ơn bác nhiều

 

Bạn hãy dùng tổ hợp Ctrl + Tab để di chuyển xoay vòng các bản vẽ CAD đang mở (giống như Alt+Tab để xoay vòng các Windows)

[nguyenkhoadung98 2]

Bạn có thể tham khảo ở đây:

http://www.cadviet.com/forum/index.php?sho...ost&p=32849

 

 

 

 

Bạn hãy dùng tổ hợp Ctrl + Tab để di chuyển xoay vòng các bản vẽ CAD đang mở (giống như Alt+Tab để xoay vòng các Windows)

minh lam dc roi (ga qua) thanks snow mwn nhé

[leduc829 1]

Trong Cad bạn gõ lệnh LIST chọn đường Pline. Copy các điểm toạ độ. VD:

at point X= 0.0000 Y= 10.3635 Z= 0.0000

at point X= 3.3371 Y= 12.5480 Z= 0.0000

at point X= 6.0988 Y= 10.4210 Z= 0.0000

at point X= 10.2988 Y= 14.7900 Z= 0.0000

at point X= 11.3920 Y= 14.7900 Z= 0.0000

at point X= 16.0524 Y= 13.0654 Z= 0.0000

at point X= 20.0223 Y= 14.1576 Z= 0.0000

at point X= 20.8854 Y= 15.9397 Z= 0.0000

at point X= 24.3375 Y= 14.7325 Z= 0.0000

at point X= 25.3731 Y= 14.3301 Z= 0.0000

at point X= 26.3512 Y= 12.2031 Z= 0.0000

at point X= 28.7102 Y= 10.8234 Z= 0.0000

at point X= 28.7102 Y= 9.7311 Z= 0.0000

at point X= 33.4281 Y= 11.3983 Z= 0.0000

Dán sang Excel dùng hàm MID trong excel để xử lý. =mid(a1,23,9) để tính toạ độ X, =mid(a1,36,9) để tính tọa độ Y

[romeo1982 19]

ở đấy có rồi này

(defun C:ol ( / ent os od )

 

(command "_offset" pause "")

 

(princ "Select object to offset or <Exit>:")

(setq ent(entsel))

 

(while ent

(setq os(getpoint "\nSpecify point on side to offset:"))

(if(=(getvar "OFFSETDIST")-1)

(setq od "t")

(setq od (getvar "OFFSETDIST"))

)

(command "_offset" od (car ent) os "")

(command "_change" (entlast) "" "p" "la" (getvar "clayer") "c" (getvar "cecolor") "lt" (getvar "celtype") "")

(setq ent(entsel))

)

 

)

Cám ơn bác, líp rất hay giúp ích cho mình rất nhiều, mình còn 1nhờ 1 tí như thế này, trên bản vẽ của mình nhận được có 1 layer nhưng vẽ rất nhiều đường thẳng lại tách ra làm 2 màu, có lip nào chuyển mỗi 1 màu thành 1 layer cho tiện việc sử lí ko bác, nhưng bác phải chú ý thế này trên bảng vẽ còn nhiều layer khác và có thể giống màu với nhau. Tốt nhất là lip sử dụng như thế này:

1 nhập lệnh

2 chọn vật có layer và màu muốn chuyển( ví dụ: layer được tách làm 2 màu là đỏ và trắng)ở đây mình sẽ chọn vật có layer màu đỏ

4 nhập tên layer mới mà mình muốn tạo ( vậy là tách tất cà vật có cùng layẻ đó nhưng màu đỏ ra thành 1 layẻ mới mà mình mới tạo), cám ơn trước

[vt_td 0]

Nhờ bác Hoành viết dùm lisp như sau:

Lập một lưới ô vuông vơi n hàng và m cột trong đó.

Nhập vào toạ độ điểm chuẩn hay chọn trên màn hình.

Nhập vào n và m.

Nhập khoảng cách của của hàng và khaỏng cách của cột.

Dùng bằng tay copy lâu quá. Bác Hoành giúp dùm nhé.

[Nguyen Hoanh 4.663]

Nhờ bác Hoành viết dùm lisp như sau:

Lập một lưới ô vuông vơi n hàng và m cột trong đó.

Nhập vào toạ độ điểm chuẩn hay chọn trên màn hình.

Nhập vào n và m.

Nhập khoảng cách của của hàng và khaỏng cách của cột.

Dùng bằng tay copy lâu quá. Bác Hoành giúp dùm nhé.

Ôi trời, cái dễ và nhanh như vậy mà bạn cũng cần lisp.

Bạn tưởng viết lisp nhanh sao.

[Flex 22]

Cái này bác dùng lênh array đi cho lành. Lười quá. Còn muốn làm thì alô em tính phí cho hi hi hi.

[romeo1982 19]

Bạn có thể post yêu cầu về autolisp ở topic này.

Xin lỗi, mình pót lộn ngoài kia. Nhờ bác Hoành viết dùm em cái líp như thế này đang cần gấp:

Trên bản vẽ của mình nhận được có 1 layer nhưng vẽ rất nhiều đối tượng lại tách ra làm 2 màu, có lip nào chuyển mỗi 1 màu thành 1 layer cho tiện việc sử lí ko bác, nhưng bác phải chú ý thế này trên bảng vẽ còn nhiều layer khác và có thể giống màu với nhau. Tốt nhất là lip sử dụng như thế này:

1 nhập lệnh

2 chọn đối tượng có layer và màu muốn chuyển( ví dụ: layer được tách làm 2 màu là đỏ và trắng)ở đây mình sẽ chọn đối tượng có layer màu đỏ

3 nhập tên layer mới mà mình muốn tạo ( vậy là tách tất cà các đối tượng có cùng layẻ đó nhưng màu đỏ ra thành 1 layẻ mới mà mình mới tạo), mình đang cần gấp cám ơn.

[Nguyen Hoanh 4.663]

Xin lỗi, mình pót lộn ngoài kia. Nhờ bác Hoành viết dùm em cái líp như thế này đang cần gấp:

Trên bản vẽ của mình nhận được có 1 layer nhưng vẽ rất nhiều đối tượng lại tách ra làm 2 màu, có lip nào chuyển mỗi 1 màu thành 1 layer cho tiện việc sử lí ko bác, nhưng bác phải chú ý thế này trên bảng vẽ còn nhiều layer khác và có thể giống màu với nhau. Tốt nhất là lip sử dụng như thế này:

1 nhập lệnh

2 chọn đối tượng có layer và màu muốn chuyển( ví dụ: layer được tách làm 2 màu là đỏ và trắng)ở đây mình sẽ chọn đối tượng có layer màu đỏ

3 nhập tên layer mới mà mình muốn tạo ( vậy là tách tất cà các đối tượng có cùng layẻ đó nhưng màu đỏ ra thành 1 layẻ mới mà mình mới tạo), mình đang cần gấp cám ơn.

1. Bạn dùng lệnh filter để chọn đối tượng có màu mình muốn.

2. Bạn đổi các đối tượng được chọn sang layer mà bạn muốn.

[romeo1982 19]

1. Bạn dùng lệnh filter để chọn đối tượng có màu mình muốn.

2. Bạn đổi các đối tượng được chọn sang layer mà bạn muốn.

Cám ơn anh đã quan tâm, xài lệnh FI thì đưa cùng một màu về layer nhưng nếu muốn xóa thì sao nó sẽ dính theo những màu đi chung nhưng khác layer mà mình đã chọn theo lệnh FI ban đầu. Ý em là như vầy anh xem bản vẽ minh họa:

http://www.cadviet.com/upfiles/g7901i_CADVIET.dwg