Jump to content
InfoFile
Tác giả: nhatphong
Bài viết gốc: 308465
Tên lệnh: tkt
cho em xin lisp đếm text

Cách này mình vẫn đang dùng.

Cách làm như sau: Chon một layout (cái layout nào cũng được) sau đó đè phím Shift+ click chuột...

>>

Cách này mình vẫn đang dùng.

Cách làm như sau: Chon một layout (cái layout nào cũng được) sau đó đè phím Shift+ click chuột chọn tất cả các Layout cần in... click chuột phải chon "Publish Selected Layouts" ---> hiện cái bảng ---> chọn tiếp Publish (hoặc Enter). Xong. Đi cafe, hút thuốc tý lấy bản vẽ...

Nhưng để làm được việc này thì: các layout của bạn phải có cùng định dạng: máy in, khổ giấy, nét in..... tốt nhất, trước khi lồng layout, bạn lồng trước 1 cái "LÀM MẪU".. sau đó in thử.. thấy ok thì dùng cái layout này Copy thành nhiều cái layout khác và edit....

:)

 

 

Không hiểu ý bạn.

- chức năng cho phép đếm 1 đối tượng : ý bạn là đếm các LINE, ARC, ... ?

Nếu đúng, bạn có thể sử dụng Tools -> Palettes -> Properties để xem.

hoặc tham khảo Lisp Thống kê Block : http://www.cadviet.com/forum/index.php?sho...ost&p=94041

 

Lisp Thống kê Text trên bản vẽ .

Bổ sung sắp xếp TEXT và tạo bảng (Table)

tkt_1.jpg

(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); thong ke text;;  By : Gia Bach, Copyrightゥ December 2010                    ;;;;  Contact : gia_bach @  www.CadViet.com                      ;;  (defun TxtWidth (val msp / txt minp maxp)    (vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)    (vla-Erase txt)    (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )  ;main  (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)    (progn      (vl-load-com)      (princ "\nChon cac Text de thong ke :")      (if (setq ss (ssget(list (cons 0 "TEXT"))))	(progn	  (setq i -1 len0 8)	  (while (setq ent (ssname ss (setq i (1+ i))))	    (setq str(cdr(assoc 1 (entget ent ))))	    (if (> (setq str_len (strlen str)) len0)	      (setq str0 str len0 str_len) )	    (if (not (assoc str lst))	      (setq lst (cons (cons str 1) lst))	      (setq lst (subst (cons str (1+ (cdr (assoc str lst))))			       (assoc str lst) lst)))	    )	  (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))		msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))	  (or *h* (setq *h* 175))	  (initget 6)	  (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))	  (if h (setq *h* h) (setq h *h*) )	  (setq width0 (* 3 h(TxtWidth "STT" msp))		height (* 2 h))	  (if str0	    (setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))	    (setq width1 (* 2 h(TxtWidth "Gia tri" msp))))	  (if (> h 3)	    (setq width0 (* (fix (/ width0 10))10)		  width1 (* (fix (/ width1 10))10)		  height (* (fix (/ height 5))5)))	  (setq pt (getpoint "\nDiem dat Bang :")		TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width1))	  (vla-put-regeneratetablesuppressed TblObj :vlax-true)	  (vla-put-vertcellmargin TblObj (* 0.25 h))	  (vla-put-horzcellmargin TblObj (* 0.75 h))	  (vla-SetColumnWidth TblObj 0 width0)	  (vla-SetColumnWidth TblObj 2 (* 2 h(TxtWidth "So luong" msp)))	  (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))		  (list acTitleRow acHeaderRow acDataRow) )	  (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))		  (list acTitleRow acHeaderRow acDataRow))	  (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 2)) )))	  (vla-setText TblObj 0 0 "Bang thong ke")	  (vla-setText TblObj 1 0 "STT")	  (vla-setText TblObj 1 1 "Gia tri")	  (vla-setText TblObj 1 2 "So luong")	  (setq i 1 row 2 )	  (foreach e lst	    (vla-setText TblObj row 0 (itoa i))	    (vla-setText TblObj row 1 (car e))	    (vla-setText TblObj row 2 (cdr e))	    (vla-SetCellAlignment TblObj row 1 7)	    (vla-SetCellAlignment TblObj row 2 9)	    (setq row (1+ row) i (1+ i))	)	  (vla-put-regeneratetablesuppressed TblObj :vlax-false)	  (vlax-release-object TblObj)	  )	(alert "Khong chon duoc Text.")    )      (princ)  )    (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")   )  )

Mình down về rồi dùng lệnh tkt của bác gia bạch không dùng được,hay tại phiên bản autocad 2014 không dùng được lisp này


<<

Filename: 308465_tkt.lsp
Tác giả: hung1608
Bài viết gốc: 379573
Tên lệnh: eb
Lisp Thay Đổi Height Và Width Factor Của Text Attribute Trong Block

Hy vọng là được (Khuyến mại thêm Textstyle): :D​

(defun c:eb (/ get-gc put-gc getvalue *error* att curcmd...
>>

Hy vọng là được (Khuyến mại thêm Textstyle): :D​

(defun c:eb (/ get-gc put-gc getvalue *error* att curcmd dcledittext dcl_id editext file_dcl hei oldhei oldval oldwid str wid dialog taolist

lststy possty sty)

(setq *error* (defun my-err (msg)

(cond ((= msg "function cancelled") (princ "\t\tuser abort"))

(t (progn (princ msg) (princ))))

(setq *error* nil)

(princ)))

(defun get-gc (group entity) (cdr (assoc group (entget entity))))

(defun put-gc (value group entity / properties)

(setq properties (entget entity))

(setq properties (subst (cons group value) (assoc group properties) properties))

(entmod properties))

(defun getvalue ()

(setq str (get_tile "text")

hei (atof (get_tile "hei"))

wid (atof (get_tile "wid"))

sty (atoi (get_tile "sty"))))

(defun taolist (kieu / kieu nl lkq)

(setq lkq '())

(setq nl (tblnext kieu t))

(while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)))

lkq)

(vl-load-com)

(setq dcledittext (list

"edit: dialog {label = \"CHANGE TEXT PROPERTIES\";initial_focus = \"text\";"

":edit_box {label = \"String:\"; allow_accept = true; edit_width = 45; key = \"text\";}" ": row {"

":edit_box {label = \"Height:\"; allow_accept = true; edit_width = 8; key = \"hei\";}"

":edit_box {label = \"Width:\"; allow_accept = true; edit_width = 8; key = \"wid\";}"

":popup_list {allow_accept = true; edit_width = 12; key = \"sty\";}" "}" "spacer_1;" "ok_cancel;}"))

(setq curcmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(while (/= (setq att (car (nentselp "\nselect attribute for edit: "))) nil)

(if (or (= (get-gc 0 att) "ATTRIB") (= (get-gc 0 att) "TEXT"))

(progn (setq oldval (get-gc 1 att)

oldhei (rtos (get-gc 40 att) 2 (getvar 'LUPREC))

oldwid (rtos (get-gc 41 att) 2 2)

oldsty (get-gc 7 att)

lststy (taolist "STYLE")

possty (vl-position oldsty lststy))

(setq editext.dcl (vl-filename-mktemp "edittext.dcl")

file_dcl (open editext.dcl "w"))

(foreach ll dcledittext (write-line ll file_dcl))

(close file_dcl)

(if (> 0 (setq dcl_id (load_dialog editext.dcl)))

(progn (alert "not found file edittext.dcl") (exit)))

(if (not (new_dialog "edit" dcl_id))

(progn (alert "not found edit dialog") (exit)))

(set_tile "text" oldval)

(set_tile "hei" oldhei)

(set_tile "wid" oldwid)

(set_tile "sty" (rtos possty))

(start_list "sty" 3)

(mapcar 'add_list lststy)

(end_list)

(action_tile "accept" "(getvalue)(setq dialog 1)(done_dialog)")

(action_tile "cancel" "(setq dialog nil)")

(start_dialog)

(unload_dialog dcl_id)

(if (eq dialog 1)

(progn (put-gc str 1 att) (put-gc hei 40 att) (put-gc wid 41 att) (put-gc (nth sty lststy) 7 att))))

(princ "select attrib/text")))

(if editext.dcl

(vl-file-delete editext.dcl))

(setvar "cmdecho" curcmd)

(setq *error* nil)

(princ))

Tuyệt vời bạn ơi

Thanks


<<

Filename: 379573_eb.lsp
Tác giả: thanhduan2407
Bài viết gốc: 98098
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD

Bạn chạy thử :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
 (defun...
>>
Bạn chạy thử :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
 (defun Split (Str Char / Lst pos)
   (while (setq pos (vl-string-search Char Str))
     (if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
     (setq Str (substr Str (+ pos 2)) ))
   (setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
     (or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
     (or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
    (setq data (split Line "\t" )
	  val (car data)
	  pt  (cdr data))
    (if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
      (progn
	(setq pXY (list (car pt)(cadr pt)))
	(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
	(vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")
	(vla-put-Alignment str 8)
	(vla-put-TextAlignmentPoint str (vlax-3d-point pXY))
	(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo")	)))))  ))
 (princ))

Cảm ơn bạn Gia_Bach rất nhiều nhưng mình thấy file muốn fun điểm lên bản vẽ phải đúng theo một khuôn mẫu nhất định. Mình rất mong rằng file mà bạn fun điểm lên bản vẽ chấp nhận các thông số SST X Y Z Code được phân biệt nhau bởi cả dấu " " (dấu cách) , dấu tab, dấu phẩy....

Nếu bạn lập được 1 hàm tách xâu phân biệt được các thông số đó thì chèn các ký hiệu trắc địa vào bản vẽ là bình thường.

Mình đang vướng mắc vấn đề đó.

Mong các bạn giúp đỡ mình


<<

Filename: 98098_rft.lsp
Tác giả: khaosat2009
Bài viết gốc: 97036
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD

Bạn chạy thử :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
 (defun...
>>
Bạn chạy thử :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
 (defun Split (Str Char / Lst pos)
   (while (setq pos (vl-string-search Char Str))
     (if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
     (setq Str (substr Str (+ pos 2)) ))
   (setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
     (or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
     (or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
    (setq data (split Line "\t" )
	  val (car data)
	  pt  (cdr data))
    (if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
      (progn
	(setq pXY (list (car pt)(cadr pt)))
	(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
	(vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")
	(vla-put-Alignment str 8)
	(vla-put-TextAlignmentPoint str (vlax-3d-point pXY))
	(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo")	)))))  ))
 (princ))

Cám ơn Anh Gia_bach, Lisp rất hay.

Nhờ anh chình thêm : người dùng chọ chiều cao chữ vì khi theo tỉ lệ bản đồ cho phù hợp.

Điểm point cách xa text cao độ một chút.

** Và vấn đề này nữa :

1. Khi đo đạc mình không thể đặt điểm đểu khắp trên khu đo vậy cần phải cấy thêm điểm mia vào, chọn vị trí trên mành hỉnh, thì lisp ghi nhận toạ độ X , Y của điểm đó, Yêu cầu nhập vào số thứ tự điểm, cao độ, thì thể hiện ra trên mành hình. ----> Các Điểm thêm bổ sung trên sẻ được ghi nối vào file toạ độ **.txt cũ ở trên.

2. Nội suy cao độ : Nội suy qua 3 text , chọn 3 text cao độ và chọn vị trí cần nội suy thì tính cho ra điểm point và text cao độ, yêu cầu : nhập số thứ tự vào. ----> Các Điểm thêm bổ sung trên sẻ được ghi nối vào file toạ độ **.txt cũ ở trên.

3. Hoặc là sau khi nhập điểm bổ sung hay nội suy ở các điểm. Ta chọn hết các điểm để xuất ra 1 file text hoàn chỉnh sau cùng.

Rất mong được anh giúp.


<<

Filename: 97036_rft.lsp
Tác giả: 790312
Bài viết gốc: 401591
Tên lệnh: sl
Lisp Rãi Thép Sàn

(defun c:SL ( / a1 c)
(setq luu (getvar "osmode"))
(setq lay (getvar "clayer"))
;(command "layer" "s" "Defpoints"...
>>
(defun c:SL ( / a1 c)
(setq luu (getvar "osmode"))
(setq lay (getvar "clayer"))
;(command "layer" "s" "Defpoints" "")
;(command "osnap" "Perp,Near")
(setq a1 (getdist "\nCh\U+1ECDn kho\U+1EA3ng r\U+1EA3i th\U+00E9p: ")) 
(or (and a (or (= (type a) 'int) (= (type a) 'real))) (setq a 200))
(setq a (cond ((getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch thanh th\U+00E9p <" (rtos a 2 2) ">:"))) (a)))
(or (and hbv (or (= (type hbv) 'int) (= (type hbv) 'real))) (setq hbv 10))
(setq hbv (cond ((getreal (strcat "\nduong kinh thep <" (rtos hbv 2 2) ">: "))) (hbv)))
(setq c (+ (/ a1 a) 1))
(while (setq ent (nentsel "\nCh\U+1ECDn ghi gi\U+00E1 tr\U+1ECB (Text ho\U+0103c ATT):" ))
(and (wcmatch (cdr (assoc 0 (entget (car ent)))) "ATTRIB,*TEXT")
(vla-put-textstring (vlax-ename->vla-object  (car ent)) (strcat (rtos c 2 0) "%%c" (rtos hbv 2 0) "a" (rtos a 2 0) ) )))
(SETVAR "clayer" lay)
(setvar "osmode" luu)
(princ)
)

Mình dùng font khi đánh phi phải đánh Alt+222 chứ không phải %%c thì sửa lisp như thế nào?


<<

Filename: 401591_sl.lsp
Tác giả: ngkcuong
Bài viết gốc: 203281
Tên lệnh: tl
LISP tính toán chiều dài đoạn thẳng

Lisp tính tổng chiều dài của mọi đối tượng có thuộc tính chiều dài (line, pline, spline, arc, circle, ellipse). Lệnh TL:

 

>>

Lisp tính tổng chiều dài của mọi đối tượng có thuộc tính chiều dài (line, pline, spline, arc, circle, ellipse). Lệnh TL:

 

;;;--------------------------------------------------------------------(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)));;;--------------------------------------------------------------------(defun C:TL( / ss L e)(setq    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))    L 0.0)(vl-load-com)(while (setq e (ssname ss 0))    (setq L (+ L (length1 e)))    (ssdel e ss))(alert (strcat "Total length = " (rtos L))));;;--------------------------------------------------------------------

Cám ơn bác nhiều.


<<

Filename: 203281_tl.lsp
Tác giả: toai
Bài viết gốc: 68608
Tên lệnh: tn
Nhờ diễn đàn sửa lisp ghi khoảng cách, cao độ trên cắt ngang
Đây là lisp mình đã rút gọn lại. đồng thời sửa thêm một số chi tiết về nhập số liệu và chế độ bắt điểm để thuận tiện hơn khi sử dụng. Lisp cũng...
>>
Đây là lisp mình đã rút gọn lại. đồng thời sửa thêm một số chi tiết về nhập số liệu và chế độ bắt điểm để thuận tiện hơn khi sử dụng. Lisp cũng đã tự động load các block cần thiết. bạn chỉ cần copy bản vẽ này vào thư mục D:\Lisp CAD là OK.

(Chú ý là không sử dụng bản vẽ BV1 của bạn nữa nhé. vì các block hơi xấu khi canh lề text, đông thời bản vẽ đó có mấy block không sử dụng nhưng mình không có cách gì purge nó đi được nên lisp load rất chậm)

(defun DXF (code elist)
 (cdr (assoc code elist))
)

(defun c:tn (); / DZ pt y ptside ang OT sc1 scale)
 (vl-load-com)
 (setvar "cmdecho" 0)

(if (not scale) (setq scale 1))
(setq sc1 (getreal (strcat "\n Cao text <"(rtos scale 2 0)">:")))
(if sc1 (setq scale sc1))
(SETQ OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien  : ") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXF 1 ed)))	
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))

(While (/= pt nil)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq y (- (cadr pt) y0 (- H0)))
(setq x (- (car pt) x0))

(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
	 ((< x 0) (setq x (rtos (abs x) 2 2)))
	 ((= x 0) (setq x "0.00"))		 )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
	 ((< y 0) (setq y (rtos y 2 2)))
	 ((= y 0) (setq y "%%p0.00")))
;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))

(if (not (tblsearch "block" "LCD1"))
(progn (command "insert" "D:\\Lisp CAD\\BVTN.dwg" "" "" "" "")
(command "erase" (entlast) "")))

( if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "LCD1" pt scale scale "0" x y))
( if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "LCD2" pt scale scale "0" y x))
( if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "LCD3" pt scale scale "0" x y))
( if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "LCD4" pt scale scale "0" y x))

(setq pt (getpoint "\nDiem chen: "))
);pro
);while 
(setvar "OSMODE" OSLAST)
(setvar "DIMZIN" DZ)
(setvar "ORTHOMODE" OT))
;---------------------------------------------------------------------------

Bạn ơi, có một điều nữa bạn xem lại giúp: kết quả cao độ và k.c được xác định từ đoạn lisp bạn đã sửa chỉ có thể đúng với bản vẽ có TL 1:1 thôi, các TL khác thì sai bạn ạ. Nhân tiện bạn update thêm ý kiến của Mr Tue_NV để lisp đó có một "kết quả" như ý của anh em được không? :s_dead:


<<

Filename: 68608_tn.lsp
Tác giả: hoan2182
Bài viết gốc: 151288
Tên lệnh: cen
Giúp em sao xác định đuợc tâm của đa giác?

Cám ơn bạn nhiều! mình dùng lệnh và đã xác định được tọa độ tâm đa giác, nhưng mình muốn vẽ được từ cái tâm đa giác đó luôn...

>>

Cám ơn bạn nhiều! mình dùng lệnh và đã xác định được tọa độ tâm đa giác, nhưng mình muốn vẽ được từ cái tâm đa giác đó luôn ý. rất mong được bạn quan tâm!

Cách 1: Dùng lisp

Đã sửa lại. Cac bạn chạy thử xem :

(defun centre(dt / cen)
;;copyright by Tue_NV
 (vl-load-com)
 (if (or (= (cdr(assoc 0 (entget dt))) "REGION") 
     	(and (wcmatch (cdr(assoc 0 (entget dt))) "*POLYLINE")
      (= (cdr(assoc 70 (entget dt))) 1)
        )
     )
      (if (and (wcmatch (cdr(assoc 0 (entget dt))) "*POLYLINE")
      (= (cdr(assoc 70 (entget dt))) 1)
          )
 (Progn
   (setq cen (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object)))
     		'addregion (list (vlax-ename->vla-object dt)))) 'Centroid))
   (entdel (entlast))
 )
 (setq cen (vlax-get (vlax-ename->vla-object dt) 'Centroid))
       )

 )    
 cen
)
(defun c:cen() (centre (car(entsel "\n Pick chon doi tuong lay trong tam :"))))

Mình sợ đặt lệnh chữ C trùng với lệnh của các bạn.

Các bạn sử dụng lệnh CEN để tìm trọng tâm

Trong 1 lệnh khác để tìm trọng tâm của 1 đa giác bất kì nhấn 'CEN

 

Cách 2: làm thủ công

 

Bước 1:-Biến đa giác thành region

 

Bước 2: Gõ lệnh Masspr >>> Chọn đối tượng region >>> sẽ hiện ra bảng cho biết các thông số về trọng tâm của Region

 

Bước 3: Gõ Esc 2 lần >>gõ tiếp F2 >>hiện ra bảng ....> Gõ lệnh L (line) Copy giá trị x, y vào dòng commad ...Xong.

 

Hoan3.jpg

hình 3

hoan4.jpg

Command: l LINE Specify point : 168.6778,4.7964 (lưu ý có dấu phẩy ở giữa x,y)

Hình 4

 

Hoan5.jpg

hình 5

 


<<

Filename: 151288_cen.lsp
Tác giả: hailuavnn
Bài viết gốc: 96066
Tên lệnh: db
Xin lisp về đếm block
Bạn dùng thử lisp này. Lệnh DB, nó chạy y như ý bạn muốn:

 

;;;------------------------------------------------
(defun ss2ent(ss / sodt index ent lstent)
(setq
   sodt...
>>
Bạn dùng thử lisp này. Lệnh DB, nó chạy y như ý bạn muốn:

 

;;;------------------------------------------------
(defun ss2ent(ss / sodt index ent lstent)
(setq
   sodt (if ss (sslength ss) 0)
   index 0
)
(repeat sodt
   (setq
       ent (ssname ss index)
       index (1+ index)
       lstent (cons ent lstent)
   )
)
(reverse lstent)
)
;;;------------------------------------------------
(defun C:DB( / ss Le fn f e Le Ln Bn old X Res) ;;;Dem so luong Blocks
(setq
   ss (ssget '((0 . "INSERT")))
   Le (ss2ent ss)
   fn (getfiled "Save As" "" "txt" 1)
   f (open fn "w")
)
(foreach e Le (setq Ln (append Ln (list (cdr (assoc 2 (entget e)))))))
(foreach Bn Ln
   (if (setq old (assoc Bn Res))
       (setq Res (subst (cons bn (1+ (cdr old))) old Res))
       (setq Res (append Res (list (cons Bn 1))))
   )
)
(princ "KET QUA:\n\n" f)
(foreach X Res  (princ (strcat (car X) " = " (itoa (cdr X)) "\n") f))
(close f)
(startapp "notepad" fn) 
(princ)
)
;;;------------------------------------------------

 

Rất cám ơn, bài viết của bạn rất có ích cho mọi người


<<

Filename: 96066_db.lsp
Tác giả: minhee
Bài viết gốc: 20822
Tên lệnh: exptxt
export tập điểm text thành file đuôi .txt
lệnh là EXPTXT

(defun c:exptxt()
 (setq
   ss (ssget '((0 . "TEXT")))
   fn (getfiled "Ten file: " "" "txt" 1)
f (open fn "w")
   lst (ss2ent ss)
 )
 (foreach e lst
   ...
>>
lệnh là EXPTXT

(defun c:exptxt()
 (setq
   ss (ssget '((0 . "TEXT")))
   fn (getfiled "Ten file: " "" "txt" 1)
f (open fn "w")
   lst (ss2ent ss)
 )
 (foreach e lst
    (setq tt (entget e)
   p (cdr (assoc 10 tt))
   x (rtos (car p))
   y (rtos (cadr p))
   z (cdr (assoc 1 tt))

    )
    (write-line (strcat x " " y " " z) f)
 )
 (close f)
 (princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

 

OK,cám ơn bác Hoành nhiều nhé,em đã dùng thử lisp của bác và làm được rồi, làm cái này nhanh hơn nhiều là dùng Topo kết hợp với Land. Thanks bác!


<<

Filename: 20822_exptxt.lsp
Tác giả: duyanhhcm
Bài viết gốc: 111122
Tên lệnh: bt
Làm tròn số trong cad
Bạn dùng lisp này nhé

;;bo text
(defun c:BT (/ c e ss txt cmde tbdangs tbdangt)
 (command "undo" "be")
 (setq cmde (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq tbdangt...
>>
Bạn dùng lisp này nhé

;;bo text
(defun c:BT (/ c e ss txt cmde tbdangs tbdangt)
 (command "undo" "be")
 (setq cmde (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq tbdangt (getreal "\nSo ky tu muon bot phia truoc:")) 
 (setq tbdangs (getreal "\nSo ky tu muon bot phia sau:")) 
 (if (null tbdangt)(setq tbdangt 0))
 (if (null tbdangs)(setq tbdangs 0))
 (setq sotru (+ tbdangt tbdangs))
(prompt "\nChon chu muon chinh.")
 (setq ss (ssget))
 (setq c 0)
 (if ss (setq e (ssname ss c)))
 (while e
(setq e (entget e))
; Ensure entity is text
(if (= (cdr (assoc 0 e)) "TEXT")
	(progn
(setq sochu (strlen (cdr (assoc 1 e))))
(if (> sochu sotru)
(progn
(setq txt (substr (cdr (assoc 1 e)) (fix (+ 1 tbdangt)) (fix (- sochu tbdangt tbdangs))))
	   (setq e (subst (cons 1 txt) (assoc 1 e) e))
	   (entmod e)
)
)

	)
)
(setq c (1+ c)); Increment counter.
(setq e (ssname ss c)); Obtain next entity.
  )
  (setvar "CMDECHO" cmde)
  (command "undo" "end")
  (Prin I)
)
;;thay doi noi dung text theo mot text chon truoc

- Xin góp ý với (C:BT) của tuanlongtl nhé:

1. Biến tbdangt, tbdangs nên đưa vào số nguyên (setq tbdangt (getint ...)). Thêm phần cảnh báo người dùng qua việc kiểm tra (đã nhập vào chưa? có phải số nguyên ? qua hàm Initget, getkword....)

2. Bổ sung đtượng đúng cho cả Mtext (hoặc Dimension) nữa.

3. Bạn đang Trim bớt phần thập phân sau dấu phẩy. Nhưng bạn chưa update lại Text đó. Dùng hàm (subst (cons 1 ....) (assoc 1 ....) .....)) và redraw (...) để cập nhật giá trị trên màn hình.

4. Không nên nhập "số ký tự muốn bớt phía sau" mà nên nhập "số ký tự còn lại phía sau". Ctrình của bạn phải tự tìm số lượng số thập phân hiện có và cắt sao cho chỉ còn như yêu cầu người dùng.


<<

Filename: 111122_bt.lsp
Tác giả: vanthangv
Bài viết gốc: 394547
Tên lệnh: 3b 2b 1b
ẩn hiện theo tên block

Bạn thử dùng cái này thủ. Mình ứng dụng thằng hideshow.lsp của Cadviet.

(defun Dxf (Id...
>>

Bạn thử dùng cái này thủ. Mình ứng dụng thằng hideshow.lsp của Cadviet.

(defun Dxf (Id Obj) (cdr (assoc Id (entget Obj))))
(defun an (SSet / Count_an Elem)
  (cond
	((/= SSet nil)
	(repeat (setq Count_an (sslength SSet))
   	(setq Count_an (1- Count_an)
  	Elem (ssname SSet Count_an))
   	(if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
  (if (Dxf 60 Elem)
	(entmod (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem)))
	(entmod (append (entget Elem) (list '(60 . 1))))
  )
  (prompt "\nEntity on a locked layer. Cannot hide this entity. ")
   	)
	)
	)  
  )
  (princ)
)
(defun C:3b (/ ena_an ss )
(while
  (and (setq ena_an (car (entsel "\nSelect a block to hidden"))) (= (dxf 0 ena_an) "INSERT"))
  (setq ss (ssget "X" (list (cons 2 (dxf 2 ena_an)))))
  (an ss)
)
(princ)
)
(defun c:2b (/ SSet WhatNext Count_an Elem)
(cond
  ((setq SSet (ssget "_X" '((60 . 1) (0 . "INSERT"))))
   (setq WhatNext "Yes")
   (cond
   ((= WhatNext "Yes")
	(prompt "\nPlease wait...")
	(repeat (setq Count_an (sslength SSet))
   	(setq Count_an (1- Count_an)
  	Elem (ssname SSet Count_an))
   	(if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
  (entmod (subst '(60 . 0) '(60 . 1) (entget Elem)))
  (prompt "\nEntity on a locked layer. Cannot make visible this entity. ")
   	)
	)
	(prompt "\nDone...")
	)
   )
  )
  (T (prompt "\nNo block was hidden. "))
)
)
(defun C:1b (/ ss ssa ss_an index)
(while (not (and
	(setq ena_an (car (entsel "\nSelect a block to only visible")))
	(=(dxf 0 ena_an) "INSERT")
	))
  (princ "Must select a BLOCK!")
)
(setq ss (ssget "X" (list (cons 2 (dxf 2 ena_an)))) index 0)
(setq ssa (ssget "X" (list (cons 0 "INSERT"))))
(repeat (sslength ss)
  (setq ssa (ssdel (ssname ss index) ssa))
  (setq index (1+ index))
)
(an ssa)
)
Lệnh 1b thì mọi block đều ẩn hết, chỉ có block bạn chọn hiện

Lệnh 2bthì hiện hết tấc cả Block

Lệnh 3b thì ẩn block bạn chọn

Nên kết hơp thêm các lệnh Layon,layiso,layoff nữa thì chắc đúng ý bạn.

 

Thanks bạn mình lục nát cái diễn đàn này nay mới tìm được


<<

Filename: 394547_3b_2b_1b.lsp
Tác giả: Hoan1111
Bài viết gốc: 240801
Tên lệnh: ha
Lisp tinh toan momen quan tinh xoan(J) cua tiet dien bat ky

 

Tôi nhớ đã post cái này 1 lần, nhưng giờ quên link nên đành post lại. Hy vọng đúng ý bạn. Và nếu đúng thì xin nhận...

>>

 

Tôi nhớ đã post cái này 1 lần, nhưng giờ quên link nên đành post lại. Hy vọng đúng ý bạn. Và nếu đúng thì xin nhận hậu tạ bằng LIKE cho gọn.

 

;Doan Van Ha - CADViet.com
;Tinh cac dac trung hinh hoc cua Polyline kin hoac Region.
(defun C:HA() 
 (setq obj (vlax-ename->vla-object (car (entsel "\Chon doi tuong kin (Polyline hoac Region): "))))
 (VxGetMassProps Obj))
(defun VxGetMassProps (Obj / DelFlg ResLst TmpObj)
 (or Gb:AcO (setq Gb:AcO (vlax-get-acad-object)))
 (or Gb:AcD (setq Gb:AcD (vla-get-activedocument Gb:AcO)))
 (if (member (vla-get-ObjectName Obj) '("AcDb2dPolyline" "AcDbPolyline"))
  (setq DelFlg T
        TmpObj (vlax-safearray-get-element  (vlax-variant-value (vla-AddRegion (vla-get-ModelSpace Gb:AcD) (VxListToArray (list Obj) vlax-vbObject))) 0))
  (setq TmpObj Obj))
 (setq ResLst (append
               (list
                (vlax-get TmpObj 'Centroid)
                (vlax-get TmpObj 'RadiiOfGyration)
                (setq a (vlax-get TmpObj 'PrincipalDirections))
                (vlax-get TmpObj 'PrincipalMoments)
                (vlax-get TmpObj 'MomentOfInertia))
               (if (= (vla-get-ObjectName TmpObj) "AcDbRegion")
                (list
                 (vla-get-ProductOfInertia TmpObj)
                 (vla-get-Area TmpObj)
                 (vla-get-Perimeter TmpObj))
                (list
                 (vlax-get TmpObj 'ProductOfInertia)
                 (vla-get-Volume TmpObj)
                 nil))))
 (if DelFlg (vla-delete TmpObj))
 (princ "\n\nKET QUA TINH: ")
 (princ "\n1). Centroid: ")
 (princ "\n X: ") (princ (car (nth 0 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 0 Reslst)))
 (princ "\n2). Radii Of Gyration: ")
 (princ "\n X: ") (princ (car (nth 1 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 1 Reslst)))
 (princ "\n3). Principal Directions: ")
 (princ "\n ") (princ (car (nth 2 Reslst)))
 (princ "\n ") (princ (cadr (nth 2 Reslst)))
 (princ "\n ") (princ (caddr (nth 2 Reslst)))
 (princ "\n ") (princ (nth 3 (nth 2 Reslst)))
 (princ "\n4). Principal Moments: ")
 (princ "\n I: ") (princ (car (nth 3 Reslst)))
 (princ "\n J: ") (princ (cadr (nth 3 Reslst)))
 (princ "\n5). Moment Of Inertia: ")
 (princ "\n X: ") (princ (car (nth 4 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 4 Reslst)))
 (princ "\n6). Product Of Inertia: ")
 (princ (nth 5 Reslst))
 (princ "\n7). Area: ")
 (princ (nth 6 Reslst))
 (princ "\n8). Perimeter: ")
 (princ (nth 7 Reslst))
 (textpage))
; (princ))
; ResLst=((70.5309 25.7049) (25.7963 70.5906) (0.966567 0.256415 -0.256415 0.966567) (285.635 561.65) (42933.0 321491.0) 116901.0 64.5172 37.4259)
;-----
(defun VxListToArray (Lst Typ)
 (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray Typ (cons 0 (1- (length Lst)))) Lst)))
 

 

Em tò mò muốn anh Hà giải thích cho em hiểu sự khác biệt khi dùng lisp của anh so với dùng  lệnh MASSPROP:

 

Command: HA Chon doi tuong kin (Polyline hoac Region):

KET QUA TINH:

1). Centroid:

 X: 18.9681

 Y: 13.3743

2). Radii Of Gyration:

 X: 13.4322

 Y: 19.1217

3). Principal Directions:

 0.972257

 0.233915

 -0.233915

 0.972257

4). Principal Moments:

 I: 37.8715

 J: 179.868

5). Moment Of Inertia:

 X: 5309.66

 Y: 10760.3

6). Product Of Inertia: 7433.39

7). Area: 29.4288

8). Perimeter: 28.1659nil

Command:

 

Command: MASSPROP

Select objects: 1 found

Select objects:

 ----------------   REGIONS   ----------------

Area:                    29.4288

Perimeter:               28.1659

Bounding box:         X: 13.9725  --  23.4991

                      Y: 10.4037  --  16.9504

Centroid:             X: 18.9681

                      Y: 13.3743

Moments of inertia:   X: 5309.6579

                      Y: 10760.3003

Product of inertia:  XY: 7433.3925

Radii of gyration:    X: 13.4322

                      Y: 19.1217

Principal moments and X-Y directions about centroid:

                      I: 37.8715 along

                      J: 179.8684 along

Write analysis to a file? <N>: *Cancel*


<<

Filename: 240801_ha.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 197654
Tên lệnh: as
LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô

Cái này cũng tương tự

 

(defun c:as()

(setq i 0 s1 0)
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
...
>>

Cái này cũng tương tự

 

(defun c:as()

(setq i 0 s1 0)
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
 (prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
(repeat (sslength txt)
	(setq txt_name (ssname txt i))
  	(setq txt_ent (entget txt_name))
	(setq cont (cdr(assoc 1 txt_ent)))
	(setq cont (atof cont))
	(setq s (+ cont n))     
 	(setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
	(entmod txt_ent)
	(setq i (+ i 1))
);repeat
);defun   
;------------------------------------------------------

Lisp rất hay bạn có thể bổ sung thêm phép trừ

cám ơn nhiều lắm


<<

Filename: 197654_as.lsp
Tác giả: tvkill
Bài viết gốc: 201613
Tên lệnh: kb ccd
xin lisp ghi cao độ

Trên diễn đàn hẳn có rất nhiều LISP na ná như bạn mong muốn

Ví dụ như LISP đánh cốt tự động của bác

>>

Trên diễn đàn hẳn có rất nhiều LISP na ná như bạn mong muốn

Ví dụ như LISP đánh cốt tự động của bác Nguyen Hoanh http://www.cadviet.c...p?showtopic=152

Hoặc bạn có thể dùng thử đồ chơi của mình

;;; Free lisp code from CADViet.com
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "\nText chen them vao phia truoc: an 1 de nhan text( " cheno " ) hoac nhap text: "))) ;; Dung viet them ghi chu cho text cao do (co the bo qua)
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok  or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq tp (getint "\nNhap vao so chu so thap phan: "))
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq i 1 n 100)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
;(WriteRes1 cddc)  ;; De dien vao text cac text co san
(command "TEXT" dchon "" "" (rtos cddc 2 tp))  ;; De viet them text moi Ban dung 1 trong 2 truong hop nhe
(setq i (+ i 1))
)
(princ)
)

 

 

Bạn dùng lệnh KB để chọn điểm gốc và các thông số

Và lệnh CCD để chèn cao độ vào các vị trí mong muốn

Trong LISP có 2 options ghi vào text có sẵn hoặc chèn text bạn nhé

Dùng trường hợp nào thì bạn cho dấu ";" vào đầu dòng còn lại nhé và bỏ dấu ";" của dòng kia đi

Lưu ý: Nếu chèn text, bạn hãy tạo text style có sẵn chiều cao chữ như bạn muốn thì nó mới chạy ngon được bạn nhé

Thân,

thak bạn ATHAN trước nha!mình muốn chèn vào text đã có sẵn,mình thử làm như bạn hướng dẫn rồi nhưng chẳng được,bạn chỉnh giúp mình cái hoặc bạn hướng dẫn cụ thể hơn cái,mình chẳng biết gì về lips cả.mong bạn giúp.chúc bạn một này vui vẻ


<<

Filename: 201613_kb_ccd.lsp
Tác giả: nataca
Bài viết gốc: 57971
Tên lệnh: addvertex
Thêm node vào đường Pline
Bạn chạy thử LISP này nhé.

(defun c:AddVertex (/ Sel Pt Obj CoordList cnt ParmPt cnt2 Ang tmpPt1 tmpPt2)
(if
(and
 (setq Sel (entsel "\n Chon vi tri can them Node tren...
>>
Bạn chạy thử LISP này nhé.

(defun c:AddVertex (/ Sel Pt Obj CoordList cnt ParmPt cnt2 Ang tmpPt1 tmpPt2)
(if
(and
 (setq Sel (entsel "\n Chon vi tri can them Node tren Polyline : "))
 (= (cdr (assoc 0 (entget (car Sel)))) "LWPOLYLINE")
 (setq Pt (trans (vlax-curve-getClosestPointTo (car Sel) (trans (cadr Sel) 1 0)) 0 (car Sel)))
 (setq Obj (vlax-ename->vla-object (car Sel)))
 (setq CoordList (vlax-get Obj 'Coordinates))
)
(progn
 (setq cnt 0)
 (setq ParmPt 1)
 (while (< (1+ cnt) (length CoordList))
  (setq cnt2
   (if (>= (setq cnt2 (+ 2 cnt)) (length CoordList))
    (- cnt2 (length CoordList))
    cnt2
   )
  )
  (setq Ang
   (angle
    (setq tmpPt1
     (list
      (nth cnt CoordList)
      (nth (1+ cnt) CoordList)
     )
    )
    (setq tmpPt2
     (list
      (nth cnt2 CoordList)
      (nth (1+ cnt2) CoordList)
     )
    )
   )
  )
  (if
   (or
    (equal (angle Pt tmpPt1) Ang 0.000001)
    (equal (angle Pt tmpPt2) Ang 0.000001)
   )
   (setq cnt (length CoordList))
   (progn
    (setq ParmPt (1+ ParmPt))
    (setq cnt (+ 2 cnt))
   )
  )
 )
 (vlax-invoke Obj 'AddVertex ParmPt (list (car Pt) (cadr Pt)))
)
)
(princ)
)

lisp này cũng tốt đấy chứ. Chỉ có điều nếu tách nhập điểm riêng thì người dùng bắt điểm chính xác hơn.


<<

Filename: 57971_addvertex.lsp
Tác giả: tvgtyb08
Bài viết gốc: 136564
Tên lệnh: congdim
Lisp cộng Dimension

Bạn thử xem

(defun c:congdim(/ S)
(setq S 0) 
(foreach x (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
(setq S (+ S (cdr(assoc 42...
>>

Bạn thử xem

(defun c:congdim(/ S)
(setq S 0) 
(foreach x (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
(setq S (+ S (cdr(assoc 42 (entget x)))))
)  
(alert (rtos S 2 0)) (princ))

Em cảm ơn các anh,

Nếu dùng lisp trudim rồi thay đoạn (setq Skq (- S St)) thành (setq Skq (+ S St)) thì khi bao hết DIM cần cộng lại nó ko ra kết quả mà phải Enter xong chọn tiếp 1 DIM nữa mới tính được.


<<

Filename: 136564_congdim.lsp
Tác giả: khaosat2009
Bài viết gốc: 96939
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD
Bạn chạy thử LISP đọc file txt có cấu trúc file dữ liệu như yêu cầu : STTXYH

Chú ý : trong file dữ liệu bạn Post lên, 3 dòng (57,189,213) có cấu trúc khác...

>>
Bạn chạy thử LISP đọc file txt có cấu trúc file dữ liệu như yêu cầu : STTXYH

Chú ý : trong file dữ liệu bạn Post lên, 3 dòng (57,189,213) có cấu trúc khác biệt.

Chiều cao Txt có thể thay đổi tại dòng : (setq h ....)

(defun c:RFT(/ data f h line pt spc ten val);Read File Txt
 (defun Split (Str Char / Lst pos)
   (while (setq pos (vl-string-search Char Str))
     (if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
     (setq Str (substr Str (+ pos 2)) ))
   (setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq h (* (getvar "dimtxt")(getvar "dimscale")))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
    (setq data (split Line "\t" )
	  val (car data)
	  pt  (cdr data) )
    (if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
      (vla-addtext spc val (vlax-3d-point pt) h) ))))  ))
 (princ))

Nhờ Anh Gia_bach có thể bổ sung lisp trên giúp em, khi bắn ra cad thì tạo ra các lớp :

1. Lớp point có kí hiệu điểm ( là điểm của tọa độ x, y trắc địa )

2. Lớp Số thứ tự

3. Lớp Cao độ

Mong được anh giúp, mong tin anh


<<

Filename: 96939_rft.lsp
Tác giả: ttbinh54
Bài viết gốc: 164367
Tên lệnh: tinhthang
Vẽ thang bằng lisp

Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào....

>>

Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào. Bạn copy đoạn code dưới đây vào file một file lisp rồi appload lên và dùng lệnh tinhthang.

 

(defun c:tinhthang()
(defun l2bac(ent)
(setq
tt (entget ent)
p1 (cdr (assoc 10 tt))
p2 (cdr (assoc 11 tt))
)
(list p1 p2)
)
(setq
ssbac (ssget '((0 . "LINE")))
hbac (getdist "\nChieu cao bac")
lstent (ss2ent ssbac)
ttbac (mapcar 'l2bac lstent)
index 0.0
)
(command ".3dmesh")
(command (* 2 (length lstent)) 2)
(foreach pp ttbac
(setq
caoht (* index hbac)
index (+ index 1.0)
p1 (car pp)
p2 (cadr pp)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
za caoht
zb (+ caoht hbac)
p1a (list x1 y1 za)
p1b (list x1 y1 zb)
p2a (list x2 y2 za)
p2b (list x2 y2 zb)
)
(command p1a p2a p1b p2b)
)
)
(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

 

Đầu tiên là mặt bằng của bạn:

Thang01.gif

 

bạn đổi viewport để xem dạng phối cảnh:

thang02.gif

 

dùng lệnh tinhthang để vẽ 3d của bậc thang:

thang03.gif

 

dùng lệnh shade để xem thang dạng có diện:

thang04.gif

 

Xoay để lấy mặt đứng biên:

thang05.gif

 

Lệnh tính thang không thể vẽ kỹ được thang cho bạn, nhưng chắc chắn nó sẽ giúp bạn làm những thao tác cơ bản để có được những nét phôi của thang. Từ đó bạn sẽ thêm nét để trở thành mặt chiếu hay phối cảnh của thang.

 

Rất mong có được sự hồi âm sau khi sử dụng Lisp.

minh hỏi sao đây trơi /không biết sao luôn


<<

Filename: 164367_tinhthang.lsp
Tác giả: vndesperados
Bài viết gốc: 3707
Tên lệnh: ct
Lisp đánh chữ theo thứ tự???
Bạn dùng mã này:

(defun c:ct ( / ss entp gtlast)
 (defun read_text (ent)
   (cdr (assoc 1 (entget ent)))
 )
 (defun write_text (ent gt / tt old new)
   (setq tt  (entget...
>>
Bạn dùng mã này:

(defun c:ct ( / ss entp gtlast)
 (defun read_text (ent)
   (cdr (assoc 1 (entget ent)))
 )
 (defun write_text (ent gt / tt old new)
   (setq tt  (entget ent)
  old (assoc 1 tt)
  new (cons 1 gt)
  tt  (subst new old tt)
   )
   (entmod tt)
 )
 (defun is_number(s)
   (wcmatch s "0,1,2,3,4,5,6,7,8,9")
 )
 (defun is_char(c )
   (wcmatch c "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,A,B,C,D,E,F,G,H,I,J,K,L,M

,N,O,P,Q,R,S,T,U,V,W,X,Y,")
 )
 (defun next_text (str / i)
   (cond
     ((is_number (substr str (strlen str) 1))
      (progn
 (setq i (strlen str))
 (while (and
	  (> i 1)
	  (is_number (substr str i 1)))
   (setq i (1- i))	
 )
 (strcat (substr str 1 i) (itoa (1+ (atoi (substr str (1+ i))))))
      )
     )
     ((is_char (substr str (strlen str) 1))
      (progn
 (strcat (substr str 1 (1- (strlen str))) (chr (1+ (ascii (substr str (strlen str))))))
      )
     )
     (t str)
   )

 )
 (setq SS (ssget ":S" '((0 . "TEXT"))))
 (if ss
   (progn
     (setq
       entp   (ssname ss 0)
dgoc   (cdr (assoc 10 (entget entp)))
gtlast (read_text entp)
     )
     (while (setq p (getpoint dgoc "\nVao diem: "))
(command ".copy" ss "" dgoc p)
(setq
  entl	 (entlast)
  gtlast (next_text gtlast)
)
(write_text (entlast) gtlast)
     )
   )
 )
 (princ)
)

Tên lệnh và cách thức giống hệt lệnh CT cũ nhưng khắc phục được nhược điểm số 100 và chữ Z.

 

 

Bác Hòanh đã check cái này chưa vậy? Bác thử với những số như là 26, 36, 16 chưa? Vì nếu lên đến 29 thì sau đó là 210, 211 (theo mình nghĩ nó sẽ là 30 hoặc 31 chứ)hoặc sau 39 sẽ là 310, 311 (40, 41)


<<

Filename: 3707_ct.lsp

Trang 223/330

223