- page 329

Info

File

Tác giả: ssg
Bài viết gốc: 73981
Tên lệnh: np

Bác Ssg à, Bác có thể cải tiến hơn 1 chút nữa là sau khi dùng lệnh np sẽ vẽ được đường pline 1 cách bình thường,ở đây e thấy lisp này chỉ nỗi thêm 1 đường line,...
>>
Bác Ssg à, Bác có thể cải tiến hơn 1 chút nữa là sau khi dùng lệnh np sẽ vẽ được đường pline 1 cách bình thường,ở đây e thấy lisp này chỉ nỗi thêm 1 đường line, nếu mình muốn vẽ nối tiếp nhiều đường thì bất tiện quá, cảm ơn bác nhiều nhiều nha!!

Bạn thử lại với cái này xem sao:
;;;----------------------------------------------------------
(defun C:NP( / p1 ss e1 Lp p2 p e2) ;;;Noi tiep pline
(setq
 p1 (getpoint "\nChon diem cuoi line, pline hoac arc:")
 ss (ssget "c" p1 p1 '((0 . "LINE,LWPOLYLINE,ARC")))
 e1 (ssname ss 0)
 Lp (list p1)
)
(while (setq p2 (getpoint p1 "\nChon diem tiep theo (hoac Enter de ket thuc):"))
 (grdraw p1 p2 255)
 (setq Lp (append Lp (list p2)) p1 p2)
)
(command "pline") (foreach p Lp (command p)) (command "")
(setq e2 (entlast))
(if (= (cdr (assoc 0 (entget e1))) "LWPOLYLINE")
 (command "pedit" e1 "j" e2 "" "")
 (command "pedit" e1 "y" "j" e2 "" "")
)
(command "regen")
)
;;;----------------------------------------------------------
<<

Download lisp

Filename: 73981_np.lsp

Tác giả: Tue_NV
Bài viết gốc: 168638
Tên lệnh: xolt

Lập lisp quay đối tượng

Bạn nqt sử dụng Code này thử nhé :


(defun c:xolt(/ goc ngon s angmau ang leng d1 d2 d3 d4)
(setq Lay "HATCH")
(setq s  (car (entsel "Pick vao doi tuong chan Line mau :")))
(setq angmau (angle (acet-dxf 10 (entget s)) (acet-dxf 11 (entget s))))
(setq ang (acet-rtod (getangle "\n Nhap goc quay :")))

(setq leng (vlax-curve-getendparam s) )

(ACET-ERROR-INIT (LIST (LIST "OSMODE" 0) T))
(foreach x (acet-ss-to-list (ssget (list (cons 0 "LINE") (cons 8...
>>

Bạn nqt sử dụng Code này thử nhé :


(defun c:xolt(/ goc ngon s angmau ang leng d1 d2 d3 d4)
(setq Lay "HATCH")
(setq s  (car (entsel "Pick vao doi tuong chan Line mau :")))
(setq angmau (angle (acet-dxf 10 (entget s)) (acet-dxf 11 (entget s))))
(setq ang (acet-rtod (getangle "\n Nhap goc quay :")))

(setq leng (vlax-curve-getendparam s) )

(ACET-ERROR-INIT (LIST (LIST "OSMODE" 0) T))
(foreach x (acet-ss-to-list (ssget (list (cons 0 "LINE") (cons 8 Lay))) )
(setq y (entget x))
(setq goc (acet-dxf 10 y))
(setq ngon (acet-dxf 11 y))
  (if (equal (angle goc ngon) angmau 0.001)
    (Progn
(setq d1 (polar (vlax-curve-getpointatdist x (/ leng 10.0)) (+ angmau (/ pi 2.0)) (/ leng 7.0)  ) 
    d2 (polar (vlax-curve-getpointatdist x (/ leng 10.0)) (+ angmau (/ pi -2.0)) (/ leng 7.0) )
    d3 (polar (vlax-curve-getpointatdist x (/ leng 1.20)) (+ angmau (/ pi -2.0)) (/ leng 7.0) )
    d4 (polar (vlax-curve-getpointatdist x (/ leng 1.20)) (+ angmau (/ pi 2.0)) (/ leng 7.0) ) 
)
(command "rotate" (ssget "cp" (list d1 d2 d3 d4) 
(list (cons 0 "LINE,TEXT") (cons 8 Lay))
) ""
goc ang)
    )
  )
)

(ACET-ERROR-RESTORE)
)

- Cách sử dụng :

1. Lisp hỏi "Pick vao doi tuong chan Line mau :" Bạn chọn chân đường Line mẫu (tức là chọn 1 đường Line mẫu nằm giữa Text màu đỏ và Text màu trắng)

2. Nhập góc quay. Ví dụ trong hình của bạn post lên là 28.3874 độ. Chú ý số lẻ thập phân để Lisp quay cho đẹp

3. Dựa vào Line mẫu ở trên, Lisp sẽ hỏi bạn chọn các kiểu Line giống y như thế đã quay

-> Lisp sẽ giải quyết vấn đề của bạn

Chúc buổi sáng tốt lành

Download lisp

Filename: 168638_xolt.lsp

Tác giả: TayNgang09
Bài viết gốc: 170348
Tên lệnh: catdm

Trim giữa 2 đối tượng

Tui mới tham gia diễn đàn. Các bác thử dùng đoạn này xem sao

;;;======================== Cat bo cac duong o giua 2 duong duoc chon


(defun C:CatDM ( / LwuBien EnCat1 EnCat2 Con DuongDM Cuoi1 Dau1 Cuoi2 Dau2 Thang1 Thang2 CaoDo )
   (setq LwuBien (list (getvar "cmdecho")
  									     (getvar "osmode")))

   (setvar "cmdecho" 0)
   (setvar "osmode" 	0)
   (WHILE (not EnCat1)
       (setq EnCat1 (car (entsel "\nCh\U+1ECDn...
>>

Tui mới tham gia diễn đàn. Các bác thử dùng đoạn này xem sao

;;;======================== Cat bo cac duong o giua 2 duong duoc chon


(defun C:CatDM ( / LwuBien EnCat1 EnCat2 Con DuongDM Cuoi1 Dau1 Cuoi2 Dau2 Thang1 Thang2 CaoDo )
   (setq LwuBien (list (getvar "cmdecho")
  									     (getvar "osmode")))

   (setvar "cmdecho" 0)
   (setvar "osmode" 	0)
   (WHILE (not EnCat1)
       (setq EnCat1 (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng c\U+1EAFt th\U+1EE9 nh\U+1EA5t: ")))
   )
   (setq    Dau1 (car (ACET-GEOM-OBJECT-END-POINTS EnCat1))
  		     Cuoi1 (cadr (ACET-GEOM-OBJECT-END-POINTS EnCat1)))
   (redraw EnCat1 3)
   (WHILE (not EnCat2)
       (setq EnCat2 (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng c\U+1EAFt th\U+1EE9 hai: ")))
   )
   (setq Dau2 (car (ACET-GEOM-OBJECT-END-POINTS EnCat2))
  		     Cuoi2 (cadr (ACET-GEOM-OBJECT-END-POINTS EnCat2))
  		     Con T)
   (redraw EnCat2 3)
   (if (inters Dau1 Dau2 Cuoi1 Cuoi2 t)
       (setq Dau2 (cadr (ACET-GEOM-OBJECT-END-POINTS EnCat2))
  			     Cuoi2 (car (ACET-GEOM-OBJECT-END-POINTS EnCat2)))
   )
   (command ".line" Dau1 Dau2 "")
   (setq Thang1 (entlast))
   (redraw Thang1 2)
   (command ".line" Cuoi1 Cuoi2 "")
   (setq Thang2 (entlast))
   (redraw Thang2 2)
   (while Con
       (setq DuongDM (entsel "\nCh\U+1ECDn \U+0111o\U+1EA1n c\U+1EA7n c\U+1EAFt b\U+1ECF gi\U+1EEFa hai \U+0111\U+01B0\U+1EDDng < ENTER \U+0111\U+1EC3 thôi c\U+1EAFt > : "))
       (if DuongDM
  	     (command ".Trim" EnCat1 EnCat2 Thang1 Thang2 "" "e" "n" DuongDM "")
  	     (setq Con nil)
       )
   )
   (command ".erase" Thang1 Thang2 "")
   (redraw EnCat1 4)
   (redraw EnCat2 4)
   (setvar "cmdecho" (nth 0 LwuBien))
   (setvar "osmode" 	(nth 1 LwuBien))
   (princ)
)
;;;========================

Download lisp

Filename: 170348_catdm.lsp

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

Lisp chỉnh sửa nội dung text

vẫn chỉ như bài viết này thôi

Text của bác trên có dạng ABC-123

Nhưng text của em chỉ là ABC123

thì sửa lisp của...
>>
vẫn chỉ như bài viết này thôi

Text của bác trên có dạng ABC-123

Nhưng text của em chỉ là ABC123

thì sửa lisp của bác như thế nào

Cảm ơn bác đã trả lời em

@Ketxu: không thấy Ket giúp nên nghĩ chắc Ket bận, đành liều giúp vậy, có gì thì srr nhé!

Bạn dùng cái này thì Text có các kiểu tiền tố và hậu tố hay số nguyên và số thực đều OK

P/S: loay hoay viết, đến khi xong, thì Ket đã xong rồi, srr Ket.
(defun C:HA( / num txtm)	;Doan Van Ha CADViet.com
(setq num (getreal "\nNhap so can them/bot: "))
(princ "\nChon cac Text can thay doi...")
(foreach ent (acet-ss-to-list (ssget '((0 . "*TEXT"))))
 (setq txtm (acet-str-replace (cadr (chia3 (cdr (assoc 1 (entget ent)))))
                                      			(rtos (+ num (atof (cadr (chia3 (cdr (assoc 1 (entget ent))))))) 2 (get-sle (cadr (chia3 (cdr (assoc 1 (entget ent)))))))
                                      			(cdr (assoc 1 (entget ent)))))
 (entmod (subst (cons 1 txtm) (cons 1 (cdr (assoc 1 (entget ent)))) (entget ent)))))
(defun get-sle (str)
(if (not (acet-str-find "." str)) 0 (- (strlen str) (acet-str-find "." str))))
(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)))))
<<

Download lisp

Filename: 171730_ha.lsp

Tác giả: thietke08
Bài viết gốc: 463654
Tên lệnh: ib

Nhờ sửa lisp chèn block trong một file khác vào bản vẽ

Hiện mình đang tạo lisp để chèn một block trong một bản vẽ có chứa các block thư viện bằng lệnh -INSERTCONTENT tuy nhiên nó báo lỗi không thực hiện được như nhập lệnh trực tiếp trong CAD.

Nhờ mọi người biết cách sửa giúp và chèn thêm điểm chèn bằng cách pick điểm trên bản vẽ. Xin cảm ơn.

Lisp hiện tại là

>>

Nhờ mọi người biết cách sửa giúp và chèn thêm điểm chèn bằng cách pick điểm trên bản vẽ. Xin cảm ơn.

Lisp hiện tại là

;INSERT BLOCK LAYER
(defun c:IB	()	(command "-INSERTCONTENT"	""U:\04 CAD\05 DIGITAL LIBRARY\K_LSTEAM-TEMPLATE 2022.dwg"" "K-LA-LAYER-DIM-TABLE-LEADER"	"0,0" "0" "1"))

Download lisp

Filename: 463654_ib.lsp

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

Lisp chèn text vào Pl

Về dải text là ok rùi. còn vấn đề này mọi người xem làm thế nào?

có thể chọn text rùi chèn...
>>
Về dải text là ok rùi. còn vấn đề này mọi người xem làm thế nào?

có thể chọn text rùi chèn vào 1 chỗ bất kỳ trên pl ko?

Quick code :
(defun c:test(/ curve txtObj pt ang)
(if
(and
 (setq curve (car(entsel "\nCurve:")))
 (setq txtObj (car (entsel "\nText :"))) 
 (setq txtObj (vlax-ename->vla-object txtObj))
 (setq txtObj (vla-copy txtObj))
 (setq pt (vlax-curve-getClosestPointTo curve (trans (getpoint "\nPoint to Insert :") 0 1)))
 (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve pt))))
 (setq pt (vlax-3d-point pt))
)
(progn
 (if (= (vla-get-Alignment txtObj) 0)
                           	(vla-put-InsertionPoint txtObj pt)
                           	(vla-put-TextAlignmentPoint txtObj pt)
   	)
 (vla-put-Rotation txtObj ang)
)
)
)
<<

Download lisp

Filename: 169583_test.lsp

Tác giả: nhimret
Bài viết gốc: 447761
Tên lệnh: ii

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Tôi có lisp bo viền 1 khung tên, nhưng mỗi lần chỉ được 1 khung tên

(defun c:ii (/ eName mn mx)
 (vl-load-com)
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 (if (setq eName (car (entsel "\n  >>  Select Object  >> ")))
   (progn
     (vla-getboundingbox (vlax-ename->vla-object eName) 'mn 'mx)
     (vl-cmdf "._rectang"...
>>

Tôi có lisp bo viền 1 khung tên, nhưng mỗi lần chỉ được 1 khung tên

(defun c:ii (/ eName mn mx)
 (vl-load-com)
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 (if (setq eName (car (entsel "\n  >>  Select Object  >> ")))
   (progn
     (vla-getboundingbox (vlax-ename->vla-object eName) 'mn 'mx)
     (vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))))
 (princ))

Nhờ các bác tư vấn hộ có cách nào chọn 1 loạt khung tên để nó bo viền 1 loạt không. Cám ơn rất nhiều.

Download lisp

Filename: 447761_ii.lsp

Tác giả: npham
Bài viết gốc: 170439
Tên lệnh: mcm1

Vẽ mặt cắt móng

Mình sửa tạm theo kiểu chắp vá bạn dùng đỡ, rãnh rỗi làm cái hộp thoại nhập số liệu chứ nhập kiểu này mỏi tay quá.

 


;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq kc (/ (- (distance pd pc) d) (- n 1)))
(command ".line" pd pc "")

(setq  a (angle pd pc)
 pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
)

(repeat n
 (command...
>>

Mình sửa tạm theo kiểu chắp vá bạn dùng đỡ, rãnh rỗi làm cái hộp thoại nhập số liệu chứ nhập kiểu này mỏi tay quá.

 


;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq kc (/ (- (distance pd pc) d) (- n 1)))
(command ".line" pd pc "")

(setq  a (angle pd pc)
 pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
)

(repeat n
 (command ".donut" 0 d pd c^)
 (setq pd(polar pd a kc))
)
;;(command ".donut" 0 d (polar pc (+ a (* pi 0.75)) d) c^)
(setvar "osmode" old)
)
;;Ham ve thep dai va thep chiu luc cua dam mong
(defun vdai (p1 a b n1 n2 d)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(command ".rectangle" p1 (list (+ (car p1) a) (+ (cadr p1) B)))
(setq  kc (/ (- a d) (- n1 1))
 p1 (list (+ (car p1) (/ d 2)) (+ (cadr p1) (/ d 2)))
)
;(princ n1)
(setq p p1)
(repeat n1
 (command ".donut" 0 d p c^)
 (setq p (polar p 0 kc))
);end of repeat1
(setq p (polar p1 (/ pi 2) (- b d)))
(repeat n1
 (command ".donut" 0 d p c^)
 (setq p (polar p 0 kc))
);end of repeat2
(setq  kc (/ (- b d) (- n2 1)))
(setq p (polar p1 (/ pi 2) kc))
(repeat (- n2 1)
 (command ".donut" 0 d p c^)
 (setq p (polar p (/ pi 2) kc))
);end of repeat3
(setq p (polar p1 0 (- a d)))
(setq p (polar p (/ pi 2) kc))
(repeat ( - n2 1)
 (command ".donut" 0 d p c^)
 (setq p (polar p (/ pi 2) kc))
);end of repeat4

(setvar "osmode" old)
)
;; Chuong trinh chinhs vex mc mongs
(defun c:mcm1 ()
(initget 1 "MC MB")
  (setq res (getkword "\n<M.BANG/M.COT><MB/MC>:"))
(setq   p1 (getpoint "\nDiem chen:")
 l1 (getreal "\nBe rong mong:")
 l2 (getreal "\nBe rong co mong:")
 l3 (/ (- l1 l2) 2)
 h1 (getreal "\nChieu cao ben mong:")
 h2 (getreal "\nChieu cao phan nghieng:")
 h3 (getreal "\nChieu cao co mong:")
 bv (getreal "\nBe day lop bao ve:")
 d (getreal "\nDuong kinh thep:")
 n (getint "\nS.luong thep day mong:")
)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (polar p1 pi 100))
(setq p (polar p (/ (- 0 pi) 2) 100))
(command  ".rectangle" p (list (+ (car p) 200 l1) (+ (cadr p) 100)))
(command  ".pline" p1 "W" 0 0 (setq p (polar p1 (/ pi 2) h1)) (setq p (list (+ (car p) l3) (+ (cadr p) h2))) (setq p (polar p (/ pi 2) h3)) ""
)
(command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) "")

(IF (= res "MB")
 (progn
  (setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
  	pc (polar pd 0 (* (- l1 (* 4 bv) l2) 0.5))
)
 (mcthep pd pc d (fix (* n 0.5)))

 (command ".line" pc (setq pc (polar pc 0 (+ l2 (* 2 bv))))  "")
 (setq pd (polar pd 0 (- l1 (* 2 bv))))

(mcthep pc pd d (fix (* n 0.5)))
  (setq  p (list (+ (car p1) l3 bv) (+ (cadr p1) d bv))
a (- l2 (* 2 bv))
b (- (+ h1 h2 h3) (* 2 bv) d)
n1 (getint "\nS.luong thep ngang dam mong:")
n2 (getint "\nS.luong thep doc dam mong:")
  )
  (vdai p a b n1 n2 d)
 );end of progn1
 (progn
	(setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
 pc (polar pd 0 (- l1 (* 2 bv)))
)
(mcthep pd pc d n)
  (setq p (list (+ (car p1) l3 bv (- 0 (* 10 d))) (+ (cadr p1) (* 2 d) bv))); end of setq
  (command ".pline" p "W" 0 0  (setq p (polar p 0 (* 10 d)))
(setq p (polar p (/ pi 2) (+ h1 h2 h3 (* 20 d) (- 0 (* 2 d)  bv))))
(setq p (polar p (/ (- 0 pi) 4) (* 2 d))) ""
  ); end of co
  (command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) ""  ); end of co
 );end of progn2

); end of if
(setvar "osmode" old)
)

Download lisp

Filename: 170439_mcm1.lsp

Tác giả: tien2005
Bài viết gốc: 463700
Tên lệnh: tdt

Lỗi khi sử dụng lisp cad tính diện tích

Các Bạn dùng thử cái này

(defun c:tdt ( / dtl pt ent ss)
  (vl-load-com)
  (or #tl (setq #tl (getreal "\nMau so ti le ban ve: ")))
  (or #htxt (setq #htxt (getreal "\nChieu cao text: ")))
  (or #sole (setq #sole (getint "\nSo le: ")))
  (setq dtl 0)
  (setq ss (ssadd))
  (while (and (setq pt (getpoint "\nPick internal point : "))
	      (vl-cmdf "_.-boundary" pt "")
	      (setq ent (entlast))
	     ...
>>

Các Bạn dùng thử cái này

(defun c:tdt ( / dtl pt ent ss)
  (vl-load-com)
  (or #tl (setq #tl (getreal "\nMau so ti le ban ve: ")))
  (or #htxt (setq #htxt (getreal "\nChieu cao text: ")))
  (or #sole (setq #sole (getint "\nSo le: ")))
  (setq dtl 0)
  (setq ss (ssadd))
  (while (and (setq pt (getpoint "\nPick internal point : "))
	      (vl-cmdf "_.-boundary" pt "")
	      (setq ent (entlast))
	      (vl-cmdf "_.-hatch" "_s" ent "" "_P" "ANSI31" 2 0 "")
	      )
    (setq ss (ssadd ent ss)
	  ss (ssadd (entlast) ss)
	  )
    (setq dtl (+  dtl (vla-get-area (vlax-ename->vla-object ent))))
    )
  (and (/= dtl 0)
       (setq pt (getpoint "\nPoint to write: "))
       (entmake	(list
		  (cons 0 "TEXT")
;;;		  (cons 8 layer)
		  (cons 1 (rtos (/ dtl #tl #tl) 2 #sole))
;;;		  (cons 7 style)
		  (cons 10 pt)
		  (cons 40 #htxt)
		  )
		)
       (vl-cmdf "_.erase" ss "")
       )
  (princ)
  )

Download lisp

Filename: 463700_tdt.lsp

Tác giả: thiep
Bài viết gốc: 71615
Tên lệnh: ctru

Cho em hỏi cách trải mặt của một hình chiếu của mặt cong ,nghiêng

Xin lỗi anh là Nam hay nữ ??? Có một vấn đề nhỏ sao anh trình bầy cứ như là ...lần đầu tiên đến nhà ra mắt bố mẹ vợ tương lai ứ!
Theo câu chữ của anh thì người...
>>
Xin lỗi anh là Nam hay nữ ??? Có một vấn đề nhỏ sao anh trình bầy cứ như là ...lần đầu tiên đến nhà ra mắt bố mẹ vợ tương lai ứ!
Theo câu chữ của anh thì người ta có thể vẽ hình chiếu của của nước thải trong cống hình trụ thẳng đứng như sau:

Hình ảnh em là hình tròn (mặt bằng), em vẽ đa giác 24 cạnh > Dóng lên mặt đứng> Chỉ đơn giản vậy thôi! Ko biết có đúng ý của anh ko???

Haanh mới ở Hà Tiên về, sao mà nóng nảy vậy? Đi xa về làm cho hình ảnh của em tròn vo rồi!

Nói đùa vậy thôi, vẫn có mã lisp cho tuyluypden và cho các bạn đây:
;;;---------------------------------
;;; LISP chieu hinh tru. COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun SAVE_MODE ()
 (command "Undo" "begin")
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "plinegen" 1)
 (setvar "OSMODE" 0)
)
(defun RESTORE ()
 (command "Undo" "end")
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
(defun c:ctru ()
 (SAVE_MODE)
 (setq	enL1 (car (entsel "\nPick Line dau tru: "))
enL2 (car (entsel "\nPick Line cuoi tru: "))
Pa1  (vlax-curve-getStartPoint enL1)
lay  (cdr (assoc 8 (entget enL1)))
Pb1  (vlax-curve-getEndPoint enL1)
D1   (distance Pa1 Pb1)
Pa2  (vlax-curve-getStartPoint enL2)
Pb2  (vlax-curve-getEndPoint enL2)
D2   (distance Pa2 Pb2)
an1  (angle Pa1 Pb1)
an2  (angle Pa2 Pb2)
n    1
 )
 (setq	k (cond	(k)
	(5)
  )
 )
 (setq oldk k)
 (setq	k
 (getint
   (strcat "\n So khoang chia:  <"
	   (itoa oldk)
	   "> : "
   )
 )
 )
 (if (null k)
   (setq k oldk)
 )
 (command "undo" "be")
 (setvar "clayer" lay)
 (repeat (- k 1)
   (setq a    (* n (/ pi k 2))
  dis1 (* D1 (sin a) (sin a))
  dis2 (* D2 (sin a) (sin a))
  p1   (polar pa1 an1 dis1)
  p2   (polar pa2 an2 dis2)
   )
   (entmake (list (cons 0 "LINE")
	   (cons 10 p1)
	   (cons 11 p2)
     )
   )
   (setq n (1+ n))
 )
 (command "undo" "end")
 (RESTORE)
 (princ)
)
<<

Download lisp

Filename: 71615_ctru.lsp

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

xin lisp xoay, dóng block theo trục X

Vào lúc 19/4/2022 tại 15:34, tạ hoàn đã nói:

Rất mong các cao...
>>
Vào lúc 19/4/2022 tại 15:34, tạ hoàn đã nói:

Rất mong các cao thủ giúp em.

Hiện trạng: Block sau khi insert ra thì bị xoay nhẹ, đang dùng lệnh Align để xoay dóng, rất mất tg khi số lượng Block nhiều

Y/C: Để 1 cạnh thẳng bất kỳ của block căng theo trục X nhiều Block (bỏ qua block tròn) , nhanh hơn lệnh Align

dóng block.dwg

Có 2 trường hợp:

1. Các đối tượng trong block nó đã lệch với phương X khi insert ra góc Block =0 thì nó vẫn lệch. => cái này phải có thêm điều kiện nhận cạnh nào để xoay.

2. Các đối tượng trong block không lệch phương X khi insert ra góc Block /=0 thì nó lệch => cái này thì đủ điều kiện. là đưa góc Block về =0 hoặc insert lại block đó với góc =0.

Test cái này cho TH số 2.
(defun c:zz  (/ ss i n ent blk_name  blk_point  )
(command ".undo" "BE") 
(setq ss (ssget (list (cons 0 "INSERT"))))
(setq i 0)
(setq n (sslength ss) )
(while (< i n)
(setq ent (ssname ss i))
(setq blk_name (cdr (assoc 2 (entget ent))))
(setq blk_point (cdr (assoc 10 (entget ent))))
(princ blk_point)
(command ".insert" blk_name blk_point 1 1 0)
(setq i (1+ i))
)
(command "ERASE" ss "")
(command ".undo" "E")
(princ)
)
<<

Download lisp

Filename: 463755_zz.lsp

Tác giả: hamster2102
Bài viết gốc: 206192
Tên lệnh: tkd

: lisp sao chép số liệu kích thước

Hi. Chúc bạn vui lới LISP mà mình chế này

Code lisp trên diễn đàn rất nhiều bạn cứ mày mò học lỏm và sửa chữa cũng vui lắm...

Hi. Chúc bạn vui lới LISP mà mình chế này

Code lisp trên diễn đàn rất nhiều bạn cứ mày mò học lỏm và sửa chữa cũng vui lắm đó.hi


;; free lisp from cadviet.com
;;; Edit by mathan
----------------------------------------------
(defun C:tkd ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq TP (getint (strcat "\nSo chu so thap phan :")))
(setq tapx '() tapy '() stt '())

;;; Phan dim
(setq ktra "OK")
(While (= ktra "OK")
(setvar "osmode" 125)
(setq DD (getpoint"\nPick diem dau"))
(setq TDD (getstring"\nNhap ten diem dau:"))
(setq DC (getpoint"\nPick diem cuoi"))
(setq TDC (getstring"\nNhap ten diem cuoi:"))
 (setvar "osmode" 0)

 (setq kc (distance DD DC))

 (setq textdim (rtos kc 2 tp))
 (setq textdiem (strcat TDD "-" TDC))
 (setq ghichu "Do thuc te")
 (command "_DIMALIGNED" DD DC (getpoint"\nDiem dat dim"))
 (setq ktra (getstring"\nBan muon tiep tuc  - dung lai :"))
 (if (= ktra "S") (setq ktra "NOT OK") (setq ktra "OK"))

(setq  
 tapx (append tapx (list textdim))
   tapy (append tapy (list ghichu))
   stt  (append stt (list textdiem))
);setq
);;end while

;;;;;;;;;;;;; Phan lap bang thong ke
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuat bang toa do?  <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di 10
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
 PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
   p1 (list (car PT) (+ (cadr PT)(* 2 h)))
   p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
   p3 (list (car p1) (+ (cadr p1)(* 2 h)))
   p4 (list (car p2) (+ (cadr p2)(* 2 h)))
  PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
  PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
  PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
   p11 (list (+ (/ di 2) (car p1))  (+ (* 1.1 h) (cadr p1)))
   p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
   p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
   L1 (list (+ di (car p3))(cadr p3))
   L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
  n (length tapx)
  k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
"text" "m" p11 h 0 "Diem do"
"text" "m" p22 h 0 "Chieu dai"
"text" "m" p33 h 0 "Ghi chu"
"text" "m" pTB (* 1.3 h) 0 "Bang thong ke chieu dai dim")  
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt
     "text" "m" PTX h 0 xx
     "text" "m" PTY h 0 yy
 "CECOLOR" 3
     "line" PT PTC "")  
(setq  PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq  PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n by Thaistreetz - Edit by Mathan")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

Chúc công việc của bạn sẽ thuận lợi hơn với lisp này.

ôi thank bác nhiều lắm, em đang dự định học lisp đây ,diễn đàn nhiều anh tài quá lại nhiệt tình nữa, chúc bác lên lv vù vù nhé, hic cảm ơn không chắc chưa đủ ^^

Download lisp

Filename: 206192_tkd.lsp

Tác giả: npham
Bài viết gốc: 169198
Tên lệnh: hcn

Vẽ hình chữ nhật

Day ban.

 

(defun c:hcn (/ p1 p2 p3 p4 p5 p6 p7 h B)
(if (and
 	(setq h (getreal "\nH:"))
 	(setq b (getreal "\nb:"))
 	(setq p3 (getpoint "\nPoint:"))
 	)
 (progn

(setq p2 (polar p3 (* pi 0.5) (+ h 21))
 	p1 (polar p2 (* pi 1.75) 66)
 	p4 (polar p3 0 B)
 	p5 (polar p4 (* pi 0.5) h)
 	p6 (polar p5 pi (+ b 21))
 	p7 (polar p6 (* pi 1.75) 66))
(command "pline" p1 p2 p3 p4 p5 p6 p7 "")
(princ)
)
 )
 )

Download lisp

Filename: 169198_hcn.lsp

Tác giả: qh2qa06
Bài viết gốc: 317272
Tên lệnh: ttl ttk

Xin lisp tính chiều dài trung bình và DL của thanh thép biến thiên

- hi nhoc đã sữa lại theo ý bạn, làm tròn lmin lmax trước rùi mới tính ltb để tránh sai số ko đáng có, bạn test thử vài...

- hi nhoc đã sữa lại theo ý bạn, làm tròn lmin lmax trước rùi mới tính ltb để tránh sai số ko đáng có, bạn test thử vài trường hợp xem có còn sai ko

- nay nhoc mới thấy phần hỏi thêm của bạn nên nhoc viết lun, cai chọn thanh có L ko đổi, chung 1 lsp lệnh ttk

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 sl info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distof (rtos (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1))) 2 3))
	 )
  )
)  
 ;=========================================================
(prompt "Chon thanh co chieu dai lon nhat:")
(setq lmax (ssget "+.:E:S" '((0 . "LINE"))))
(if lmax
 (progn
    (setq ename2 (ssname lmax 0)
	      info2 (entget ename2)
		  dai2  (distof (rtos (distance (cdr (assoc 10 info2)) (cdr (assoc 11 info2))) 2 3))
	 )
  )
)  
;===========================================================
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq ltb (distof (rtos (/ (+ dai1 dai2) 2.0) 2 3)))
(if (= (- ltb (fix ltb)) 0.5)
(setq ltb (+ ltb 0.5))
ltb
)
(setq ldelta (* (/ (- dai2 dai1) (- sl 1)) 1000))
;==============================================================
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e1)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) "`14,L =" (rtos (* ltb 1000) 2 0))) (assoc 1 e1) e1))
;===============================================================
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e2)) "DIMENSION")
(prompt "doi tuong ban chon ko phai la dim, ban chon lai hen!!!")
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
)
(entmod (subst (cons 1 (strcat (rtos (* dai1 1000) 2 0) "~" (rtos (* dai2 1000) 2 0) ", \U+0394L=" (rtos ldelta 2 0))) (assoc 1 e2) e2))
;======================================================================
(setvar "osmode" old)
(princ "\n")
(princ)
)
;===============================chon thanh co chieu dai ko doi edit vao text co san
(defun c:ttk(/ lx ename3 info3 dai3 e3 old sl)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai khong doi:")
(setq lx (ssget "+.:E:S" '((0 . "LINE"))))
(if lx
 (progn
    (setq ename3 (ssname lx 0)
	      info3 (entget ename3)
		  dai3 (distof (rtos (distance (cdr (assoc 10 info3)) (cdr (assoc 11 info3))) 2 3))
	 )
  )
)
(setq sl (getint "\nSo luong thanh mun tinh:"))
;====================================================
 (setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e3)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) "`14,L =" (rtos (* dai3 1000) 2 0))) (assoc 1 e3) e3))
(setvar "osmode" old)
(princ "\n")
(princ)
)

Lsp đã hoàn chỉnh. Cảm ơn bạn rất nhiều!

Trong Lisp "ttk", nếu muốn chọn đường kính thép (hiện ở đây đang là fi 14), bạn cho thêm câu lệnh hỏi "Nhập đường kính thép" (8, 10, 12, 14, 16,...) rồi mới đến các lệnh khác, bạn sửa giúp mình thêm lệnh này được không? Tks.

Download lisp

Filename: 317272_ttl_ttk.lsp

Tác giả: thaycung
Bài viết gốc: 99910
Tên lệnh: toado

Ghi tọa độ?

(DEFUN EXCUTE(/ n P TX TY)
 (setq str (strcat "\nPhan so le muon lay  (press Enter or Space for get default): "))
 (setq n (getint str))
 (if (/= n Nil)
(setq sl n)	
 )  
 (While...
>>
(DEFUN EXCUTE(/ n P TX TY)
 (setq str (strcat "\nPhan so le muon lay  (press Enter or Space for get default): "))
 (setq n (getint str))
 (if (/= n Nil)
(setq sl n)	
 )  
 (While T
(setq P Null)
(princ "\nPick a point or press ESC for exit:")
(setq P (getpoint))
(if (/= P Nil)
  (progn
(setq TX (rtos (Car P) 2 sl))
(setq TY (rtos (Cadr P) 2 sl))
(command "-INSERT" "TD" P "1" "1" "0" TX TY)
  )	  
)  
 );End While  
)
(DEFUN INIT()
 (if (= sl Nil)
(setq sl 2)
 )  
)
(DEFUN C:TOADO()
 (INIT)
 (EXCUTE)
)
Tải thêm cái này về:

http://www.cadviet.com/upfiles/TD.zip
Tôi là người mới nhập diễn đàn, vẽ acad còn chậm, mong mọi người trợ giúp.

với đoạn mã trên, có cách nào hiển thị thêm các ký tự (ví dụ: "X=" hay "Y=") ở đầu các chữ số ghi tọa độ không?

<<

Download lisp

Filename: 99910_toado.lsp

Tác giả: Mèo Mun
Bài viết gốc: 419950
Tên lệnh: cpt

Nhờ Viết Lisp Rải Text Dạng Số

Quick code
(defun c:cpt(/ ss pt1)
  (setq pt1 (getpoint "\nChon diem goc copy : "))
 ...
>>
Quick code
(defun c:cpt(/ ss pt1)
  (setq pt1 (getpoint "\nChon diem goc copy : "))
  (setq ss (car (entsel "\n Chon Text:")))
 
  (while (and ss pt1)
    (command "._copy" ss "" pt1 (setq pt1 (getpoint pt1 "\n diem dich copy :")  ))
    (setq ss (entlast))
    (command "Textedit" "L" "") 
  )
)
Với cad đời cao: (Mình đang dùng cad 2015)

Thì lệnh _.ddedit dường như không phù hợp, nên không chạy được như ý muốn.

Thử lại lệnh gốc : Textedit thì ok.

<<
Download lisp
Filename: 419950_cpt.lsp

Tác giả: truongthanh
Bài viết gốc: 66775
Tên lệnh: ist

Viết Lisp theo yêu cầu

Yêu cầu càng lúc càng nhiều hỉ :s_big: . Sửa thêm lần nữa.

(defun c:ist(/ chu os obj ndai p1 p2 pm ang)
 (vl-load-com)
 (if (not kc) (setq kc 1))
 (setq kc1 (getreal...
>>

Download lisp

Filename: 66775_ist.lsp

Tác giả: saycaphe
Bài viết gốc: 419210
Tên lệnh: test2

Lisp Tự Mirror, Sau Đó Join Các Đường Đã Mirror

Để nguyên Pline sau khi join trên mặt phẳng XoY. Chạy lisp mới chọn những pline trước sau đó chọn Line // trục X với điểm bắt...
>>
Để nguyên Pline sau khi join trên mặt phẳng XoY. Chạy lisp mới chọn những pline trước sau đó chọn Line // trục X với điểm bắt đầu từ trục Y trở đi để tính 1 điểm cắt với pline thôi nhé. Sau khi move hết theo trục Z xuống cách 1 khoảng 500 thì xoay toàn bộ đối tượng sau nhé. Chúc ngon miệng ^_^
(defun LM:intersections	(ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
	   (vlax-method-applicable-p ob2 'intersectwith)
	   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
    (repeat (/ (length lst) 3)
      (setq rtn	(cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	    lst	(cdddr lst)
      )
    )
  )
  (reverse rtn)
)
(vl-load-com)

(defun c:test2 ()
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (command "undo" "be")
  (princ "\nChon doi tuong: ")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (if (setq line_X (car (entsel "\nChon doan thang // X: ")))
	(progn
	  (setq	lst_e (vl-remove-if
			'listp
			(mapcar 'cadr (ssnamex ss))
		      )
	  )
	  (setq lst_pt nil)
	  (foreach e lst_e
	    (setq pt (LM:intersections
		       (vlax-ename->vla-object e)
		       (vlax-ename->vla-object line_X)
		       acextendnone
		     )
	    )
	    (setq lst_pt (cons (cons e (car pt)) lst_pt))
	  )
	  (vl-sort lst_pt '(lambda (e1 e2) (< (cadr e1) (cadr e2)))) ;
	  (setq n 500)
	  (foreach pl (cdr lst_pt)
	    (command "move"
		     (car pl)
		     ""
		     "0,0,0"
		     (strcat "0,0,-" (rtos n 2 0))
	    )
	    (setq n (+ n 500))
	  )
	)				;progn line_X
	(princ "\nBan da khong chon doan thang // X.")
      )					;if
    )					;progn ss
    (princ "\nBan da khong chon doi tuong.")
  )					;if

  (command "undo" "end")
  (setvar "osmode" osm)
  (princ)
)					;defun
Đại ca ơi.

ý em là move từng đường 1,không kể màu, vì thực thế cứ 4 đường màu đỏ, đến 1 đường màu xanh, đấy chỉ là hình thức đánh dấu thôi, chứ ý em không phải là move màu đỏ xong, rồi move màu xanh.

Thay đổi thế nào để move theo độ tăng lên củatọa độ giao điểm của đường được chọn với các polylines.

Làm sao để chọn khoảng cách move đường trong mặt x0y theo 0z (hiện tại đang là 500) ạ
<<
Download lisp
Filename: 419210_test2.lsp

Tác giả: duonghung1210
Bài viết gốc: 86472
Tên lệnh: draw name

viết lisp thống kê bản vẽ

Đã viết xong Lisp thống kê tên các bản vẽ , nhưng ngại vấn đề bảo hành và link như ý của Nataca nên chưa post lên.

Ban chạy thử và cho ý kiến.

Đã viết xong Lisp thống kê tên các bản vẽ , nhưng ngại vấn đề bảo hành và link như ý của Nataca nên chưa post lên.

Ban chạy thử và cho ý kiến.

(defun c:draw_name (/ att doc i kyhieu lst lstatt msp pt row ss tblobj ten) ;Bang ten ban ve
;;  By : Gia Bach, Copyrightｩ December 2009                   ;;
;;  Contact : gia_bach @  www.CadViet.com                     ;;
 (defun VxGetAtts (Obj)
 (mapcar
   '(lambda (Att)
      (cons (vla-get-TagString Att)
     (vla-get-TextString Att) ) )
   (vlax-invoke Obj 'GetAttributes) ))
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn

 (if (setq ss (ssget "_A"(list (cons 0 "INSERT")(cons 66 1)(cons 2 "KHUNG CHUAN SEICO"))))
   (progn
     (vl-load-com)
     (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
    msp (vla-get-modelspace doc))
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq lstAtt (VxGetAtts (vlax-ename->vla-object e))
      kyhieu (cdr (assoc "DWNNO" lstAtt))
      ten (cdr (assoc "DRAWING1" lstAtt)))
(setq lst (cons (cons kyhieu ten) lst))	   )
     (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)) ) ))
     (setq i 1
    row 2
    pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 15 100))
     (vla-put-vertcellmargin TblObj 4)
     (vla-SetColumnWidth TblObj 0 50)
     (mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
      (list acTitleRow acHeaderRow acDataRow)	      )
     (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
      (list acTitleRow acHeaderRow acDataRow))
     (vla-setText TblObj 0 0 "list of drawings")      
     (vla-setText TblObj 1 0 "STT")
     (vla-setText TblObj 1 1 "Ten ban e")
     (vla-setText TblObj 1 2 "Ky hieu")
     (foreach pt lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (cdr pt))
(vla-setText TblObj row 2 (car pt))
(setq row (1+ row) i (1+ i))
)
     (vlax-release-object TblObj)
     (princ)  )  )  )
 (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
 ))

Sau khi mò mẫn đã em đã chỉnh được lish theo khung tên của em nhưng do không có chế độ select nên vẫn còn nhiều bất tiện ( khi tạo bảng thì không theo thứ tự như mình muốn ). Bác nào có thể thêm chế độ select vào hộ em được không ạ?? em cảm ơn.

Đây là lisp cho khung tên của em: http://www.cadviet.com/upfiles/2/draw_name_sua.lsp

Download lisp

Filename: 86472_draw_name.lsp

Tác giả: npham
Bài viết gốc: 121129
Tên lệnh: ar%2B

Kết hợp lệnh ar (array) và ct (lệnh coppy tịnh tiến)

Thông thường ta sử dụng lệnh ar để tạo mảng và ct để coppy tịnh tiến (lisp ct có trên 4r)
Mình có một bảng muốn đánh số từ 1 đến 100 theo cột dọc, mà khoảng...
>>
Thông thường ta sử dụng lệnh ar để tạo mảng và ct để coppy tịnh tiến (lisp ct có trên 4r)
Mình có một bảng muốn đánh số từ 1 đến 100 theo cột dọc, mà khoảng cách giữa các số này là giống nhau, cùng bằng 5 đvị chẳng hạn

Bây giờ để cho nhanh, mình muốn ar sô 1 (số đầu tiên của chuỗi) mà các số sau tịnh tiến theo đúng nguyên tắc của lisp ct thì làm thế nào?

Bạn thử xem code này được không. Nó array luôn 1 dòng bạn chọn.

Mình quên cho array luôn cái line (dòng kẻ). bạn thêm vào nhé
;Lisp by nPham - www.cadviet.com
(defun copy+ (ss row / ename ent i number str p ssnew)  
(setq j 0)
(setq ssnew (ssadd))
(while 
	(setq ename (ssname ss j))  
(setq ent (entget ename))
(setq str (cdr (assoc 1 ent)))
(setq i 1)
	(while (< i (+ (strlen str) 1))
	  (if (not (wcmatch (substr str i) "*@*"))
		(progn
		  (setq number (substr str i))
		  (setq i 10000)
		  )
			(setq i (1+ i))
	  )
  )
   (if number (setq str (strcat (substr str 1 (- (strlen str) (strlen number)))
			(if (vl-string-search  " " number) " " "")
			(itoa (+ (atoi number) 1)))))	
	(setq ent (subst (cons 1 str) (assoc 1 ent) ent))	  
	(setq p  (cdr (assoc 10 ent)))
	(setq ent (subst (cons 10 (polar p (* pi 1.5) row)) (assoc 10 ent) ent))
  (setq p  (cdr (assoc 11 ent)))
  (setq ent (subst (cons 11 (polar p (* pi 1.5) row)) (assoc 11 ent) ent))
	(entmake ent)
	(entupd ename)	  
	(setq ssnew (ssadd (entlast) ssnew ))
 (setq j (1+ j))
 )
 ssnew 
)

(defun c:ar+ (/ ss num row)
(setq ss (ssget (list (cons 0 "TEXT"))))
(setq num (getint "\nSo luong dong:"))
(setq row (getint "\nKhoang cach dong:"))

(repeat num (setq ss (copy+ ss row)))
(redraw)  
(princ)
)
<<