Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

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

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

Tue_NV    3.841

Chào bác PhamThanhBinh và bạn Sony :

Bạn hãy thử đoạn Code này :

Đoạn code này kiểm tra điểm P có nằm trên P1P2 hay không. Vấn đề nội suy còn lại -> hy vọng Sony tự giải quyết được

(defun c:ktra(/ p p1 p2 dis)
 (command "ucs" "")
 (setq p1 (getpoint "\n Nhap diem P1 :"))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
 (command "ucs" "z" p1 p2)
 (setvar "orthomode" 1)
 (setq p1 (trans p1 0 1) p2 (trans p2 0 1)
dis (distance p1 p2)
 )
(While (setq p (getpoint p1 "\n Nhap diem P :"))
 (if (or (= (+ (distance p1 p) (distance p p2)) dis)
  (= (+ (distance p p1) dis) (distance p p2))
  (= (+ (distance p2 p) dis) (distance p p1))
     )
   (alert "\n P nam tren P1 P2")
   (alert "\n P khong nam tren P1 P2")
 )
 )
 (command "ucs" "P")
 (command "ucs" "P")
(princ)
)

 

Hề hề hề,

Chào bác TueNV,

Cái này mình quên thật nên cũng muốn nhắc bạn Sony2007 cần lưu ý khi ra đề bài cho chặt chẽ, vì không phải lúc nào các chế độ như trên đều mặc định. Vả lại mình thấy các bác trên diễn đàn có phép chọn điểm trên đối tượng gần nhất với điểm chọn nên mình muốn hỏi lại bạn sony2007 cho chắc để có thể tạo lisp cho những trường hợp điểm pick không nằm trên đối tượng bác ạ. Nếu chấp nhận việc lấy điểm trên đối tượng gần nhất với điểm chọn thì có thể làm lisp cho trường hợp tổng quát mà không lệ thuộc vào việc chọn điểm có chính xác hay không bác ạ.

Rất cám ơn bác vì đã nhắc nhở mình mấy cách cài đặt các chế độ màn hình của CAD.

Chúc bác luôn vui.

@Bác PhamThanhBinh :

Chế độ ortho, osmode nếu không ở chế độ mặc định thì ta làm cho nó theo ý của mình. Có thể là trong quá trình viết Lisp, hoặc là trong quá trình chạy Lisp, user cũng có thể thiết lập nó. Code trên là 1 ví dụ

Chúc bác luôn vui, khoẻ nữa. :cheers:

  • 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
romeo1982    19

Xin hỏi các cao thủ có cách nào nối 2 cung tròn thành đường tròn ko, ý mình muốn nói là nối 1 lượt vài ngàn cái cung tròn .Mong các cao thủ giúp đỡ

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    3.841
Xin hỏi các cao thủ có cách nào nối 2 cung tròn thành đường tròn ko, ý mình muốn nói là nối 1 lượt vài ngàn cái cung tròn .Mong các cao thủ giúp đỡ

2 cung tròn này có góc ở tâm bằng 180 độ phải không romeo? và "dính" với nhau tạo thành 1 đường tròn phải không?

Nếu không phải thì bạn upload file .dwg và nói rõ nhé

  • 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
romeo1982    19
2 cung tròn này có góc ở tâm bằng 180 độ phải không romeo? và "dính" với nhau tạo thành 1 đường tròn phải không?

Nếu không phải thì bạn upload file .dwg và nói rõ nhé

đúng bác ah,cám ơn bác đã quan tâ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
thaycung    0

Nhờ mọi người giúp cho một LISP vẽ các đường thẳng song song nhưng khoảng cách giữa các đường đó tăng dần hoặc giảm dần (ví dụ như các đường chải mái dốc). Xin được cảm ơn trước!

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    3.841
đúng bác ah,cám ơn bác đã quan tâm

@romeo : Nếu 2 cung tròn có góc ở tâm bằng 180 độ và "dính" với nhau tạo thành 1 đường tròn thì 1 cách đơn giản là sao bạn không sử dụng lệnh Pedit mà nối với nhau tạo thành 1 đường tròn "polyline"?

 

Nhờ mọi người giúp cho một LISP vẽ các đường thẳng song song nhưng khoảng cách giữa các đường đó tăng dần hoặc giảm dần (ví dụ như các đường chải mái dốc). Xin được cảm ơn trước!

@thaycung: khoảng cách giữa các đường song song tăng hoặc giảm theo quy luật nào? Bạn vui lòng nói rõ?

  • 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
romeo1982    19

@romeo : Nếu 2 cung tròn có góc ở tâm bằng 180 độ và "dính" với nhau tạo thành 1 đường tròn thì 1 cách đơn giản là sao bạn không sử dụng lệnh Pedit mà nối với nhau tạo thành 1 đường tròn "polyline"?

Vấn đề là mình đang dùng cái lip của bác gia_bạch:

 

(defun c:addLay (/ ent i j layname objci objpl pt_lst ss ssc)

;| By : Gia Bach, gia_bach @ www.CadViet.com |;

(vl-load-com)

 

(defun GetPtLst (obj / anginc arcparam blg delta eparam inc pt ptlst sparam)

(setq sparam (vlax-curve-getStartParam obj)

eparam (vlax-curve-getEndParam obj)

anginc (* pi (/ 6 180.0)))

(while (<= sparam eparam)

(setq pt (vlax-curve-getPointAtParam obj sparam))

(if (not (equal pt (car ptlst) 1e-12))

(setq ptlst (cons pt ptlst)))

(if (and (/= sparam eparam)

(setq blg (abs (vlax-invoke obj 'GetBulge sparam)))

(/= 0 blg))

(progn

(setq delta (* 4 (atan blg)) ;included angle

inc (/ 1.0 (1+ (fix (/ delta anginc))))

arcparam (+ sparam inc))

(while (< arcparam (1+ sparam))

(setq pt (vlax-curve-getPointAtParam obj arcparam)

ptlst (cons pt ptlst)

arcparam (+ inc arcparam)))) )

(setq sparam (1+ sparam)) )

ptlst)

;main

(princ "\nChon Pline : ")

(if (setq ss (ssget '((0 . "LWPOLYLINE"))))

(progn

(setq i -1)

(while (setq ent (ssname ss (setq i (1+ i))))

(setq objPL (vlax-ename->vla-object ent)

pt_lst (GetPtLst objPL)

ssC (ssget "_WP" pt_lst (list (cons 0 "CIRCLE"))) )

(if ssC

(progn

(setq num (sslength ssC))

(if (> num 255) (setq num (rem num 255)))

(setq layname (strcat "Layer_" (itoa num) "_Circle") j -1)

(or (tblsearch "Layer" layname) (vl-cmdf "-layer" "N" layname "c" num layname ""))

(vla-put-Layer objPL layname)

(while (setq ent (ssname ssC (setq j (1+ j))))

(setq objCi (vlax-ename->vla-object ent) )

(vla-put-Layer objCi layname) ) ) ))))

(princ))

 

Nó dò tìm trong các polyline khép kín, nếu trong po nào có 1,2,3... vòng tròn thì nó đưa về 1,2,3.... layẻ riêng. lisp xài rât tốt, nhưng có file cad không hiểu sao ko phải là vòng tròn nữa mà toàn bộ lại bị tách ra làm 2 cung bằng nhau hết nên mình mới xin lisp để nối nó lại vì có tới hàng ngàn cái như vậy, rất tiếc là lisp của bác gia bach chỉ tìm circle thôi chứ ko tìm được vòng tròn bằng po bạn ah, 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
thaycung    0
@thaycung: khoảng cách giữa các đường song song tăng hoặc giảm theo quy luật nào? Bạn vui lòng nói rõ?

Khoảng cách giữa các đường đó thể tăng giảm theo nhiều tỷ lệ khác nhau: 1.2 hoặc 1.5; 2; 2.3; 3, 4 ... lần (ví dụ: nếu theo tỷ lệ 1.5 thì: khoảng cách giữa đường thứ nhất và đường thứ 2 là 1 đơn vị, giữa đường thứ 2 và đường thứ 3 sẽ là 1.5 đơn vị, giữa đường thứ 3 và đường thứ 4 sẽ là 1*1.5*1.5=2.25 đơn vị...), và tôi có thêm một đề nghị nhỏ nữa là những đường song song này được rải nằm trong một miền kín có biên là một đường tròn hoặc đa giác nào đấy.

Cảm ơn Tue_NV và mọi người đã quan tâm tới câu hỏi của tô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
Sony2007    85
Chào bác PhamThanhBinh và bạn Sony :

Bạn hãy thử đoạn Code này :

Đoạn code này kiểm tra điểm P có nằm trên P1P2 hay không. Vấn đề nội suy còn lại -> hy vọng Sony tự giải quyết được

(defun c:ktra(/ p p1 p2 dis)
 (command "ucs" "")
 (setq p1 (getpoint "\n Nhap diem P1 :"))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
 (command "ucs" "z" p1 p2)
 (setvar "orthomode" 1)
 (setq p1 (trans p1 0 1) p2 (trans p2 0 1)
dis (distance p1 p2)
 )
(While (setq p (getpoint p1 "\n Nhap diem P :"))
 (if (or (= (+ (distance p1 p) (distance p p2)) dis)
  (= (+ (distance p p1) dis) (distance p p2))
  (= (+ (distance p2 p) dis) (distance p p1))
     )
   (alert "\n P nam tren P1 P2")
   (alert "\n P khong nam tren P1 P2")
 )
 )
 (command "ucs" "P")
 (command "ucs" "P")
(princ)
)

@Bác PhamThanhBinh :

Chế độ ortho, osmode nếu không ở chế độ mặc định thì ta làm cho nó theo ý của mình. Có thể là trong quá trình viết Lisp, hoặc là trong quá trình chạy Lisp, user cũng có thể thiết lập nó. Code trên là 1 ví dụ

Chúc bác luôn vui, khoẻ nữa. :D

 

 

 

Bác đã giúp thì giúp cho trọn đi bác. E k biết sử dụng ngôn ngữ lisp mà. Bác Tue_NV giúp đỡ e với. Cám ơn 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
bachngoctung    11

-Mình có một vấn đề này muốn hỏi các bạn. Nhờ mọi nguời viết cho một lisp để biến hình 1 thành hình 2 một cách nhanh chóng nhất. Với cấu trức lisp như sau:

1.jpg

+ Chọn đuờng thẳng chặt

+ Chọn các đuờng thằng muốn chặt

+ Kết quả cho đuợc ra như hình 2 ( mình thường làm thủ công bằng các break các đường thằng muốn chặt ra rồi sau đó move nó vào)

-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
romeo1982    19
-Mình có một vấn đề này muốn hỏi các bạn. Nhờ mọi nguời viết cho một lisp để biến hình 1 thành hình 2 một cách nhanh chóng nhất. Với cấu trức lisp như sau:

1.jpg

+ Chọn đuờng thẳng chặt

+ Chọn các đuờng thằng muốn chặt

+ Kết quả cho đuợc ra như hình 2 ( mình thường làm thủ công bằng các break các đường thằng muốn chặt ra rồi sau đó move nó vào)

-Cám ơn

bác vào chổ tìm kiếm, đánh vào 'lệnh bf' và từ từ mà thử nhé, nếu chưa vừa ý thì hãy nhờ mấy cao thủ giúp thêm cho

  • 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
romeo1982    19

@romeo : Nếu 2 cung tròn có góc ở tâm bằng 180 độ và "dính" với nhau tạo thành 1 đường tròn thì 1 cách đơn giản là sao bạn không sử dụng lệnh Pedit mà nối với nhau tạo thành 1 đường tròn "polyline"?

Vấn đề là mình đang dùng cái lip của bác gia_bạch:

 

Nó dò tìm trong các polyline khép kín, nếu trong po nào có 1,2,3... vòng tròn thì nó đưa về 1,2,3.... layẻ riêng. lisp xài rât tốt, nhưng có file cad không hiểu sao ko phải là vòng tròn nữa mà toàn bộ lại bị tách ra làm 2 cung bằng nhau hết nên mình mới xin lisp để nối nó lại vì có tới hàng ngàn cái như vậy, rất tiếc là lisp của bác gia bach chỉ tìm circle thôi chứ ko tìm được vòng tròn bằng po bạn ah, cám ơn

Bác TUE_NV ơi, sao lâu qué không thấy bác hồi âm, mong tin bác

  • 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
gia_bach    1.442
-Mình có một vấn đề này muốn hỏi các bạn. Nhờ mọi nguời viết cho một lisp để biến hình 1 thành hình 2 một cách nhanh chóng nhất. Với cấu trức lisp như sau:

1.jpg

+ Chọn đuờng thẳng chặt

+ Chọn các đuờng thằng muốn chặt

+ Kết quả cho đuợc ra như hình 2 ( mình thường làm thủ công bằng các break các đường thằng muốn chặt ra rồi sau đó move nó vào)

-Cám ơn

Bạn nên sử dụng chức năng tìm kiếm truớc khi post yêu cầu.

Đây là LISP đáp ứng yêu cầu của bạn : Cắt các đối tượng : lines, lwplines, plines, splines, ellipse, circles & arcs tại các giao điểm.

Link : http://www.cadviet.com/forum/index.php?showtopic=10514

  • 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    3.841
Bác đã giúp thì giúp cho trọn đi bác. E k biết sử dụng ngôn ngữ lisp mà. Bác Tue_NV giúp đỡ e với. Cám ơn bác nhiều

Sony hãy thử với đoạn code này.

Đây là Lisp nội suy cao độ Z của 1 điểm P khi biết P1(x1,y1,z1) và P2(x2,y2,z2) với z1 và z2 nhập từ bàn phím và điều kiện P phải nằm trên P1P2 (P có thể nằm trong hoặc nằm ngoài đoạn P1P2

(defun c:noisuy()
 (setq temperr *error*) 
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :"))
 (setq Z1 (getreal "\n Nhap cao do Z1 :"))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
 (setq Z2 (getreal "\n Nhap cao do Z2 :"))
 (setq dis (distance p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
 (command "snap" "R" p1 p2)
 (setvar "orthomode" 1)
(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
 (setq a (distance p p1))
 (if (or (equal (+ (distance p1 p) (distance p p2)) dis 0.000001)
  (equal (+ (distance p p1) dis) (distance p p2) 0.000001)
  (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
     )
   ;(alert "\n P nam tren P1 P2")
   (PROGN
(if (	    (if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001) 	     
	    	(progn (setq Z (+ Z1 (* tana (- a) ))) (in) )
    	(progn (setq Z (+ Z1 (* tana a))) (in))
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
    (if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001) 	     
	    	(progn (setq Z (+ Z2 (* tana (- a) ))) (in) )
    	(progn (setq Z (+ Z2 (* tana a))) (in) )
    )
)

    );PROGN
  (alert "\n P khong nam tren P1 P2")
);if
 );while
 (command "snap" "R" '(0 0 0) 0)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in()
(princ "\n gia tri noi suy tai diem P :") (princ Z)
)

romeo hãy thử với code này :

(defun c:acc(/ lis ss ent i tam)
 (setq ss (ssget '((0 . "ARC"))) i -1 lis '())
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (not (member (setq tam (cdr(assoc 10 (entget ent)))) lis))
     (progn
    	(command "circle" tam (cdr(assoc 40 (entget ent))))
       (setq lis (cons tam lis))
     )
   )
   (entdel ent)
 )
(princ)
)

  • 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
vietha209    1

http://www.cadviet.com/upfiles/2/dientich_chieudaisua.lsp

Nhờ mọi người sửa giúp mình file lisp này với, tính diện tích trong trường hợp giá trị chẵn nó không hiển thị 2 số thập phân như mong muốn (ví dụ 1 đáng lẽ là 1.00 thì nó lại thành 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    3.841
http://www.cadviet.com/upfiles/2/dientich_chieudaisua.lsp

Nhờ mọi người sửa giúp mình file lisp này với, tính diện tích trong trường hợp giá trị chẵn nó không hiển thị 2 số thập phân như mong muốn (ví dụ 1 đáng lẽ là 1.00 thì nó lại thành 1)

Bạn thêm vào dòng này (setvar "Dimzin" 0) sau dòng

(setvar "cmdecho" 0)

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

Nhờ các bạn một lisp như sau : Cũng như lệnh Overkill xoá các đối tượng nằm trùng lên nó. nhưng mình cần xoá hết cả đối tượng trùng nhau cả cũ lẫn mới. (trong một bản vẽ lisp sẽ xác định các đối tượng trùng nhau hoan toàn và xoá luôn hai đối tượng trùng nhau . không như lệnh Overkill mà mình nói như trê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
truongthanh    7
To truongthanh

Đây là bài toán nguợc rất khó, cho đến bây giờ tui chưa tìm đuợc huớng đi cho đuờng Pline.

 

Một đề nghị :

- Bạn nên đặt biến DIMASSOC=2 trước khi gọi lệnh Dim, sau đó nếu không cần Associate nữa thì gọi lệnh DIMDISASSOCIATE để tắt Associate sẽ dễ hơn.

ko biết có bác nào tìm ra giải pháp chưa vậy?giúp mình vớ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
leducthovn    1

Các bạn cho xin lsp in nhiều trang trong layout của cad 2005 trở lên,khung tên không phải là block nhé.cảm ơn nhiều.

email:leducthovn@yahoo.com

Giúp mình email nhé.Thanks!

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
Sony2007    85
Sony hãy thử với đoạn code này.

Đây là Lisp nội suy cao độ Z của 1 điểm P khi biết P1(x1,y1,z1) và P2(x2,y2,z2) với z1 và z2 nhập từ bàn phím và điều kiện P phải nằm trên P1P2 (P có thể nằm trong hoặc nằm ngoài đoạn P1P2

(defun c:noisuy()
 (setq temperr *error*) 
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :"))
 (setq Z1 (getreal "\n Nhap cao do Z1 :"))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
 (setq Z2 (getreal "\n Nhap cao do Z2 :"))
 (setq dis (distance p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
 (command "snap" "R" p1 p2)
 (setvar "orthomode" 1)
(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
 (setq a (distance p p1))
 (if (or (equal (+ (distance p1 p) (distance p p2)) dis 0.000001)
  (equal (+ (distance p p1) dis) (distance p p2) 0.000001)
  (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
     )
   ;(alert "\n P nam tren P1 P2")
   (PROGN
(if (< Z1 Z2)
    (if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001) 	     
	    	(progn (setq Z (+ Z1 (* tana (- a) ))) (in) )
    	(progn (setq Z (+ Z1 (* tana a))) (in))
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
    (if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001) 	     
	    	(progn (setq Z (+ Z2 (* tana (- a) ))) (in) )
    	(progn (setq Z (+ Z2 (* tana a))) (in) )
    )
)

    );PROGN
  (alert "\n P khong nam tren P1 P2")
);if
 );while
 (command "snap" "R" '(0 0 0) 0)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in()
(princ "\n gia tri noi suy tai diem P :") (princ Z)
)

romeo hãy thử với code này :

(defun c:acc(/ lis ss ent i tam)
 (setq ss (ssget '((0 . "ARC"))) i -1 lis '())
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (not (member (setq tam (cdr(assoc 10 (entget ent)))) lis))
     (progn
    	(command "circle" tam (cdr(assoc 40 (entget ent))))
       (setq lis (cons tam lis))
     )
   )
   (entdel ent)
 )
(princ)
)

 

 

 

Cám ơn bác nhiều nhiều, quá đúng ý e rùi. Mà k biết bác ở đâu khi nào rủ đi nhậu 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
tiazu    1

Tôi cần 1 LISP đổi tên block với yêu cầu sau:

- chạy LISP

- chọn block cần đổi tên

- nhập tên mới

 

(Trong AutoCAD đã có lệnh REN nhưng không cho mình chọn block muốn đổi tên, mà phải tìm tên của nó trước rồi mới vô đó tìm trong 1 đống tên :cheers:, đối với file có nhiều block tên dạng như A$12345678 thì :blink:bó tay ).

 

Tôi cũng có viết 1 VBA tương tự (nhưng nó load vô phức tạp hơn lisp) nên muốn nhờ cao thủ chuyển sang LISP dùm. Với lại CAD sau này ko tích hợp sẵn VBA như trước nữa mà phải tự cài thêm nên muốn chuyển cho máy khác cũng hơi phê. Thêm phần FORM cho nó nữa thì càng tốt :cheers:. (Mới tập tành viết VBA nên có nhiều lỗi nhưng đc cái thực hiện đúng ý đồ của mình, mong chỉ giáo :D)

Sub DoiTenBlock()
On Error Resume Next
Dim a As String
Dim Doituong As AcadObject
Dim ChonBlock As AcadBlock
Dim Toado As Variant
ThisDrawing.Utility.Prompt ("Doi ten block...")
ThisDrawing.Utility.GetEntity Doituong, Toado, vbCrLf & vbCrLf & "Chon doi tuong: "
Do While Doituong.ObjectName <> "AcDbBlockReference"
On Error GoTo Thoat
ThisDrawing.Utility.GetEntity Doituong, Toado, vbCrLf & "Doi tuong khong phai block. Chon lai doi tuong: "
Loop
a = Doituong.Name
Set ChonBlock = ThisDrawing.Blocks.Item(a)
a = ThisDrawing.Utility.GetString(1, vbCrLf & "Nhap ten moi: ")
ChonBlock.Name = a
ThisDrawing.Utility.Prompt "Block da duoc doi ten thanh: " & a
Thoat:
End Sub

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
Thaistreetz    515
Tôi cần 1 LISP đổi tên block với yêu cầu sau:

- chạy LISP

- chọn block cần đổi tên

- nhập tên mới

 

(defun c:RB (/ SS NAME NNAME)
 (setq SS (ssget "I"))
 (if (not SS)
(progn
  (prompt "- Select block for rename")
  (setq SS (ssget '((0 . "insert"))))
  );progn
);if
(setq NAME (cdr (assoc 2 (entget (ssname SS 0)))))
(setq NNAME(getstring (strcat "\nCurrent block name: " NAME "\nEnter new name:")))
(command "-rename" "B" NAME NNAME)
 (princ)
 );end

Nếu cần ngay thì bạn dùng tạm code này. mình không có thời gian làm hộp thoại cho bạn.

  • 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
tiazu    1
Nếu cần ngay thì bạn dùng tạm code này. mình không có thời gian làm hộp thoại cho bạn.

 

Cám ơn rất nhiều.

Nhưng có 1 cái tôi cần bạn cải tiến dùm (ko phải đc voi đòi tiên đâu nhe, do mình ko biết LISP :cheers: ) : code bạn đưa không thể đặt tên block có khoảng trắng đc :cheers: , đôi lúc block cần có khoảng trắng nữa (trong code VBA của mình thì đc).

 

Cám ơn lần nữa :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
Tue_NV    3.841
Cám ơn rất nhiều.

Nhưng có 1 cái tôi cần bạn cải tiến dùm (ko phải đc voi đòi tiên đâu nhe, do mình ko biết LISP :cheers: ) : code bạn đưa không thể đặt tên block có khoảng trắng đc :cheers: , đôi lúc block cần có khoảng trắng nữa (trong code VBA của mình thì đc).

 

Cám ơn lần nữa :D

Bạn thay dòng này :

(setq NNAME(getstring (strcat "\nCurrent block name: " NAME "\nEnter new name:")))

bằng dòng này :

(setq NNAME(getstring t (strcat "\nCurrent block name: " NAME "\nEnter new name:")))

Đã đặt tên Block có khoảng trăng rồi đấy nhé

  • 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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×