- page 326

Info

File

Tác giả: Nguyen Hoanh
Bài viết gốc: 462597
Tên lệnh: thayattr

Lisp thay đổi giá trị mặc định của Atribuite

Mình đã viết lisp cho bạn như bên dưới.

Cách dùng:

1- Download file lisp về

2- Mở file lisp, Sửa chữ chỗ ("DESC3"."S"..... theo nguyên tắc: Phía bên trái dấu chấm là tên tag, phía bên phải dấu chấm là giá trị default value. Mỗi dòng là 1 lần thay. Lưu lại.

3- Add file lisp này vào mục chạy tự động, bằng lệnh Appload > Contents > Add

4- Dùng...

Mình đã viết lisp cho bạn như bên dưới.

Cách dùng:

1- Download file lisp về

3- Add file lisp này vào mục chạy tự động, bằng lệnh Appload > Contents > Add

4- Dùng một chức năng nào đó để mở 3500 file của bạn, mỗi lần file được mở lên, lisp sẽ tự động chạy, sửa, lưu lại và tự động close bản vẽ.

Sau khi dùng xong, thì xóa hoặc rename file lisp thành tên khác, rồi remove file lisp ra khỏi việc chạy tự động.

(setq
  cv:thay '(
	 ("DESC3" . "S")
	 ("DESC1" . "XY")
	)
)

(defun c:thayattr( / dt ss ent tt find repl)
(foreach dt cv:thay
  (setq ss (ssget "X" (list (cons 0 "ATTDEF") (cons 2 (car dt)))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq tt (entget ent)
	  find (assoc 1 tt)
	  repl (cons 1 (cdr dt))
	  tt (if find
	       (subst repl find tt)
	       (cons repl find)
	     )
     )
     (entmod tt)
  )
)
  (command ".qsave" "y")
  (command ".close")
)
(c:thayattr)

Download lisp

Filename: 462597_thayattr.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 102764
Tên lệnh: ssx

Em xin hỏi các anh về lệnh ssx

Câu 1: Theo em được biết là có lệnh SSX trong lisp để chỉnh sửa các đối tượng giống nhau về cùng 1 kiểu(gõ lệnh p để chọn lại đối tượng mình muốn chỉnh sửa...
>>
Câu 1: Theo em được biết là có lệnh SSX trong lisp để chỉnh sửa các đối tượng giống nhau về cùng 1 kiểu(gõ lệnh p để chọn lại đối tượng mình muốn chỉnh sửa theo).các anh có thể chỉ chi tiết giùm em ko ạ.
Câu 2: em có 1 block mà em muốn đưa block đó chạy dọc theo 1 đường L hoặc Pl hoặc SPl với 1 khoảng cách cố định với đường và các block với nhau.nhưng các blog này đều vuông góc với đường mốc. E nên làm thế nào ạ?

Chào bạn 47c1,

Câu 1: Trong các lệnh gốc của lisp thì không thấy có cái lệnh ssx bạn cho, nhưng nếu lệnh này được tạo ra từ các code lisp thì nó lại có thể là bất cứ cái gì bạn muốn thực hiện chứ không phải chỉ có như cái bạn nói. Mà cái bạn nói thì mình chả hiểu nó là cái gì??? Sửa các đối tượng về cùng một kiểu nghĩa là thế nào?? Các hình vuông thành hình tròn hay các hình tròn thành e-líp???? Bạn cần giải thích rõ cái kiểu ở đây là cái gì bạn nhé....

Ví dụ sau đây là cách tạo lệnh ssx dùng để đổi màu của một đối tượng thành màu đỏ.
(defun c:ssx ()
(setq en (entsel "\n Chon đoi tuong bat ky")
       els (enget (car en)))
(if (/= (cdr (assoc 62 els)) nil)
(progn
(setq els (subst (cons 62 1) (assoc 62 els) els))
(entmod els))
(progn
(setq els (append els (list(cons 62 1))))
(entmod els))
)
)
Do vậy nếu bạn muốn lệnh ssx là cái gì thì bạn phải hiểu và biết cách viết lisp cho nó.

Câu 2:

Bạn có thể sử dụng lisp sau để làm cái việc bạn cần. Nếu nó chưa đúng ý bạn thì hãy post điều chưa vừa ý lên nhé.
(defun c:ido ()
(vl-load-com)
(command "undo" "be")
(setq dt (car (entsel "\n Chon doi tuong goc"))
     edt (entget dt)
     bn (cdr (assoc 2 edt))
     dg (cdr (assoc 10 edt))
     dc (car (entsel "\n Chon duong chuan"))
     edc (entget dc)
     p0 (getpoint"\n Chon diem bat dau")
)
(if (equal (cdr (assoc 10 edc)) p0)
   (setq a1 0)
   (setq a1 (vlax-curve-getdistatpoint dc p0))
)
(setq par (vlax-curve-getparamatdist dc a1)
     vtt (vlax-curve-getFirstderiv dc par)
     lth (vlax-curve-getdistatpoint dc (vlax-curve-getendpoint dc))
     dis (getreal "\n Nhap khoang cach giua cac diem : ")
     i 0
)
(if (/= (car vtt) 0)
   (setq gr (atan (/ (cadr vtt) (car vtt))))
   (setq gr (- 0 (/ pi 2)))
)
(if (> (car vtt) 0)
   (setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(if (    (progn
         (while (>= (- a1 (* i dis)) 0)
                (setq p1 (vlax-curve-getpointatdist dc (- a1 (* i dis)))
                      par (vlax-curve-getparamatpoint dc p1)
                      vtt (vlax-curve-getFirstderiv dc par)
                )
                (if (/= (car vtt) 0)
                    (setq gr (atan (/ (cadr vtt) (car vtt))))
                )
                (if (> (car vtt) 0)
                    (setq gr (+ pi gr))
                )
                (setq gd (/ (* gr 180) pi))
                (command "insert" bn "r" gd p1 "" "" "")
                (if (and (> gd 90) (                     (setq gd (+ gd 180))
                )
                (setq i (1+ i))

          )
    )
    (progn
          (while (                  (setq p1 (vlax-curve-getpointatdist dc (+ a1 (* i dis)))
                       par (vlax-curve-getparamatpoint dc p1)
                       vtt (vlax-curve-getFirstderiv dc par)
                 )
                 (if (/= (car vtt) 0)
                     (setq gr (atan (/ (cadr vtt) (car vtt))))
                 )
                 (if (                      (setq gr (+ pi gr))
                 )
                 (setq gd (/ (* gr 180) pi))
                 (command "insert" bn "r" gd p1 "" "" "") 
                 (if (and (> gd 90) (                      (setq gd (+ gd 180))
                 )
                 (setq i (1+ i))
          )
    )
)
(command "undo" "e")
(princ)
)
Chúc bạn vui.

<<

Download lisp

Filename: 102764_ssx.lsp

Tác giả: ketxu
Bài viết gốc: 171531
Tên lệnh: tlt

Lisp rải taluy kiểu thủy lợi !

Dù sao cũng nhắc bạn cần suy nghĩ thấu đáo hơn khi yêu cầu người khác giúp bạn. Nếu bạn không trình bày chính xác và rõ...
>>
Dù sao cũng nhắc bạn cần suy nghĩ thấu đáo hơn khi yêu cầu người khác giúp bạn. Nếu bạn không trình bày chính xác và rõ ràng vấn đề của bạn rất có khả năng bạn sẽ nhận được những thứ không ngon như bạn muốn.

Hề hề hề.....

Em đồng ý, dù ai viết về vấn đề dù nhỏ nhất cũng cần nhìn nhận mọi khía cạnh điều mình hỏi. Lần này hay không bằng hên nên chẳng may viết đúng ý bạn hanam1210, e cũng quên béng mất là các đường nó không bằng nhau, ngại quá ^^

hi. Bác KETXU đúng là siêu cao thủ lisp chạy đúng yêu cầu, nhưng có 1 vấn đề này do ban đầu e chưa nêu hết em xin bác bổ sung giúp được ko ạ ? Tức là nét dài sẽ thuộc một layer có màu 1 chẳng hạn. Nét ngắn thuộc layer đó nhưng có màu 8 chẳng hạn.bác Update giúp em nhé. Cảm ơn bác nhiều !

Bạn nhìn theo cái này, cần thay chỗ nào mình đều ghi chú rồi tự sửa nhé
(defun c:tlt(/ eLine curve pt i j len dsttmp)
(vl-load-com)
(or #dist (setq #dist 10)) ; 10 = Khoang cach mac dinh
(setq #dist (cond ((getdist (strcat "\n D  <" (vl-princ-to-string #dist) " > :")))(#dist)))
(defun eLine (p1 P isFull / p2 col)
(if isFull
(setq p2 P col 1) ;1 = Mau cua Line full
(setq p2 (polar p1 (angle p1 P) (/ (distance p1 P) 2)) col 8) ; 8 = Mau cua Line nua
)
(entmake
 (list (cons 0 "LINE")(cons 10 p1)
 (cons 11 p2)(cons 62 col)
 (cons 8 "0") ;0 = Layer cua Duong Taluy
 )
)
)
;;Doan duoi nay khong can de y
(while
(and
(setq curve  (car(entsel "\nPath curve :")))
(wcmatch (cdadr (entget curve)) "*LINE,ARC")
(setq pt (getpoint "\n P :"))
(setq i -2 j -1 len (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)))
)
(progn
(while (< (setq dsttmp (* (setq i (+ i 2)) #dist)) len) (eLine (vlax-curve-getPointAtDist curve dsttmp) pt T))
(while (< (setq dsttmp (* (setq j (+ j 2)) #dist)) len) (eLine (vlax-curve-getPointAtDist curve dsttmp) pt nil))
)
))
<<

Download lisp

Filename: 171531_tlt.lsp

Tác giả: ketxu
Bài viết gốc: 171474
Tên lệnh: test

Lisp rải taluy kiểu thủy lợi !

Quick code, không dùng cho SPline

(defun c:test(/ eLine curve dist pt i j p1)
(vl-load-com)
(defun eLine (p1 P isFull)(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 (if isFull P (polar p1 (angle p1 P) (/ (distance p1 P) 2)))))))
(if
(and (setq curve  (car(entsel "\nPath curve ;")))
(setq dist (getdist "\n D :"))
(setq pt (getpoint "\n P:"))
(setq i -2 j -1)
)
(progn
(while (setq p1 (vlax-curve-getPointAtDist curve  (* (setq i (+ i 2))...
>>

Quick code, không dùng cho SPline

(defun c:test(/ eLine curve dist pt i j p1)
(vl-load-com)
(defun eLine (p1 P isFull)(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 (if isFull P (polar p1 (angle p1 P) (/ (distance p1 P) 2)))))))
(if
(and (setq curve  (car(entsel "\nPath curve ;")))
(setq dist (getdist "\n D :"))
(setq pt (getpoint "\n P:"))
(setq i -2 j -1)
)
(progn
(while (setq p1 (vlax-curve-getPointAtDist curve  (* (setq i (+ i 2)) dist))) (eLine p1 pt T))
(while (setq p1 (vlax-curve-getPointAtDist curve  (* (setq j (+ j 2)) dist))) (eLine p1 pt nil))
)
))

Download lisp

Filename: 171474_test.lsp

Tác giả: cuongtk2
Bài viết gốc: 462633
Tên lệnh: test

Nhờ các bác viết lisp gom nhóm đèn trong bản vẽ điện

Dùng cái này coi.

(defun c:test ( / E ENT I LS N ND SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "TEXT")) )))
(setq ls (mapcar '(lambda (e) (cdr (assoc 1 (entget e))))
                 ss)
      )
(setq ls (vl-sort ls '(lambda (st st2 ) (< (atof st) (atof st2) ))))
(setq nd ""))
    (setq nd (strcat nd (nth i ls) ","))
    )
  (setq i (1+ i))
  )
(setq ent (entget (car (entsel "\nChon text de...
>>

Dùng cái này coi.

(defun c:test ( / E ENT I LS N ND SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "TEXT")) )))
(setq ls (mapcar '(lambda (e) (cdr (assoc 1 (entget e))))
                 ss)
      )
(setq ls (vl-sort ls '(lambda (st st2 ) (< (atof st) (atof st2) ))))
(setq nd ""))
    (setq nd (strcat nd (nth i ls) ","))
    )
  (setq i (1+ i))
  )
(setq ent (entget (car (entsel "\nChon text de update:"))))
(setq ent (subst (cons 1 nd) (assoc 1 ent) ent)
      )
  
(entmod ent)
  (princ)

)

Download lisp

Filename: 462633_test.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 172012
Tên lệnh: ha

viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo

Ở diễn đàn cũng có nhưng mình thích cái coste cao độ như hình mình vẽ cho nó đồng bộ với bản vẽ của mình, mà copy cái kia về mình...

Ở diễn đàn cũng có nhưng mình thích cái coste cao độ như hình mình vẽ cho nó đồng bộ với bản vẽ của mình, mà copy cái kia về mình không biết sửa nên nhờ bạn. thanks

Thực tình thì copy theo kiểu của bạn chắc chắn trên Cadviet đã có. Tuy nhiên vì bạn có thể tìm chưa ra hoặc không ưng ý, nếu vậy thì dùng thử cái này vậy.

; Doan Van Ha CADViet.com
; Copy-Array, rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
(defun C:HA (/ dsdt dt dt1 dt2 p1 p2 sl x strt strp num sym ds daup giaso)
(command "undo" "be")
(princ "\nChon cac doi tuong can Copy-Array...")
(setq dsdt (acet-ss-to-list (setq dt (ssget)))
      	dt1 dt
      	p1 (getpoint "\nDiem goc: ")
      	p2 (getpoint p1 "\nDiem den: ")
      	sl (getint "\nSo lan: ")
      	x 1 giaso (/ (- (cadr p2) (cadr p1)) 1000))
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(foreach n dsdt
 (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
  (if (KT_NUM (cdr (assoc 1 (entget n))))
(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt)))
(if dt2
 (progn
  (setq x 1)
  (repeat sl
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
(entmod (subst (cons 1 (strcat (car ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds)))  (assoc 1 (entget (entlast))) (entget (entlast))))
(entupd (entlast))
(setq x (1+ x)))))
(if dt1
 (progn
  (setq x 1)
  (repeat sl
(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(setq x (1+ x)))))
(command "undo" "e")
(acet-sysvar-restore)
(princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
 (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
        	(T (setq lstt nil))))
(while lstn
 (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
        	(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
(foreach n (vl-string->list str)
 (if (and (>= n 48) (<= n 57)) (setq kt T)))
kt)

Download lisp

Filename: 172012_ha.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 172155
Tên lệnh: ha

viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo

thank Ha nhé đúng như cái mình cần nhưng còn 1 chỗ nhờ bạn sửa giúp thêm 1 tí. Ban đầu cos +-0.000 nếu copy lên thì sẽ +3.600 nếu copy...

thank Ha nhé đúng như cái mình cần nhưng còn 1 chỗ nhờ bạn sửa giúp thêm 1 tí. Ban đầu cos +-0.000 nếu copy lên thì sẽ +3.600 nếu copy xuống thì -3.600. thanks.

Đây bạn! Tuy nhiên, bạn đừng y/c theo kiểu lâu lâu 1 y/c thì khổ người viết lắm. Tóm lại, bạn nên nêu tất cả y/c 1 lần thôi. Lisp dưới đây bỏ dấu +-cho bạn, còn các y/c khác thì đợi bạn... hết y/c mới nhào vô viết 1 lần luôn (vì vừa mới sửa xong, up lên thì lại thấy bạn bổ sung thêm y/c nữa).

; Doan Van Ha CADViet.com
; Copy-Array, rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
(defun C:HA (/ dsdt dt dt1 dt2 p1 p2 sl x strt strp num sym ds daup giaso)
(command "undo" "be")
(princ "\nChon cac doi tuong can Copy-Array...")
(setq dsdt (acet-ss-to-list (setq dt (ssget)))
  		dt1 dt
  		p1 (getpoint "\nDiem goc: ")
  		p2 (getpoint p1 "\nDiem den: ")
  		sl (getint "\nSo lan: ")
  		x 1 giaso (/ (- (cadr p2) (cadr p1)) 1000))
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(foreach n dsdt
 (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
  (if (KT_NUM (cdr (assoc 1 (entget n))))
(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt)))
(if dt2
 (progn
  (setq x 1)
  (repeat sl
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
;	(entmod (subst (cons 1 (strcat (car ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds)))  (assoc 1 (entget (entlast))) (entget (entlast))))
(entmod (subst (cons 1 (strcat (ACET-STR-REPLACE (chr 177) "" (car ds)) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds)))  (assoc 1 (entget (entlast))) (entget (entlast))))
(entupd (entlast))
(setq x (1+ x)))))
(if dt1
 (progn
  (setq x 1)
  (repeat sl
(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(setq x (1+ x)))))
(command "undo" "e")
(acet-sysvar-restore)
(princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
 (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
		(T (setq lstt nil))))
(while lstn
 (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
		(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
(foreach n (vl-string->list str)
 (if (and (>= n 48) (<= n 57)) (setq kt T)))
kt)

Download lisp

Filename: 172155_ha.lsp

Tác giả: ketxu
Bài viết gốc: 172191
Tên lệnh: dc

viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo

Hôm qua về mệt quá ngủ luôn, nên quên không viết, srr risusu ^^

1 ví dụ với copy cao độ (ở 2D là tọa độ Y) với tập các đối tượng Text như trong bản vẽ :

(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq  lstSS (mapcar 'entget (acet-ss-to-list (setq ss(ssget))))
 Txt (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr x)"*TEXT")) lstSS))
...
>>

Hôm qua về mệt quá ngủ luôn, nên quên không viết, srr risusu ^^

1 ví dụ với copy cao độ (ở 2D là tọa độ Y) với tập các đối tượng Text như trong bản vẽ :

(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq  lstSS (mapcar 'entget (acet-ss-to-list (setq ss(ssget))))
 Txt (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr x)"*TEXT")) lstSS))
 txtstr (atof (acet-dxf 1 txt))
 p1 (getpoint "\nBasepoint :")
 eL (entlast)
)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq  Txt1 (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) Listname))
 eL (entlast)
)
(vla-put-textstring (vlax-ename->vla-object txt1)
(strcat (cond ((> (setq num (+ txtstr (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
  )
(rtos num  2 3))
)
)
)

Download lisp

Filename: 172191_dc.lsp

Tác giả: elleHCSC
Bài viết gốc: 69811
Tên lệnh: ssb

Hỏi lisp về Region

Bạn chạy thử Lisp Highlight đối tuợng Region bao ngoài (nếu có) trong tập hợp các đối tuợng Region.
Sau đó việc erase, move, copy ... bạn tùy nghi xử...
>>
Bạn chạy thử Lisp Highlight đối tuợng Region bao ngoài (nếu có) trong tập hợp các đối tuợng Region.
Sau đó việc erase, move, copy ... bạn tùy nghi xử lý.

Chú ý : Lisp này không tạo ra Region mà chỉ chọn ra Region bao ngoài trong tập hợp các đối tuợng Region.
(defun C:ssb(/ ss ss1 boundary e minPt maxPt )  ;select region boundary
 (vl-load-com)
 (setq ss1 (ssadd))
 (if (setq ss (ssget (list (cons 0 "REGION")  ) ) )
   (progn
     (setq boundary (boundarySS ss))
     (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(vla-getBoundingBox e 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt)
      maxPt (vlax-safearray->list maxPt))
(if (equal (list minPt  maxPt ) boundary 0.001)
  (setq ss1 (ssadd (vlax-vla-object->ename e) ss1))
  )
); foreach
     (if (>(sslength ss1)0)(sssetfirst nil ss1) )
     ); progn
   ); if  
 )
;ham tra ve 2 diem (LowerLeft TopRight) cua hinh chu nhat bao quanh cac doi tuong 
(defun boundarySS (ss / all_max all_min ll maxpt minpt ur); 
 (setq	all_min	(list)
all_max	(list)  ) 
 (foreach x (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (vla-GetBoundingBox x 'minpt 'maxpt)
   (setq all_min (cons (vlax-safearray->list minpt) all_min)
  all_max (cons (vlax-safearray->list maxpt) all_max)  )
   ) ;foreach
 (setq ll (list (car (vl-sort (mapcar 'car all_min) '<))
	 (car (vl-sort (mapcar 'cadr all_min) '<))
	 (car (vl-sort (mapcar 'caddr all_min) '<)) ) ;list
ur (list (last (vl-sort (mapcar 'car all_max) '<))
	 (last (vl-sort (mapcar 'cadr all_max) '<))
	 (last (vl-sort (mapcar 'caddr all_max) '<))) ;list
) ;setq
 (list ll  ur )
 )
Chào Gia_bach mình đã thử đoạn code trên nhưng nó ko như được ý mình muốn. Kết quả của đoạn code trên nó cũng cho gần giống của TUE_NV nếu như khi chạy chọn tập các region rời rạc (mình chọn "all" region mỗi khi chạy ssb) thì kết quá nó báo là "nil". mình đã thử đi thử lại với nhiều bản vẽ.

Tks bác gia_bach, quả là bác có nhiều chiêu hay quá...

<<

Download lisp

Filename: 69811_ssb.lsp

Tác giả: DungNguyen685
Bài viết gốc: 458342
Tên lệnh: vt

Căn chỉnh image trong tile image của dialog

Chào các bác!

Em có tham khảo qua nhiều topic trong đó có topic của bác @Doan Van Ha

mà vẫn không thể nào căn chỉnh được img sao cho vừa title img trong dialog. Em có code này để minh họa. Mong các bác giúp đỡ.

(defun C:VT (/)
(if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (foreach x
               '(
                    "pass : dialog"
                    "{"
                    "        label = \"Setting\";"		
                    "            : column "
                    "            {"
                    "                : boxed_row"
                    "                	{"	
                    "        		 label = \"Th\U+00F4ng s\U+1ED1\";"	
                    "            : radio_column "
                    "            {"					
                    "            : edit_box"
                    "            {"
                    "                key = \"k1\";"
                    "       		 label = \"Nh\U+1EADp th\U+00F4ng s\U+1ED1:\";"					
                    "                edit_width = 12;"
                    "                alignment = left;"
                    "                mnemonic = \"L\";"	
                    "            }"	
                    "    spacer;"
                            "        : image"
                            "        {"
                            "            key = \"logo\";"
                            "            width = 33.5;"
                            "            height = 11.62;"
                            "            fixed_width = true;"
                            "            fixed_height = true;"
                            "            alignment = centered;"
                            "        }"
                    "    spacer;"	
                    "            }"	
                    "            }"	
                    "    : row"
                    "    {"	
                    "    : button"
                    "    {"
                    "        key = \"accept\";"
                    "        label = \"Draw\";"
                    "        is_default = true;"	
                    "        is_cancel = true;"
                    "        fixed_width = true;"
                    "        alignment = centered;"
                    "        width = 15;"
                    "        mnemonic = \"x\";"
                    "    }"
					
                    "    : button"
                    "    {"
                    "        key = \"cancel\";"
                    "        label = \"Cancel\";"
                    "        is_default = false;"	
                    "        is_cancel = true;"						
                    "        fixed_width = true;"
                    "        alignment = centered;"
                    "        width = 15;"
                    "        mnemonic = \"G\";"
                    "    }"					
                    "    }"						
                    "}"
					"            }"	
                )
                (write-line x des)
            )
            (not (setq des (close des)))
            (< 0 (setq dch (load_dialog dcl)))
            (new_dialog "pass" dch)
        )
        (progn
(defun logo (key)
  (start_image key)
  (mapcar 'vector_image; Color 1
	(list 86 96 86)
    (list 47 47 47)
    (list 96 96 86)
    (list 47 48 48)
    (list  1  1  1)
  );mapcar
  (end_image)
);defun
 (logo "logo")
			(start_dialog)
        )
        (princ "\nUnable to load password dialog.")
)
(princ)
)

Download lisp

Filename: 458342_vt.lsp

Tác giả: kedensau88
Bài viết gốc: 185122
Tên lệnh: ef

Cách lấy số liệu từ file txt

(defun DCL ( lstType / fl ret dcl_id Return# add_lst tmp)
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list...
>>

(defun DCL ( lstType / fl ret dcl_id Return# add_lst tmp)
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
 (vl-load-com)
 (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
 (setq  ret (open fl "w"))
 (mapcar
'(lambda (x) (write-line x ret))
(list
 " mip_msg : dialog { label = \"Elbowls\";"
 " : boxed_column { label = \"Chon loai Elbowls\";"
 " : list_box { key = \"mylist\";width = 17;}"
 " } "
 " : boxed_column { label = \"Chon loai NPS\";"
 " : popup_list {key = \"NPS\"; width = 17; height = 8;} "
 " } "
 " : row { "
 " : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
 " : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
 " } "
 "} "
)  
 )
 (setq ret (close ret))
 (if (and (not (minusp (setq dcl_id (load_dialog fl))))
   	(new_dialog "mip_msg" dcl_id)
  )
(progn
 (add_lst "mylist" '("Elbowls 45" "Elbowls 90" "Elbowls 180") 3)
 (set_tile "mylist" "0")
 (add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3) ;Chu y dong khoi tao lay du lieu Elbowls 45
 ;Xu ly khi pick chon loai Elbowls
 (action_tile "mylist"
  "(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
 )
 (action_tile "accept" "(setq ret  (list (get_tile \"mylist\")
	(car (setq tmp
	(cadr
	(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))))
	(last tmp)
	))(done_dialog)")
 (start_dialog)
)
 )
 (unload_dialog dcl_id)
 (vl-file-delete fl)
ret
)

(defun c:ef (/  PR RL  lst0 lst1 lst2 lst val pt)

;Lay ten file
(or  fn0
 (setq fn0 (findfile "Nhap ten file mac dinh vao day"))
 (setq fn0 (getfiled "Chon file chua so lieu Elbowls 45 " "" "txt" 2)))
(or  fn1
 (setq fn1 (findfile "Nhap ten file mac dinh vao day"))
 (setq fn1 (getfiled "Chon file chua so lieu Elbowls 90 " "" "txt" 2)))
(or  fn2
 (setq fn2 (findfile "Nhap ten file mac dinh vao day"))
 (setq fn2 (getfiled "Chon file chua so lieu Elbowls 180 " "" "txt" 2)))
;Het lay ten file
(if (and fn0 fn1 fn2)
 (progn
; Doc tung file dua vao list
  (setq PR (open fn0 "r") RL (read-line PR))
  (while  (setq RL (read-line PR))
  (setq   RL (read (strcat "(" RL ")"))
  lst0 (append lst0 (list (list (car RL)(cdr RL))))  
  )
)
(setq lst0 (list "0" lst0))
(close PR)
; Doc file fn1 dua vao list
  (setq PR (open fn1 "r") RL (read-line PR))
  (while  (setq RL (read-line PR))
  (setq   RL (read (strcat "(" RL ")"))
  lst1 (append lst1 (list (list (car RL)(cdr RL))))  
  )
)
(setq lst1 (list "1" lst1))
(close PR)
(setq PR (open fn2 "r") RL (read-line PR))
  (while  (setq RL (read-line PR))
  (setq   RL (read (strcat "(" RL ")"))
  lst2 (append lst2 (list (list (car RL)(cdr RL))))  
  )
)
(setq lst2 (list "2" lst2))
(close PR)
(setq lst (list lst0 lst1 lst2)) ;Lay list du lieu dang (("0" (NPS (OD B))(NPS (OD B))...)("1" (NPS (OD B))(NPS (OD B))...)...)
(if
(and (setq val (DCL lst))
  (setq pt (getpoint "\nDiem chen:"))
)
(apply 'draw (append val (list pt)))
(princ "Loi")
)
);Het Progn
(princ "\nThieu file")
)
(princ)
)


;--------------------------------------------------------------------------------
(defun draw (Loai OD B P1 /  P2 P3 P4 P5 P6 P7 OldOS)
;Phan nay la phan chung cua tat ca cac ham
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(cond
((= Loai "0") ;Loai 45 do
(setq
 P2(polar P1 0.0 (* B 2.414213562))
 P3(polar P1 0.0 (* OD 0.5))
 P4(polar P1 pi (* OD 0.5))
 P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
 P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
 P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
 P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)  
 (COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
 (command "circle" P2 P1)
 (COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
 (command "circle" P2 P3)
 (command "circle" P2 P4)
 (command "line" P2 P4 "")
 (command "rotate" "b" P5 P6 "" P2 -45 "")
 (command "line" P2 P4 "")
 (command "zoom" "w" P7 P8)
 (command "trim" "" P7 P8 "")
 ) ;Ket thuc ham ve Loai 45
 ((= Loai "1") ;Loai 90
(setq
 P2(polar P1 (/ pi 2) B)
 P3(polar P2 (* pi 1.5) (/ OD 2))
 P4(polar P2 (/ pi 2) (/ OD 2))
 P5(polar P1 pi (+ B (/ OD 2)))
 P6(list (+ (car P1) (+ B (/ OD 2))) (- (cadr P1) (+ B (/ OD 2))) (caddr P1))
 P7(list (- (car P1) (/ B 4)) (+ (cadr P1) (/ B 4)) (caddr P1))
)
 (COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
 (command "circle" P1 P2)
 (COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
 (command "circle" P1 P3)
 (command "circle" P1 P4)
 (command "line" P1 P4 "")
 (command "line" P1 P5 "")
 (command "zoom" "w" P6 P4)
 (command "TRIM" "" P6 P7 "")
 ) ;Ket thuc ham ve loai 90

 ((= Loai "2")
 (setq
P2(polar P1 pi (* O 0.5))
P3(polar P2 0.0 (* OD 0.5))
P4(polar P2 pi (* OD 0.5))
P5(polar P1 0.0 (* 0.5 (+ O OD)))
P6(list (+ (car P1) (* 1 O)) (- (cadr P1) (* O 1)) (caddr P1))
P7(list (- (car P1) (* 0.25 (- O OD))) (+ (cadr P1) (* 0.25 (- O OD))) (caddr P1))
P8(list (- (car P1) (* 1 O)) (+ (cadr P1) (* O 1)) (caddr P1))
)
 (COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
 (command "circle" P1 P2)
 (COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
 (command "circle" P1 P3)
 (command "circle" P1 P4)
 (command "line" P4 P5 "")
 (command "zoom" "w" P6 P8)
 (command "trim" "" P6 P7 "")
 ) ; Ket thuc ham ve loai 180
);Ket thuc phan loai COnd
;Phan nay la phan chung
 (setvar "osmode" OldOs)
 (princ)
)

Code đa số mình dùng dotted pair list chứ k phân ra nhiều biến và lợi dụng hàm assoc, bạn phải chú ý theo dõi sự thay đổi của các biến nhận về thì mới hiểu rõ được. Hiện tại mình chưa rỗi nên chưa viết rõ chức năng từng dòng được, nên bạn chịu khó ngâm, khúc mắc đâu mọi người sẽ giải thích

Phần lấy tên 3 file và đọc dữ liệu trong từng file gán vào 1 list nhỏ mình cố ý để dài như vậy để bạn hiểu nhược điểm bất tiện của nó khi code : số lượng file chứa Elbowls là cố định và k linh hoạt. Bạn hãy sửa thành cách cho chọn bất kỳ file Elbowls nào (thêm 1 nút chọn thêm file) => append file vào list các loại elbowls

(Lấy tên loại elbowls = tên file - *.txt). COi như đây là 1 bài tập dành cho bạn (nếu bạn thực sự muốn chương trình của mình tốt hơn)

Hic,hic,khó quá anh ơi,em chịu thôi ạ. :(

Download lisp

Filename: 185122_ef.lsp

Tác giả: duy782006
Bài viết gốc: 3346
Tên lệnh: tht

Cấu trúc rẽ nhánh trong AutoLisp

;;Vo Kien Cuong
;;FITC - FRESHWIND INFORMATION TECHNOLOGY CORPORATION
;;vokiencuong@freshwind-it.com
;;Thong ke
(DEFUN EXCUTE( / LiValue LinValue i ss n j k dt value)
 (setq LiValue...
>>

Download lisp

Filename: 3346_tht.lsp

Tác giả: nguyentuyen6
Bài viết gốc: 126052
Tên lệnh: bylayer

Nhờ viết lisp đổi màu về bylayer

Trước mình cũng viết cái Líp này mà dài loàng ngoằng ra. hehe

(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
(vl-load-com)
(defun c:bylayer (/ ss en el i)
 (vl-load-com)
(setvar "cmdecho" 0)  
(command ".UNDO" "E") 
 (princ "\n >>> Dang xu ly .....")
 (princ "\nChuyen ve ByLayer")
 ;25/11/2010
 ;nguyentuyen86@gmail.com
 (setq ss (ssget "x"))
 (setq i 0)
 (while...
>>

Trước mình cũng viết cái Líp này mà dài loàng ngoằng ra. hehe

(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
(vl-load-com)
(defun c:bylayer (/ ss en el i)
 (vl-load-com)
(setvar "cmdecho" 0)  
(command ".UNDO" "E") 
 (princ "\n >>> Dang xu ly .....")
 (princ "\nChuyen ve ByLayer")
 ;25/11/2010
 ;nguyentuyen86@gmail.com
 (setq ss (ssget "x"))
 (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
   (if	(/= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
(if (/= (cdr (assoc 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)
     )
     (upwblock en)
   )
(entupd en)
   (setq i (1+ i))
 )
(command ".REGEN")
(command ".UNDO" "E")
(setvar "cmdecho" 0)  
(princ "\n....DONE....")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn
(if (/= (cdr (assoc 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)

     )
   )
(entupd en)
   (setq en (entnext en))
 )
)

Download lisp

Filename: 126052_bylayer.lsp

Tác giả: cuongtk2
Bài viết gốc: 462671
Tên lệnh: test

Nhờ các bác viết lisp gom nhóm đèn trong bản vẽ điện

Sửa lại đây nhé:

(defun c:test ( / E ENT I LS N ND SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "TEXT")) )))
(setq ls (mapcar '(lambda (e) (cdr (assoc 1 (entget e))))
                 ss)
      )
(setq ls (vl-sort ls '(lambda (st st2 ) (< (atof st) (atof st2) ))))
(setq nd ""))
    (setq nd (strcat nd (nth i ls) ","))
    )
  (setq i (1+ i))
  )

  (setq textdxf (entget (car ss)))
  (setq pt...
>>

Sửa lại đây nhé:

(defun c:test ( / E ENT I LS N ND SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "TEXT")) )))
(setq ls (mapcar '(lambda (e) (cdr (assoc 1 (entget e))))
                 ss)
      )
(setq ls (vl-sort ls '(lambda (st st2 ) (< (atof st) (atof st2) ))))
(setq nd ""))
    (setq nd (strcat nd (nth i ls) ","))
    )
  (setq i (1+ i))
  )

  (setq textdxf (entget (car ss)))
  (setq pt (getpoint "\nDiem dat text:"))
  (setq ent (list
              (cons 0 "TEXT")
              (cons 1 nd)
              (cons 67 0)
              (assoc 410 textdxf)
              (assoc 40 textdxf)
              (assoc 7 textdxf)
              (assoc 41 textdxf)
              (cons 10 pt)
              )
)
  
(entmake ent)
  (princ)

)

Download lisp

Filename: 462671_test.lsp

Tác giả: cd2k44
Bài viết gốc: 172114
Tên lệnh: 1

lisp chuyển layer

Vậy mình mới nói với bạn là layer đích lấy ở đâu đó.ví dụ mình mặc định 1 là layer net liền cho bạn thì phải làm thêm điều kiện là tìm xem layer nét liền có tồn tại hay không nữa ah.Bạn hiểu ý mình chứ,chỉ có bạn vẽ thì bạn mới biết trong bạn vẽ của bạn có những layer nào để chuyển thôi bạn ah

(defun c:1() 
 (prompt "_.change ")
 (princ "\n thay doi layer...
>>

(defun c:1() 
 (prompt "_.change ")
 (princ "\n thay doi layer sang layer netlien")
 (setq sset (ssget))
 (if (null sset)
(progn
 	(princ "\nERROR: Nothing selected.")
 	(exit)	)  )
 (command "_.change" sset "" "P" "la" "netlien" "") ;muon doi layer khac thi ban doi ten layer netlien nhe
(princ))

Download lisp

Filename: 172114_1.lsp

Tác giả: ketxu
Bài viết gốc: 170557
Tên lệnh: nb

convert anonymous block to normal block

....

P/s : đề nghị bạn cho đoạn mã vào thẻ Code

Vấn đề của bạn có thể xử lý bằng lisp...

....

P/s : đề nghị bạn cho đoạn mã vào thẻ Code

Vấn đề của bạn có thể xử lý bằng lisp này cũng được :

http://www.cadviet.com/forum/index.php?showtopic=53341&st=0&p=166931&&do=findComment&comment=166931

Nó sẽ copy block Anon bạn chọn thành 1 block mới, rồi bạn chèn vào đúng điểm chèn cũ của block đó ( trong ví dụ cảu bạn thì toàn '( 0 0 0).

Từ lisp này cũng có thể biến hóa thành lisp convert block anon -> block thường :

;| Change Anonymous Block to normal with new Name
@ Ketxu 27 - 9 - 2011
|;
(defun c:nb( / blkObj blkName blkNew_Name fn pt) 
(vl-load-com)
(defun ST:SS->List-Vla (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
 )
)

(defun change_block(old new)
(foreach blkObj (setq ss (ST:SS->List-Vla (ssget "X" (list (cons 0 "INSERT")(cons 2 old)))))
(vla-put-name blkObj new);;change the name
(vla-update blkObj)
)
)
(grtext -1 "Free Lisp From Cadviet @Ketxu")
(setvar "cmdecho" 0)
(setq 
blkObj (vlax-ename->vla-object (car(entsel "\nBlock Source :")))
blkName (vlax-get-property blkObj
   (if (vlax-property-available-p blkObj 'EffectiveName) 'EffectiveName 'Name)
 )  
blkNew_Name (getstring "\n New Name :")
 fn (strcat (getenv "TEMP") "\\" blkNew_Name ".dwg")
)
(command ".-wblock" fn "_Y" blkName "")  
(command "._insert" (strcat blkNew_Name "=" fn) nil )
(if (wcmatch "`*" (substr blkName 1 1))(setq blkName (strcat "`*" (substr blkName 2))))
(change_block blkName blkNew_Name)
(vl-file-delete  fn)
)

Download lisp

Filename: 170557_nb.lsp

Tác giả: Detailing
Bài viết gốc: 172062
Tên lệnh: mat

lisp matext (copy nội dung text này sang text kia)

Mình có download trên diễn đàn lisp matext: copy nội dung text A cho text B. Nhưng nó chỉ dùng được 1 lần cho copy nội dung từ A sang B, đôi...
>>
Mình có download trên diễn đàn lisp matext: copy nội dung text A cho text B. Nhưng nó chỉ dùng được 1 lần cho copy nội dung từ A sang B, đôi khi mình gặp các trường hợp cần dùng tiếp copy nội dung text A cho text C, D, E... nữa. Các bác chỉnh dùm cho nó thành mutiple dùm mình với nhé!

Lisp matext: http://www.cadviet.c...es/3/matext.lsp

yêu cầu này thực ra ko cần vì bạn có thể chọn nhiều text 1 lần nhưng chỉ thêm vài dòng nên mình "múa rìu" vậy.

goodluck!
;Viet boi: KTS_DUY  BINH SON - QUANG NGAI
;Dien dan: tailieukythuat.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:mat ()
(command "undo" "be")
(setq donvi (/ (getvar "viewsize") 40))
(setq ddd (entsel "\nChon doi tuong mau"))
(while
(or
(null ddd)
(and (/= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (/= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (/= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong phai la TEXT, MTEXT hoac DIMENSION! Chon lai"))
)
  (setq DT (car ddd))
  (setq DTM (entget DT))
  (setq NOIDUNG (cdr (assoc 1 DTM)))
  (setq DIEMCHENMAU (cdr (assoc 10 DTM)))

(setq diemvt1 (polar DIEMCHENMAU pi donvi))
(setq diemvt2 (polar DIEMCHENMAU (* 2 pi) donvi))
(setq diemvt3 (polar DIEMCHENMAU (/ pi 2) donvi))
(setq diemvt4 (polar DIEMCHENMAU (- 0 (/ pi 2)) donvi))
       	(grdraw diemvt1 diemvt2 3)
       	(grdraw diemvt3 diemvt4 3)
(while T
(Princ "\nChon TEXT,MTEXT,DIMENSION muon chinh :")
(setq xx (ssget '((0 . "TEXT,MTEXT,DIMENSION"))))
(if(not xx) (exit))
(setq L 0)
(setq M (sslength XX))
(while (< L M)
  		(setq DTs (ssname XX L))
  		(setq DTMs (entget DTs))
  		(setq NOIDUNGM NOIDUNG)
  		(setq DTMs (subst (cons 1 NOIDUNGM) (assoc 1 DTMs) DTMs))
  		(entmod DTMs)

  (setq L (1+ L))
)
 )
(command ".pan" DIEMCHENMAU DIEMCHENMAU)
(command "undo" "end")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
 	(Princ))
<<

Download lisp

Filename: 172062_mat.lsp

Tác giả: lp_hai
Bài viết gốc: 169734
Tên lệnh: clo

Lisp đo và điền giá trị diện tích

Bạn thử xem nhá!

Tuy nhiên mình làm hơi khác yêu cầu của bạn một tý. Nguyên lý hoạt động là:

1.Chọn Block mẫu, vì block bạn có thể thay đổi khi thì LK-09: khi thì LK-10: .... vì vậy phải chọn.

2.pick diểm trong vùng tính dt, cái này ko phải nói

3.chọn điểm gốc đặt block, và chọn thêm một điểm để xác định góc quay. Nếu làm như bạn yêu cầu thì phải thêm tùy chọn C...

Bạn thử xem nhá!

Tuy nhiên mình làm hơi khác yêu cầu của bạn một tý. Nguyên lý hoạt động là:

1.Chọn Block mẫu, vì block bạn có thể thay đổi khi thì LK-09: khi thì LK-10: .... vì vậy phải chọn.

2.pick diểm trong vùng tính dt, cái này ko phải nói

3.chọn điểm gốc đặt block, và chọn thêm một điểm để xác định góc quay. Nếu làm như bạn yêu cầu thì phải thêm tùy chọn C hoặ T thì cũng mất thời gian hơn là mặc định chọn 2 điểm.

(defun c:clo(/ bm bn tenlo tengoc stt st p1 p2 pt ang area po)
 (setq bm (entsel "\nchon Block mau:")
bn (cdr (assoc 2 (entget(car bm))))
Tenlo (cdr (assoc 1 (entget(entnext(entnext(car bm))))))
po (vl-string-position (ascii ":") tenlo)
tengoc (substr tenlo 1 (+ po 1))
stt (getint "\nso lo dat bat dau:")
)
  ;;;;;;;;;;;
 (while (setq pt (getpoint "\npick diem:"))
(setq p1 (getpoint "\nChon diem dat Block:")
  p2 (getpoint p1 "\nChon diem 2:")
  ang (/(*(angle p1 p2)180)pi)
  )
(command "-BOUNDARY" pt "")
(setq area (vlax-curve-getArea (entlast)))
(setq st (if (< stt 10) (strcat "0" (rtos stt)) (rtos stt)))
(entdel(entlast))
(command "insert" bn p1 "1" "" (+ ang 90) (rtos area 2 1) (strcat tengoc st))  
(setq	stt (+ stt 1))
)
 (princ)
 )

Download lisp

Filename: 169734_clo.lsp

Tác giả: roberto
Bài viết gốc: 14375
Tên lệnh: show

Giao diện hộp thoại trong AutoLisp

Các bác có thể cho em 1 lisp ví dụ về dialog được không ah . Khi đánh lệnh ABC.. gì đó thì sẽ hiện lên bảng dialog . 1 bên là có 3 dòng với nội dung "hình tròn" "hình vuông" "tam...
>>
Các bác có thể cho em 1 lisp ví dụ về dialog được không ah . Khi đánh lệnh ABC.. gì đó thì sẽ hiện lên bảng dialog . 1 bên là có 3 dòng với nội dung "hình tròn" "hình vuông" "tam giác" , bên kia là slide của 3 hình đó . Khi mình click vào hình slide hay dòng chữ thì sẽ thực thi ngay lệnh chứ không cần phải nhấp ok . Tất nhiên sau khi click sẽ có giai đoạn nhập R đường tròn , cạnh hình vuông hoặc kích thước tam giác .
Lisp này để em học hỏi , chứ nhiều lisp trên máy quá phức tạp và rất dài , em còn học nhiều nên chưa hiểu hết .

Em cảm ơn rất nhiều .

Bạn thu đoạn code này xem,

Tự tạo lay file *.Sld nhé

"htron.sld"

"hvuong.sld"

" htamgiac.sld"

đặt đường dẫn ở đoạn này

" im (strcat "c:\\" image)" trong funtion (fill-im) mình đang để là ổ c:\

Hy vọng giúp được bạn. Mình buông súng lâu rồi nên bây giờ viết chắc củ chuối lắm <_<

Nếu bạn không muốn lặp lại main dialog thì bỏ phần "(while ( >= redia 2 )" ở C:show đi

thuty.dcl
thuty: dialog{
label= "thu image button";
 :boxed_column {
:row{	
:icon_ima{
	key ="tron";
	}
:icon_ima{
	key ="vuong";

	}
:icon_ima{
	key ="tamgiac";

	}
 } //row  
: retirement_button {
		label		   = " Exit  ";
		key			 = "accept";
		is_default	  = true;
  }


 }//boxed_colum
}

// lap mot cai rieng >>> lap lai nhieu lan
icon_ima: image_button {
	color					= 0;
	allow_accept			= true;
	fixed_height			= true;
	fixed_width			 = true;
width 			=25;
height 			=9;

}


hinhtron: dialog{
label="hinh tron";
:edit_box{
	label	= "nhap ban kinh R";
	key	= "bankinh";
	value	= "0.0";

}

ok_cancel;
}

hinhvuong: dialog{
label="hinh vuong";
:edit_box{
	label	= "chieu dai canh";
	key	= "canh";
	value	= "0.0";

}

ok_cancel;

}

hinhtamgiac: dialog{
label="Hinh tam giac";
:edit_box{
	label	= "canh gi cung duoc";
	key	= "canhtamgiac";
	value	= "100.0";

}
:edit_box{
	label	= "goc gi cung duoc";
	key	= "goctamgiac";
	value	= 0.0;

}

ok_cancel;

}
Thuty.lsp
;;; load dialog
(defun loadcl (dia_name)
 (if (= -1 (setq dcl_id (load_dialog (strcat dia_name ".dcl"))))
(progn
  (alert (strcat dia_name ".dcl" "not found")
  (setq dialogloaded nil)
 )		 
) 
(setq dialogloaded 1)
) 
)
;;;=========================
;;; thu tuc dua anh nen 
(defun fill-im (image key / width height im)
(setq 	width (dimx_tile  key)
		  height (dimy_tile key)
;********************* CHU Y *****************************
; dat duong dan den file chua anh - image la anh can dua nen
;************************************************************
	im (strcat "c:\\" image)
	)
(start_image key)
(slide_image 0 0  width height im)  
(end_image)
)
;;; htron , hvuong , htamgiac la anh can dua nen
;;; thu tuc nay chi lam gon chuong trinh 
(defun appear-images ()
 (fill-im "htron" "tron")
 (fill-im "hvuong" "vuong")
 (fill-im "htamgiac" "tamgiac")

)
;;; Load subdialog tranh lap lai nhieu lan 
(defun td (dialogname)
  (if (not (new_dialog dialogname dcl_id)) (exit))
  (start_dialog)
  (done_dialog)
; dat mot so cac function kiem tra va lam viec voi subdialog

);end defun
;;;
;;; Chu y  chi la vi du ve cach hien thi dialog thoi
(defun td1 ()
  (if (not (new_dialog "hinhtron" dcl_id)) (exit))
  (start_dialog)
;CHU Y DAY CHI LA VI DU VE CANH HIEN THI DIALOG THOI
; 2 cach hien thi dialog thi dieu khien sub dialog khac nhau
; do thoi gian co han chi lay vi du thoi.

);end defun
;;;

(defun c:show (/ dcl_id dialogloaded redia r)
 (setq redia 2)
 (loadcl "thuty")
 (if (/= nil dialogloaded)
(progn
   (while ( >= redia 2 )
	  (progn
	  (if (not (new_dialog "thuty" dcl_id)) (exit)); break when error
	  (appear-images)
		  (action_tile  "tron" "(td1)(done_dialog 3)")
		  (action_tile  "vuong" "(setq r $key)(done_dialog 4)")
		  (action_tile  "tamgiac" "(setq r $key)(done_dialog 5)")
	  (action_tile  "accept" "(done_dialog 1)")
			(setq redia (start_dialog))
;;; Co mot so cach de goi Funtion khi tac dong Image
;;; Minh chi gioi thieu 2 cach thoi, khong co thoi gian
;;; Cach 1	  
		  (cond
	((eq r "vuong") (td "hinhvuong"))
	((eq r "tamgiac") (td "hinhtamgiac"))	
	  )
	  (setq r nil)
;;; cach 2
;;;			  (cond
;;;		((= redia 4) (td "hinhvuong"))
;;;		((= redia 5) (td "hinhtamgiac"))	
;;;		  ) 

	  );p
 );w
  (unload_dialog dcl_id)
  );p-f
(print "Error")
 );if  
);defun
Have fun,

Roberto Nguyen

<<

Download lisp

Filename: 14375_show.lsp

Tác giả: Bee
Bài viết gốc: 426199
Tên lệnh: mirror blockatt

Hỏi về cách sử dụng text trong Attribute.

1 giờ trước, Mèo Mun đã nói:

^_^ . Nhưng mà vậy thì hơi auto...
>>
1 giờ trước, Mèo Mun đã nói:

^_^ . Nhưng mà vậy thì hơi auto "tay" quá ạ.

Có hướng giải quyết nào mà chỉ cần Click vô nút Mirror là xong không anh #Bee @@. ??

Còn nếu ko được chắc phải dùng cách của anh thật. :(

Đang rảnh nên nghịch chút cho bạn làm luôn. Dùng lisp thôi ^_^. Bạn tự thêm phần check right or left nhé.
(defun c:mirror_blockatt  ()
  
  (command "select" "all" "")
  (setq remove (ssget "p"))

  (print "MIRROR Select objects: ")
  (if (setq ss (ssget))
    (progn
      (command "mirror" ss "" pause pause "N")

      (command "select" "all" "remove" remove "")
      (setq new (ssget "p"))

      (command "_justifytext" new "" "R")
      )
    )
  (princ)
  )
<<