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

[gia_bach 1.553]

đây là file cad http://www.cadviet.com/upfiles/3/dim1.dwg

đây là file ảnh thao tác mình thực hiện http://www.cadviet.com/upfiles/3/dim_1.jpg

...............

LISP lọc các đuờng kích thuớc theo Tiền tố hoặc hậu tố:

tác giả : Alan J. Thompson

(defun c:DimSearch (/ flt lst n gr)
 ;; By Alan J. Thompson
 (vl-load-com)
 (or *doc*
     (setq *doc* (vla-get-activedocument (vlax-get-acad-object)) ) )
 (if
   (and
     (/= "" (setq flt (strcase (getstring T "\nNhap tien to hay hau to: "))))
     (princ "\nChon kich thuoc : ")
     ((lambda (ss / dims ss)
 (if (setq dims (cond ((ssget '((0 . "DIMENSION"))))
		      ((ssget "_X" '((0 . "DIMENSION"))))  )  )
   (progn
     (vlax-for x (setq dims (vla-get-activeselectionset *doc* ) )
       (if (vl-member-if
	     (function (lambda (s) (wcmatch s flt)))
	     (mapcar (function (lambda (p) (strcase (vlax-get-property x p))))
		     '(TextPrefix TextSuffix)  )  )
	 (setq lst (cons (trans (vlax-get x 'TextPosition) 0 1) lst)
	       ss  (ssadd (vlax-vla-object->ename x) ss) )  )  )
     (vla-delete dims)
     (sssetfirst nil ss)
     (ssget "_I") ) ) )
(ssadd) )
     (setq n -1) )
   (while (and (eq 5 (car (setq gr (grread T 15 0)))) (vl-consp (cadr gr)))
     (redraw)
     (foreach p lst (grdraw (cadr gr) p 1)) ) )
 (redraw)
 (princ))

Chỉnh sửa Tháng 11 15, 2010 theo gia_bach

[nguyenh001 0]

LISP lọc các đuờng kích thuớc theo Tiền tố hoặc hậu tố:

tác giả : Alan J. Thompson

(defun c:DimSearch (/ flt lst n gr)
 ;; By Alan J. Thompson
 (vl-load-com)
 (or (*doc*)
     (setq *doc* (vla-get-activedocument (vlax-get-acad-object)) ) )
 (if
   (and
     (/= "" (setq flt (strcase (getstring T "\nNhap tien to hay hau to: "))))
     (princ "\nChon kich thuoc : ")
     ((lambda (ss / dims ss)
 (if (setq dims (cond ((ssget '((0 . "DIMENSION"))))
		      ((ssget "_X" '((0 . "DIMENSION"))))  )  )
   (progn
     (vlax-for x (setq dims (vla-get-activeselectionset *doc* ) )
       (if (vl-member-if
	     (function (lambda (s) (wcmatch s flt)))
	     (mapcar (function (lambda (p) (strcase (vlax-get-property x p))))
		     '(TextPrefix TextSuffix)  )  )
	 (setq lst (cons (trans (vlax-get x 'TextPosition) 0 1) lst)
	       ss  (ssadd (vlax-vla-object->ename x) ss) )  )  )
     (vla-delete dims)
     (sssetfirst nil ss)
     (ssget "_I") ) ) )
(ssadd) )
     (setq n -1) )
   (while (and (eq 5 (car (setq gr (grread T 15 0)))) (vl-consp (cadr gr)))
     (redraw)
     (foreach p lst (grdraw (cadr gr) p 1)) ) )
 (redraw)
 (princ))

 

Cám ơn bạn gia_bach, đoạn lisp của bạn cung cấp mình sử dụng được rồi, nó chỉ bị 1 lỗi nhỏ ở đoạn (or ("doc") mình phải xóa đi mới chạy được, chắc không ảnh hưởng đến cấu trúc. Về nội dung thì hơi phức tạp đối với mình, nếu bạn giải thích thêm được thì tốt, nếu không mình sẽ nghiên cứu dần dần. :iluvyousmiley:

Thank you very much (Tue_NV,gia_bach,phamthanhbinh)

[gia_bach 1.553]

Cám ơn bạn gia_bach, đoạn lisp của bạn cung cấp mình sử dụng được rồi, nó chỉ bị 1 lỗi nhỏ ở đoạn (or ("doc") mình phải xóa đi mới chạy được, chắc không ảnh hưởng đến cấu trúc. Về nội dung thì hơi phức tạp đối với mình, nếu bạn giải thích thêm được thì tốt, nếu không mình sẽ nghiên cứu dần dần. :iluvyousmiley:

Thank you very much (Tue_NV,gia_bach,phamthanhbinh)

Thanks, đã sữa lỗi (or ("doc")...) -> (or "doc" ...)

Rất tiếc là không có nhiều thời gian để giải thích cho bạn đuợc.

[hugo007 1]

Bác giải thích giùm e trong đoạn code này chỗ nào gán đường kính của các chấm tròn thép và khoảng cách từ tâm chấm tròn này đến thanh thép phía dưới.Và tạo cho các vòng tròn là block ATT.Thanks

Không bác nào giải thích giùm e được sao?

[quan08 0]

Mình thử tạo block ATT cho một hình tròn mà không được.Mong các bác xem chỉnh sửa giùm.Thanks.

http://www.cadviet.com/upfiles/3/ttttt.lsp

[phongthien 0]

giúp mình file cad này với các bác ơi

có thể cắt các chuỗi text màu xanh thành các text nằm ở các lớp khác nhau như trong bản vẽ không.

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

vì khối lượng bản vẽ quá lớn mà mình ngồi gõ lại chắc tới năm sau quá

cám ơn các bác nhiều thật nhiều nhe.

có thể dùng lisp hặcc cách nào khác không vậy

file đính kèm

http://www.cadviet.com/upfiles/3/aaa_2.dwg

[KS.PhanThanhTu 76]

giúp mình file cad này với các bác ơi

có thể cắt các chuỗi text màu xanh thành các text nằm ở các lớp khác nhau như trong bản vẽ không.

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

vì khối lượng bản vẽ quá lớn mà mình ngồi gõ lại chắc tới năm sau quá

cám ơn các bác nhiều thật nhiều nhe.

có thể dùng lisp hặcc cách nào khác không vậy

file đính kèm

http://www.cadviet.com/upfiles/3/aaa_2.dwg

 

Lệnh là TDT http://www.mediafire.com/?hbhhd40hmqr41mg

 

Hoặc chạy luôn file chương trình đó

 

Quét tất cả các text của bản vẽ của bạn nhé , cho khỏe! ^^

bạn test thử nhé, layer như đúng bản vẽ của bạn

 

Nếu có hứng thú nghiên cứu về nó bạn đọc ở blog mình nha (PR tý :iluvyousmiley: ) http://tudaihiep.com/huong-dan-lap-trinh-vba/

[phamngoctukts 714]

Lệnh là TDT http://www.mediafire.com/?hbhhd40hmqr41mg

 

Hoặc chạy luôn file chương trình đó

 

Quét tất cả các text của bản vẽ của bạn nhé , cho khỏe! ^^

bạn test thử nhé, layer như đúng bản vẽ của bạn

 

Nếu có hứng thú nghiên cứu về nó bạn đọc ở blog mình nha (PR tý :iluvyousmiley: ) http://tudaihiep.com/huong-dan-lap-trinh-vba/

Cái của bạn rất hay nhưng hình như chưa đúng với yêu cầu của tác giả. Bạn có tài liệu VBA không thấy bạn làm nhiều chương trình hay nên mình thấy "kết" con VBA này rồi đấy.

[KS.PhanThanhTu 76]

:iluvyousmiley:

Theo như yêu cầu của bạn ấy thì mình nghĩ là chương trình đúng rồi chứ (nếu mình ko hiểu sai ý của bạn ý :D

 

Trước khi chạy lệnh (bản vẽ ban đầu của bạn ý)

Các text thuộc 1 layer có nội dung liền nhau (tức là 1 đối tượng text)

 

 

sau khi chạy lệnh thì tách ra 3 text ở 3 layer khác nhau, có màu khác theo như mẫu của bạn ý

 

:D Về VBA thì cũng chẳng có tài liệu gì mấy, căn bản mình trước hay làm phần mềm bằng VB mà, nên VBA cũng nhanh quen và cũng có thư viện tích lũy được trong quá trình làm trước đây rồi!

[phamvanthiet108 11]

Chào bạn Phamvanthiet108,

Bạn cần nói rõ việc bạn muốn chuyển 1 polyline thành Spline nhằm mục tiêu gì và cái Spline bạn muốn có những đặc điểm gì so với cái polyline ban đầu. Như vậy họa may mới có cách giúp bạn được. Còn trình bày như bạn đã thấy có các cách hiểu khác nhau về yêu cầu của bạn rồi đó, và như thế thì cái kết quả có nhẽ cũng khó mà đúng ý bạn được.

Nếu không bí mật bạn hãy thử post bản vẽ 1 cái polyline ban đầu và cái Spline cuối cùng mà bạn muốn có để mọi người tham khảo bạn nhé...

Muc dich cua Em la E vẽ đường đồng mức bằng Pl nhưng bây giờ em muốn đường đồng mức mền mại hơn một chút thôi.

[phongthien 0]

:iluvyousmiley:

Theo như yêu cầu của bạn ấy thì mình nghĩ là chương trình đúng rồi chứ (nếu mình ko hiểu sai ý của bạn ý :D

 

Trước khi chạy lệnh (bản vẽ ban đầu của bạn ý)

Các text thuộc 1 layer có nội dung liền nhau (tức là 1 đối tượng text)

 

 

sau khi chạy lệnh thì tách ra 3 text ở 3 layer khác nhau, có màu khác theo như mẫu của bạn ý

 

:D Về VBA thì cũng chẳng có tài liệu gì mấy, căn bản mình trước hay làm phần mềm bằng VB mà, nên VBA cũng nhanh quen và cũng có thư viện tích lũy được trong quá trình làm trước đây rồi!

cám ơn anh Phan Thanh Tú Nhiều nhe

đúng ý em rồi đó

nhưng có thể cải thiện thêm 1 chút nữa không anh

vì có nhiều text nằm đứng mà khi chạy lisp thì nó lại nằm ngang

phải dọn lại lần nữa

vì khối lượng bản đồ rất lớn nên mong anh giúp em thêm lần nữa cho nguyện vọng em được trọn vẹn nhe anh.

Cám ơn anh thật nhiều.hihihi

[phamthanhbinh 3.146]

Mình thử tạo block ATT cho một hình tròn mà không được.Mong các bác xem chỉnh sửa giùm.Thanks.

http://www.cadviet.com/upfiles/3/ttttt.lsp

Chào bạn quan08,

Vì sao bạn phải dùng lisp để tạo block thuộc tính mà không dùng CAD??? Nó không những chả nhanh hơn mà có khi còn rối hơn đó....

Việc sử dụng các tham số trong lệnh command bạn nên tìm hiểu kỹ trước khi xài nó vào lisp bạn nhé, Chỉ cần dùng sai trật tự thì lisp sẽ không hiểu đâu bạn ạ. Hãy thận trọng khi xài cái thằng này trong lisp bạn ạ.

Chúc bạn vui.

[KS.PhanThanhTu 76]

cám ơn anh Phan Thanh Tú Nhiều nhe

đúng ý em rồi đó

nhưng có thể cải thiện thêm 1 chút nữa không anh

vì có nhiều text nằm đứng mà khi chạy lisp thì nó lại nằm ngang

phải dọn lại lần nữa

vì khối lượng bản đồ rất lớn nên mong anh giúp em thêm lần nữa cho nguyện vọng em được trọn vẹn nhe anh.

Cám ơn anh thật nhiều.hihihi

 

Đây là bản xoay cả text đứng luôn cho bạn

 

http://www.mediafire.com/?imgsa3rqd5s776f

[phamthanhbinh 3.146]

Muc dich cua Em la E vẽ đường đồng mức bằng Pl nhưng bây giờ em muốn đường đồng mức mền mại hơn một chút thôi.

Chào bạn PhamVanThiet108,

Như vậy có nghĩa là bạn muốn tạo một spline dựa trên các đỉnh có sẵn của một polyline ư ??? Hay là cái Spline này được tạo theo cái tùy hứng của bạn ????

Muốn là Spline hay Spl..... gì gì nữa thì CAD cũng yêu cầu bạn phải cung cấp cho nó những tiêu chí nhất định để tạo hình. Vậy tiêu chí của bạn là chi, bạn nên nói rõ ra thì mọi người mới giúp bạn được, bằng không thì bạn phải tùy hứng mà làm theo cái bạn muốn thôi. Hề hề hề...

[truongthanh 7]

Cho em hỏi có lisp nào giúp dãn dòng text với pline ko ah?

Ví dụ em có các pline và các text nằm song song với pline

giờ em thực hiện lisp:

select object:(select cả text và pline)

yêu cầu nhập khoảng cách mới (khoảng cách giữa Text và pline)

kết thúc lệnh

Em đang phân vân ko biết lisp có hiểu text nào gắn với pline nào ko nữa?Có thể chọn text đang nằm gần pline đó nhất được ko mấy anh?

chi tiết xem file CAD em đính kèm dùm em nhé!

http://www.cadviet.com/upfiles/3/test_7.dwg

Xin cảm ơn các anh rất nhiều!

[quan08 0]

Chào bạn quan08,

Vì sao bạn phải dùng lisp để tạo block thuộc tính mà không dùng CAD??? Nó không những chả nhanh hơn mà có khi còn rối hơn đó....

Việc sử dụng các tham số trong lệnh command bạn nên tìm hiểu kỹ trước khi xài nó vào lisp bạn nhé, Chỉ cần dùng sai trật tự thì lisp sẽ không hiểu đâu bạn ạ. Hãy thận trọng khi xài cái thằng này trong lisp bạn ạ.

Chúc bạn vui.

Mình đang tìm hiểu về lisp vẽ hình bằng lisp thì mình đã hiểu nhưng vẽ hình bằng lisp rồi viết thêm lệnh để tự động thành Block ATT thì mình chưa biết nên hỏi các bác chỉ giùm trong đoạn lisp dưới đây.Thanks.

http://www.cadviet.com/upfiles/3/ttttt.lsp

[phongthien 0]

Đây là bản xoay cả text đứng luôn cho bạn

 

http://www.mediafire.com/?imgsa3rqd5s776f

cám ơn anh phan thanh tú nhiều nhe.đúng ý em 100% rùi đó

anh nhận em làm đệ tử đi

sau này có diệp sẽ thọ giáo anh trong trang tú đại hiệp hé

thank verry verry......

[hatieu 13]

Update : Thống kê Block trong bản vẽ.

Fix : tên Block tiếng Việt .

(defun c:BlkQty (/ blk_id blk_len blk_name blks ent h header_lsp height i j
	 len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
(defun TxtWidth (val h msp / txt minp maxp)
 (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
 (vla-getBoundingBox txt 'minp 'maxp )
 (vla-Erase txt)
 (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
 (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
 (foreach itm (vlax-for itm objTblStyDic
	 (setq tabLst (append tabLst (list itm))))
   (if (not
  (vl-catch-all-error-p
    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
     (setq nameLst (append nameLst (list name)))  )  )
 (if (not (vl-position tbl_name nameLst))
   (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
 (setq objTblSty (vla-item objTblStyDic tbl_name)
TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
 (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
      (list acTitleRow acHeaderRow acDataRow) )
 (vla-setvariable *adoc "CTableStyle" tbl_name) )

(defun GetObjectID (obj)
 (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
   (vlax-invoke-method *util 'GetObjectIdString obj :vlax-false )
   (vla-get-Objectid obj)))  
;main
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
   (progn
     (vl-load-com)
     (setq i -1 len0 8)
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (cdr (assoc 2 (entget ent))))
(if (> (setq blk_len (strlen blk_name)) len0)
  (setq str blk_name len0 blk_len) )	
(if (not (assoc blk_name lst_blk))
  (setq lst_blk (cons (cons blk_name 1) lst_blk))
  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
		       (assoc blk_name lst_blk) lst_blk)))	    )
     (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
     (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
     (initget 6)
     (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))      
     (if h (setq *h* h) (setq h *h*) )
     (or *adoc (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))))
     (setq msp (vla-get-modelspace *adoc)
    *util (vla-get-Utility *adoc)
    blks (vla-get-blocks *adoc))      
     (setq width1 (* 2 (TxtWidth "STT" h msp))
    width (* 2 (TxtWidth "So luong" h msp))
    height (* 2 h))
     (if str
(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
(setq width2 width))
     (if (> h 3)
(setq width (* (fix (/ width 10))10)
      width1 (* (fix (/ width1 10))10)
      width2 (* (fix (/ width2 10))10)
      height (* (fix (/ height 5))5)))
     (GetOrCreateTableStyle "CadViet")
     (setq pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
     (vla-put-regeneratetablesuppressed TblObj :vlax-true)
     (vla-SetColumnWidth TblObj 0 width1)
     (vla-SetColumnWidth TblObj 1 width2)
     (vla-put-vertcellmargin TblObj (* 0.75 h))
     (vla-put-horzcellmargin TblObj (* 0.75 h))
     (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
      (list acTitleRow acHeaderRow acDataRow) )
     (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
      (list acTitleRow acHeaderRow acDataRow))      
     (vla-MergeCells TblObj 0 0 0 4)
     (vla-setText TblObj 0 0 "Bang thong ke")
     (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) 
     (repeat (length header_lsp)
(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
     (setq row 2 i 1)    
     (foreach pt lst_blk
(setq blk_name (car pt) j -1)
(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
	(list i blk_name "cai" (cdr pt)))
(vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true)
(vla-SetCellAlignment TblObj row 1 7)
(vla-SetCellAlignment TblObj row 3 9)
(setq row (1+ row) i (1+ i))	)
     (vla-put-regeneratetablesuppressed TblObj :vlax-false)
     (vlax-release-object TblObj) )  )
 (princ))

 

Mò mãi mà không ra. Bác Gia Bạnh giúp em tạo cái bảng này bằng lisp của bác được không?

Còn đây là file cad của em.

File cad

 

Các chỗ khác vẫn bình thường duy chỉ có cột W và H là khác. Block của em có tên là W x H.

[phamthanhbinh 3.146]

Mình đang tìm hiểu về lisp vẽ hình bằng lisp thì mình đã hiểu nhưng vẽ hình bằng lisp rồi viết thêm lệnh để tự động thành Block ATT thì mình chưa biết nên hỏi các bác chỉ giùm trong đoạn lisp dưới đây.Thanks.

http://www.cadviet.com/upfiles/3/ttttt.lsp

Chào bạn quan08,

Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.

Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.

Hề hề hề,

Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.

Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.

Chúc mừng sự thành công của bạn...

[quan08 0]

Chào bạn quan08,

Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.

Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.

Hề hề hề,

Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.

Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.

Chúc mừng sự thành công của bạn...

Code này chỉ vẽ được hình tròn và số bên trong nhưng đoạn code tạo cho nó thành block ATT vẫn chưa đúng.Mong bác chỉ chỗ sai và sửa lại giùm.Thanks.

[truongthanh 7]

Cho em hỏi có lisp nào giúp dãn dòng text với pline ko ah?

Ví dụ em có các pline và các text nằm song song với pline

giờ em thực hiện lisp:

select object:(select cả text và pline)

yêu cầu nhập khoảng cách mới (khoảng cách giữa Text và pline)

kết thúc lệnh

Em đang phân vân ko biết lisp có hiểu text nào gắn với pline nào ko nữa?Có thể chọn text đang nằm gần pline đó nhất được ko mấy anh?

chi tiết xem file CAD em đính kèm dùm em nhé!

http://www.cadviet.com/upfiles/3/test_7.dwg

Xin cảm ơn các anh rất nhiều!

Mấy anh giúp em với!

[phamthanhbinh 3.146]

Mấy anh giúp em với!

Chào bạn Truongthanh,

Bạn dùng thử lisp này coi sao. Do mình mới viết vội nên chưa hoàn chỉnh lắm, bạn dùng thử và cho ý kiến để mình hoàn chỉnh lại.

(defun c:gtxt ()
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text"))))
       ssl (acet-ss-to-list (ssget (list (cons 0 "lwpolyline"))))
       h (getdist "\n Nhap khoang cach: ") 
)
(foreach x sst
      (setq els (entget x)
              pt (cdr (assoc 11 els))
              g (cdr (assoc 50 els))
              plst (list)

      )
      (foreach y ssl
              (setq obj (vlax-ename->vla-object y)
                      p0 (vlax-curve-getclosestpointto obj pt)
                      dis (distance pt p0)
                      plst (append plst (list (list p0 dis y)))

              )
       )
       (setq plst (vl-sort plst '(lambda (a b ) (                p1 ( polar (caar plst) (+ g (/ pi 2)) h)
               els (subst (cons 11 p1) (assoc 11 els) els)
       )
       (entmod els)
)
)

Chúc bạn vui.

[truongthanh 7]

Chào bạn Truongthanh,

Bạn dùng thử lisp này coi sao. Do mình mới viết vội nên chưa hoàn chỉnh lắm, bạn dùng thử và cho ý kiến để mình hoàn chỉnh lại.

(defun c:gtxt ()
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text"))))
       ssl (acet-ss-to-list (ssget (list (cons 0 "lwpolyline"))))
       h (getdist "\n Nhap khoang cach: ") 
)
(foreach x sst
      (setq els (entget x)
              pt (cdr (assoc 11 els))
              g (cdr (assoc 50 els))
              plst (list)

      )
      (foreach y ssl
              (setq obj (vlax-ename->vla-object y)
                      p0 (vlax-curve-getclosestpointto obj pt)
                      dis (distance pt p0)
                      plst (append plst (list (list p0 dis y)))

              )
       )
       (setq plst (vl-sort plst '(lambda (a b ) (< (cadr a ) (cadr b ))))
               p1 ( polar (caar plst) (+ g (/ pi 2)) h)
               els (subst (cons 11 p1) (assoc 11 els) els)
       )
       (entmod els)
)
)

Chúc bạn vui.

Dạ chào anh Bình!Trước tiên em xin cảm ơn anh đã quan tâm đến yêu cầu của em!

Em đã test thử rồi! Lisp đã đúng ý em! Chỉ có vấn đề nhỏ bé tẹo là sau khi thực hiện xong trong dòng command hiện 1 đống text lên ko biết đó là gì vậy anh!

Xin chân thành cảm ơn anh!

[quan08 0]

Chào bạn quan08,

Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.

Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.

Hề hề hề,

Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.

Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.

Chúc mừng sự thành công của bạn...

Lisp vẽ hình tròn và chèn text vào hình tròn e đã hiểu,nhưng ý e là viết thêm dòng code nào để khi chèn text vào hình tròn

thì hình tròn này và text sẽ là block ATT.Mong bác chỉ giúp.Thanks

(defun C:TTT ()
(setq bk (getvar "USERR3"))
(if (= bk 0)
 (progn
   (setq cont "1")
   (setvar "USERR3" 1)
   )
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap"  "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500 "")
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(command "line" pt6 pt7 "")
(command "line" pt3 pt5 "")
(command "line" pt8 pt9 "")
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
 (setq bk (getvar "USERR3"))
)
 (setvar "USERR3" bk)
 )
(command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC"  "VHELVCN.TTF" "" "" "" "" "")
(command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "") 
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move")
)
(princ)

[phamngoctukts 714]

Lisp vẽ hình tròn và chèn text vào hình tròn e đã hiểu,nhưng ý e là viết thêm dòng code nào để khi chèn text vào hình tròn

thì hình tròn này và text sẽ là block ATT.Mong bác chỉ giúp.Thanks

(defun C:TTT ()
(setq bk (getvar "USERR3"))
(if (= bk 0)
 (progn
   (setq cont "1")
   (setvar "USERR3" 1)
   )
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap"  "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500 "")
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(command "line" pt6 pt7 "")
(command "line" pt3 pt5 "")
(command "line" pt8 pt9 "")
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
 (setq bk (getvar "USERR3"))
)
 (setvar "USERR3" bk)
 )
(command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC"  "VHELVCN.TTF" "" "" "" "" "")
(command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "") 
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move")
)
(princ)

Bạn thay dòng (command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "") bằng (command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")

Mình sửa cho bạn như thế này bạn xem được chưa

;; free lisp from cadviet.com

(defun C:TTT ( / vt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11)
(setq vt (ssadd))
(setq bk (getvar "USERR3"))
(if (= bk 0)
 (progn
   (setq cont "1")
   (setvar "USERR3" 1)
   )
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap"  "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500)
(setq vt (ssadd (entlast) vt))
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt6 pt7 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt3 pt5 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt8 pt9 "")
(setq vt (ssadd (entlast) vt))
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
 (setq bk (getvar "USERR3"))
)
 (setvar "USERR3" bk)
 )
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC"  "VHELVCN.TTF" "" "" "" "" "")
(command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")
(setq vt (ssadd (entlast) vt))
(if (= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" pt1 vt "")
)
(if (/= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" "y" pt1 vt "")
)
(command "insert" "ghichu" pt1 bk bk "0" "A")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move" (entlast) "" pt1)
)
(princ)