Tr.CongSon
-
Số lượng nội dung
181 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
4
Bài đăng được đăng bởi Tr.CongSon
-
-
em tìm đến lenhcad.lsp mà thấy có mấy lệnh thay đổi chứ không thấy đầy đủ lệnh của speed cad bác sơn ơi? ạn
ý em là phím tắt của speed cad trùng với 1 số phím tắt của lisp e cài vào nên không dùng dùng được. nên bây giờ em mún đổi lại phím tắt của speed cad chứ có nhiều lệnh tắt bị trùng nên không dùng được. bác biết chỉ giúp e với.
em cảm ơn...!
Bạn chỉ đổi được lệnh Tắt của Cad trong file lenhCAD.lsp thôi
Còn mấy lệnh kia viết sang .VLX thì không thể đổi được bạn nhé
Có chăng thì bạn đổi tên lệnh Lisp của bạn cho khỏi bị trùng với lệnh Lisp trong SpeedCad thôi bạn ạ
Chúc thành công nhé!
-
Phá Block rồi mirror --> xong rồi Block lại bạn ạ :)
-
1
-
-
em muốn sửa lại lệnh tắt trong speed cad thì làm thế nào hả mấy bác? bác nào giúp em với...
Bạn đọc lại bài # 91 nhé
Chủ Topic đã hướng dẫn kỹ càng rồi J
Bạn tìm file "lenhCAD.lsp" trong thư mục Support của Autocad rồi chỉnh sửa theo ý mình là được
Còn phần vẽ dầm hình như bị lỗi rồi,mình không dùng cái này nên không rõ nhưng tốt nhất tự vẽ sẽ hay hơn bạn ạ
Chúc thành công!
-
Anh chị cho em hỏi cách Add 1 text vào Block Attribute đã có với ạ,
Hoặc có thể code cho em 1 đoạn tham khảo cũng được
Em cảm ơn,
-
Bạn Tr.CongSon có thể nói rõ hơn không? Do mình không rành về lsp nên không biết sữa chỗ nào trong lsp hết. Mong tin từ bạn. Thanks bạn!
Ộc ộc.Cái mình biểu bạn sửa là cái Text trong bản vẽ của bạn chứ đâu phải trong Lisp :)
Sửa luôn cho bạn rồi đây
Tên lệnh như cũ nhé ^^
(defun TS:Getboundary (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;;;---------------------
(defun TS:sel (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Block \U+0111\U+1EC3 th\U+1ED1ng k\U+00EA : "))
(cond
((= 7 (getvar 'errno))
(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")
)
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"INSERT"
)
(progn (setq ent (car ent))
nil
)
(princ
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block."
)
)
)
)
)
)
ent
)
;;;---------------------
(defun TS:eText (pt justify witdh txt / Lst)
(setq Lst (list (cons 0 "TEXT")
(cons 8 "TAREA")
(cons 7 (getvar "textstyle"))
(cons 10 pt)
(cons 40
(if (= (getvar "textstyle") "Romans")
30
31.5
)
)
(cons 41 witdh)
(cons 71 0)
(cons 1 txt)
)
)
(cond ((= justify "C")
(setq Lst (append Lst (list (cons 72 1) (cons 73 2) (cons 11 pt))))
)
((= justify "L")
(setq Lst (append Lst (list (cons 72 0) (cons 73 2) (cons 11 pt))))
)
)
(entmakex lst)
)
;;;---------------------
(defun TS:Eline (p1 p2)
(entmakex
(list
(cons 0 "LINE")
(cons 8 "TAREA")
(cons 10 p1)
(cons 11 p2)
)
)
)
;;;---------------------
(defun TS:MakeBTK (point / p1 p2 p3 p4 p5 p6 p7 p8)
(setq p1 (list (+ (car point) 68) (+ (cadr point) 30))
p2 (list (+ (car point) 274) (+ (cadr point) 30))
p3 (list (+ (car point) 424) (+ (cadr point) 30))
p4 (list (+ (car point) 1545) (+ (cadr point) 30))
p5 (list (car point) (+ (cadr point) 60))
p6 (list (+ (car point) 1305) (+ (cadr point) 60))
)
(TS:Eline p5 p6)
(if (null entblk)
(progn
(setq p7 (list (+ (car point) 990) (+ (cadr point) 30))
p8 (list (+ (car point) 1200) (+ (cadr point) 30))
)
(TS:Eline point (list (+ (car point) 1305) (cadr point)))
(setvar "Textstyle" "ROMANS")
(mapcar 'TS:eText
(list p1 p2 p3 p7 p8)
(list "C" "C" "L" "C" "C")
(list 0.75 0.6 0.75 0.6 0.6)
(list "Q.TY" "PIECE MARK" "MATERIAL DESCRIPTION" "UNIT WEIGHT" "ELEMENT WT.")
)
)
(progn
(setvar "Textstyle" "Arial")
(mapcar 'TS:eText
(list p1 p2 p3 p4)
(list "C" "C" "L" "L")
(list 1 1 1 1 1)
(list (nth 1 lsttxt) (nth 0 lsttxt) txt_PL txt_item)
)
)
)
)
;;;;;;;------------------;;;;;;;;;;
(defun c:BTK (/ entblk i item ll lsttxt osm pt pt1 pt2 pt3 pt4 pt5 sstxt txt_pl ur)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ Detail SS")
(setvar "cmdecho" 0)
(command "Undo" "Be")
(setq osm (getvar "osmode")
tstyle (getvar "Textstyle")
)
(setvar "osmode" 1)
(if (not (tblsearch "Style" "Arial"))
(command "_.STYLE" "Arial" "Arial" "0" "1" "0" "No" "No")
)
(if (not (tblsearch "Style" "Romans"))
(command "_.STYLE" "Romans" "Romans" "0" "0.6" "0" "No" "No" "No")
)
(setq pt (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
)
i 0
)
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(while (setq entblk (TS:sel))
(redraw entblk 3)
(setq ll (car (TS:Getboundary entblk))
ur (cadr (TS:Getboundary entblk))
sstxt (acet-ss-to-list
(ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
;;; (cons 62 2)
)
)
)
ssitem (car (vl-sort sstxt
'(lambda (x1 x2)
(> (caddr (assoc 10 (entget x1)))
(caddr (assoc 10 (entget x2)))
)
)
)
)
sstxt (vl-sort (vl-remove ssitem sstxt)
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
txt_item (cdr (assoc 1 (entget ssitem)))
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
)
(if (= (length lsttxt) 5)
(setq txt_PL (strcat "PL" (nth 3 lsttxt) "x" (nth 4 lsttxt) "x" (nth 2 lsttxt)))
(setq txt_PL (strcat "FL" (nth 3 lsttxt) "x" (nth 2 lsttxt)))
)
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(setq i (1+ i))
)
(setq pt1 (list (+ (car pt) 135) (cadr pt))
pt2 (list (+ (car pt) 412) (cadr pt))
pt3 (list (+ (car pt) 885) (cadr pt))
pt4 (list (+ (car pt) 1095) (cadr pt))
pt5 (list (+ (car pt) 1305) (cadr pt))
)
(TS:Eline pt (list (car pt) (- (cadr pt) (* (1+ i) 60))))
(setvar "osmode" 0)
(command "_.copy" (entlast) "" "M" pt pt1 pt2 pt3 pt4 pt5 "")
(setvar "osmode" osm)
(setvar "Textstyle" tstyle)
(command "regen")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
)
-
1
-
-
Mình đã làm theo cách của bạn rồi, nhưng thứ tự các cột nó bị nhảy lộn xộn hết luôn, mong bạn chỉ thêm. Thanks!
Đã tìm ra nguyên nhân ,do mình sắp xếp các text theo chiều tăng của X nên nó bị lỗi
Bạn sửa điểm chèn của Text ở cột piece Mark = với 4 Text ngang là được :)
-
Do diễn đàn bị lỗi nên bạn đọc cmt không được đó.
Bạn Click vào nút trả lời sẽ thấy :)
Chúc bạn thành công nhé!
-
Không biết bạn đã xử lý được chưa?
* Theo mình kiểm tra thì thấy có một số biến bạn khử sớm quá (Xác định biến cục bộ và biến toàn cục), giải quyết vấn đề này là OK.
Hôm qua cũng nghi nghi cái biến ,Giờ em sửa được rồi a .Bỏ 2 thằng này (objatt objblk ) ở hàm( TS:STK) là được ạ :)
Giờ đang cải tiến thêm để xử lý một số điều kiện cho Text chon nữa ^^
Anh Check giúp em còn trường hợp nào bị lỗi nữa không ạ.
Em cảm ơn..!
-
Chào bạn Tr.CongSon!
Trong quá trình làm việc mình có thay đổi kích thước khung block và font trong bock(để tiện hơn trong quá trình làm việc), không biết phải là nguyên nhân gây nên lỗi lsp hay không, bạn xem dùm mình nguyên nhân gây ra lỗi này giúp mình với. Thanks bạn!
Mình có kèm file để tiện cho bạn kiểm tra.
Bạn tìm đoạn này:
(acet-ss-to-list(ssget "W"llur(list (cons 0 "TEXT")(cons 8 "0")(cons 62 2))))Rồi thêm dấu ; vào trước (cons 62 2) hoặc delete (cons 62 2) đi là được-
1
-
-
Xem có thấy gì không ???
@Tr.CongSon tham khảo:
Hi.Giờ mới đọc comment của a.Cảm ơn anh nhiều (Like This)
Em viết hồi sáng giờ cũng được chừng ni rồi,Khi chạy từng đoạn thì được nhưng chạy tổng hết lệnh thì nó không được ak
ANh chị check giúp em với
; GetAtt - Reads all attribute values from a block
; Copyright: ;#169;2000 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
; Obj = Object [VLA-OBJECT]
; Return [Type]:
; > Dotted pair list '(("Tag1" . "Val1")...)
(defun GetAtt (obj)
(mapcar '(lambda (att) (cons (vla-get-TagString att) (vla-get-TextString att)))
(vlax-invoke obj 'GetAttributes)
)
)
;;;----------------------------------------
(defun SetAtt (obj lst / attval)
(mapcar '(lambda (att)
(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))
(vla-put-TextString att attval)
)
)
(vlax-invoke obj 'GetAttributes)
)
(vla-update obj)
)
;;;----------------------------------------
(defun T_Weight (Phi TongDai)
(/ (* pi (expt Phi 2) 7850 TongDai) (* 4 (expt 10 6))) ;phi=mm,TongDai=m
)
(defun T_Len1T (lstlen)
(apply '+ (mapcar '(lambda (x) (atoi (cdr x))) lstlen));lstlen=m
)
;;;----------------------------------------
; Lay ma Dxf cua doi tuong
(defun GetDxf(n elist) (cdr (assoc n elist)))
;;;----------------------------------------
(defun TS:Change_ATT (objblk objatt / 1ck cd1t dia lstatt lstdk lstkt newvalue sock tag tcd tl tst
val)
(setq LstATT (Getatt ObjBLK)
Tag (vla-get-TagString ObjATT)
Val (vla-get-TextString ObjATT)
Dia (atoi (substr (GetDxf "DK" LstATT) 4))
)
(cond
((wcmatch Tag "KT*")
(setq lstKT (vl-remove-if-not
'(lambda (x)
(and (wcmatch (car x) "KT*")
(/= (cdr x) "")
)
)
LstATT
)
lstKT (subst (cons Tag NewValue) (assoc Tag lstKT) lstKT)
CD1T (T_Len1T lstKT)
TCD (* CD1T (distof (GetDxf "TST" LstATT)) 10e-4)
TL (T_Weight Dia TCD)
lstUp (append lstKT (mapcar '(lambda (a B) (cons a B))
(list "CD1T" "TCD" "TL")
(list (itoa CD1T) (rtos TCD 2 2) (rtos TL 2 2))))
)
)
((wcmatch Tag "DK")
(setq Dia (atoi NewValue)
lstDK (cons Tag (strcat "%%c" NewValue))
TCD (GetDxf "TCD" LstATT)
TL (T_Weight Dia (atof TCD))
lstUp (mapcar '(lambda (a B) (cons a B))
(list Tag "TCD" "TL")
(list (strcat "%%c" NewValue) TCD (rtos TL 2 2)))
)
)
((wcmatch Tag "1T")
(initget 7)
(setq SoCK (getint "\nNh\U+1EADp S\U+1ED1 C\U+1EA5u Ki\U+1EC7n : "))
(setq 1CK (cons Tag NewValue)
TST (* SoCK (atoi NewValue))
CD1T (atoi (GetDxf "CD1T" LstATT))
TCD (* CD1T TST 10e-4)
TL (T_Weight Dia TCD)
lstUp (mapcar '(lambda (a B) (cons a B))
(list Tag "TST" "TCD" "TL")
(list NewValue (itoa TST) (rtos TCD 2 2) (rtos TL 2 2))
)
)
)
)
(SetAtt ObjBLK lstUp)
)
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:STK (/ SelATT)
(setvar "CMDECHO" 0)
(defun TS:STK (Selent / entatt lsttemp newvalue objatt objblk txttemp)
(setq ObjBLK (vlax-ename->Vla-Object (car Selent))
EntATT (car (nentselp (cadr Selent)))
ObjATT (vlax-ename->Vla-Object EntATT)
Lsttemp (vl-remove-if-not
'(lambda (pair)
(member (car pair) (list 7 8 10 40 67 1))
)
(entget EntATT)
)
)
(if (vlax-property-available-p ObjATT 'Visible)
(vlax-put ObjATT 'Visible 0)
)
(setq TxtTemp (entmakex
(append (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
)
Lsttemp
)
)
)
(vl-cmdf "_.DDEDIT" txtTemp)
(setq NewValue (GetDxf 1 (entget (entlast))))
(TS:Change_ATT ObjBLK ObjATT)
(entdel txttemp)
(if (vlax-property-available-p ObjATT 'Visible)
(vlax-put ObjATT 'Visible 1)
)
)
(while (setq SelATT (entsel "\Chon Text trong Block ATT can Edit:"))
(TS:STK SelATT)
)
(princ)
)
-
@ Tr. Cong Son: Cấu tạo Block của mình bằng các Attribute (không sử dụng Field trong block thống kê thép tròn).
Hướng đi đúng theo quocmanh đã viết ^_^
Thanks a Tuệ,
Anh chị cho em hỏi:em dùng code này để lấy list (Tagstring . Textstring)
(setq ent (entsel "\Chon Text trong Block ATT can Edit:")
e2 (car (nentselp (cadr ent)))
obj (vlax-ename->vla-object ent)
lstATT (Getatt obj)
)
(defun GetAtt (obj)
(mapcar '(lambda (att) (cons (vla-get-TagString att) (vla-get-TextString att)))
(vlax-invoke obj 'GetAttributes)
)
)
Nhưng dùng thì có hồi được ,hồi báo lỗi như vậy: ActiveX Server returned the error: unknown name: "GETATTRIBUTES"Anh chị giải thích cho em biết và cách khắc phục như thế nào ko ạ?Em cảm ơn -
Cái màu xanh:
Sau khi lấy được tính chất của Tag đó => ẩn tag đó đi => entmake Text có một số tính chất của Tag (Textstring, Style, Heigth, Pos ...) => Edit text => Lấy giá trị mới của text này gán vào Tag và cho hiện lên=> Xóa text entmake.
Chỉ 1 bước: (defun c:test () (setq ent (entsel)) (setq a-ent (nentselp (cadr ent))))
Cảm ơn a quocmanh04tt
Tối qua về mày mò ra cũng giống như a vậy,code em dùng:
(setq ent (entsel"\Chon Text trong Block ATT can Edit:")p1 (cadr ent)e2 (car (nentselp p1)));;chỗ này có thể dùng (ssget point '((0 . "INSERT"))) cũng đượcMàu xanh: Giờ mới đọc cmt của anh , nên em sẽ thử xem sao,em code có chỗ nào vướng mắc em sẽ post hỏi tiếp ạ@a pphung : Em cảm ơn nhưng cái này không phải cái em cần anh ơi,vì em muốn Edit trực tiếp chỗ cái Text của Block ATT cho dễ thẫy ấy mà -
B
Giống như bạn Tuệ thì chỉ có bạn Tuệ trả lời được. Nhưng mình nghĩ trình lisp của bạn đã có đủ khả năng làm thống kê thép bằng block chứa att.
1.Bạn làm 1 hàm con đọc att trong block cần đọc được tag và giá trị.
2.Bạn lại làm 1 hàm con có khả năng sửa giá trị có tag chỉ định trong block.
Cứ chọn 1 att trong block dùng hàm 1. Nhập giá trị cần sửa. Dùng hàm 2 chỉnh chính nó và các tag khác sau khi cộng trừ nhân chia.
Em cảm ơn a Duy,
- Lấy giá trị TagString và TextString của Block ATT em làm được ạ
- Sửa TagString có giá trị Tag chỉ định thì em cũng tạm ổn
- Màu Xanh: Em chỉ biết nhập giá trị cần sửa = hàm getstring hoặc getreal thôi ạ.Chứ làm cho nó trực quan giống như Edit Dtext bình thường (như a Tuệ đã làm ) em suy nghĩ mãi mà chưa ra cách nên mới nhờ các anh chị ạ.
Cách làm của em:
- Chọn Block Att để lấy các TagString và Text String
- Dùng (car (nentsel"\Chon Text trong Block ATT can Edit:")) để chọn cái Text Block ATT cần sửa.-->Thắc mắc:Ở Lisp a Tuệ chỉ làm 1 bước là đã tới cái Text trong Block ATT -->Cái này em làm chưa được
- Nhập giá trị và lisp tự tính
Các anh chị xem từ bước 2 em có được entityname con của Blockatt -->Có cách nào mà từ bước 2 có thể lấy Entity của Block và các TagString,Textstring của Block ATT đó không ạ (không cần chọn block ở bước 1)
-
1. Edit text hay edit att? Bản vẽ cao hơn 2007 không đọc được.
2. Đợi tác giả.
3. Google Field thì đọc 1 năm không xuể.
Sorry anh ,lúc sáng em upload file được mà giờ up lên toàn bị IT chặn hết.
ANh chị nào convert file về 2007 giúp em với
@a Hạ:
- Edit text trong block ATT à a
- Anh xem video của a Tue xem sao ạ (em cũng đang đợi tin a Tuệ đây)
- Cảm ơn a,em cũng đang tham khảo trên này.Nhưng chưa hiểu các tạo các Field trong Lisp a ạ.
-
Chào các anh chị,
Em đang viết đoạn Lisp để chỉnh sưa bảng thông kê cho cốt thép như file đính kèm.
http://www.cadviet.com/upfiles/5/142392_thong_ke_thep_2.dwg
Em có đọc bài viết của a Tue_NV ở trang này http://www.cadviet.c...ong-block-dong/ .Trong đoạn video đó,anh Tue_NV có viết lisp để ED 1 giá trị trong Block thuộc tính (ví dụ như số lượng thép, chiều dài, phi,...) thì nó update kết quả luôn (chiều dài,khối lượng ).Do trong topic đó anh Tuệ đã nói "không cho không được" nên em mạo muội nhờ các anh chị giải thích giúp em 1 vài vấn đề sau được không ạ:
- Trong lisp Làm sao chỉnh sửa Text trong block ATT nó hiện bảng như edit Text bình thường .(giống như a Tuệ đã làm)
- Ở chỗ Update giá trị có phải a Tuệ dùng Field để update hay dùng chức năng gì ạ?
- Sẵn anh chị cho em vài đoạn code mẫu hoặc giải thích giúp em cách dùng Field trong Lisp như thế nào với,.Hoặc cho em vài đường link để tham khảo cũng được ạ
Mong anh chị giúp đỡ .Em chân thành cảm ơn!
- Trong lisp Làm sao chỉnh sửa Text trong block ATT nó hiện bảng như edit Text bình thường .(giống như a Tuệ đã làm)
-
Thử sức: là cái mình đã biết làm rồi,muốn đánh đố,thách thức người khác ^^
Giúp đỡ; là cái mình làm không được,cần mọi người giải đáp hoặc làm giùm ^^
Em nghĩ anh nên để tiêu để : "Nhờ sự giúp đỡ của các bạn trên Forums " thì đúng hơn ^^
Anh làm theo huớng dẫn của anh United xem sao
-
Dùng DWG Trueview,convert về version nào cũng được hết
Bạn Search diễn đàn nhé.!
-
Nó là 1 không khác nhau gì đâu bạn
Cảm ơn anh !
-
Đã sửa xong cho bạn rồi đây ^^
Chúc thành công nhé!
(defun TS:Getboundary (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;;;---------------------
(defun TS:sel (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Block \U+0111\U+1EC3 th\U+1ED1ng k\U+00EA : "))
(cond
((= 7 (getvar 'errno)) (princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i."))
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"INSERT"
)
(progn (setq ent (car ent))
nil
)
(princ "\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block.")
)
)
)
)
)
ent
)
;;;---------------------
(defun TS:eText (pt justify witdh txt / Lst)
(setq Lst (list (cons 0 "TEXT")
(cons 8 "TAREA")
(cons 7 (getvar "textstyle"))
(cons 10 pt)
(cons 40 (if (= (getvar "textstyle") "Romans")
30 31.5))
(cons 41 witdh)
(cons 71 0)
(cons 1 txt)
)
)
(cond ((= justify "C")
(setq Lst (append Lst (list (cons 72 1) (cons 73 2) (cons 11 pt))))
)
((= justify "L")
(setq Lst (append Lst (list (cons 72 0) (cons 73 2) (cons 11 pt))))
)
)
(entmakex lst)
)
;;;---------------------
(defun TS:Eline (p1 p2)
(entmakex
(list
(cons 0 "LINE")
(cons 8 "TAREA")
(cons 10 p1)
(cons 11 p2)
)
)
)
;;;---------------------
(defun TS:MakeBTK (point / p1 p2 p3 p4 p5 p6 p7 p8)
(setq p1 (list (+ (car point) 68) (+ (cadr point) 30))
p2 (list (+ (car point) 274) (+ (cadr point) 30))
p3 (list (+ (car point) 424) (+ (cadr point) 30))
p4 (list (+ (car point) 1545) (+ (cadr point) 30))
p5 (list (car point) (+ (cadr point) 60))
p6 (list (+ (car point) 1305) (+ (cadr point) 60))
)
(TS:Eline p5 p6)
(if (null entblk)
(progn
(setq p7 (list (+ (car point) 990) (+ (cadr point) 30))
p8 (list (+ (car point) 1200) (+ (cadr point) 30))
)
(TS:Eline point (list (+ (car point) 1305) (cadr point)))
(setvar "Textstyle" "ROMANS")
(mapcar 'TS:eText
(list p1 p2 p3 p7 p8)
(list "C" "C" "L" "C" "C")
(list 0.75 0.6 0.75 0.6 0.6)
(list "Q.TY" "PIECE MARK" "MATERIAL DESCRIPTION" "UNIT WEIGHT" "ELEMENT WT.")
)
)
(progn
(setvar "Textstyle" "Arial")
(mapcar 'TS:eText
(list p1 p2 p3 p4)
(list "C" "C" "L" "L")
(list 1 1 1 1 1)
(list (nth 2 lsttxt) (nth 1 lsttxt) txt_PL (nth 0 lsttxt))
)
)
)
)
;;;;;;;------------------;;;;;;;;;;
(defun c:BTK (/ entblk i item ll lsttxt osm pt pt1 pt2 pt3 pt4 pt5 sstxt txt_pl ur)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ Detail SS")
(setvar "cmdecho" 0)
(command "Undo" "Be")
(setq osm (getvar "osmode")
tstyle (getvar "Textstyle")
)
(setvar "osmode" 1)
(if (not (tblsearch "Style" "Arial"))
(command "_.STYLE" "Arial" "Arial" "0" "1" "0" "No" "No")
)
(if (not (tblsearch "Style" "Romans"))
(command "_.STYLE" "Romans" "Romans" "0" "0.6" "0" "No" "No" "No")
)
(setq pt (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
)
i 0
)
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(while (setq entblk (TS:sel))
(redraw entblk 3)
(setq ll (car (TS:Getboundary entblk))
ur (cadr (TS:Getboundary entblk))
sstxt (acet-ss-to-list
(ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
(cons 62 2)
)
)
)
sstxt (vl-sort (vl-sort sstxt
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
'(lambda (x1 x2)
(> (caddr (assoc 10 (entget x1)))
(caddr (assoc 10 (entget x2)))
)
)
)
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
)
(if (= (length lsttxt) 6)
(setq txt_PL (strcat "PL" (nth 4 lsttxt) "x" (nth 5 lsttxt) "x" (nth 3 lsttxt)))
(setq txt_PL (strcat "FL" (nth 4 lsttxt) "x" (nth 3 lsttxt))))
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(setq i (1+ i))
)
(setq pt1 (list (+ (car pt) 135) (cadr pt))
pt2 (list (+ (car pt) 412) (cadr pt))
pt3 (list (+ (car pt) 885) (cadr pt))
pt4 (list (+ (car pt) 1095) (cadr pt))
pt5 (list (+ (car pt) 1305) (cadr pt))
)
(TS:Eline pt (list (car pt) (- (cadr pt) (* (1+ i) 60))))
(setvar "osmode" 0)
(command "_.copy" (entlast) "" "M" pt pt1 pt2 pt3 pt4 pt5 "")
(setvar "osmode" osm)
(setvar "Textstyle" tstyle)
(command "regen")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
)-
1
-
-
Thực sự là rất mong bác gộp giúp em 2 cái lisp kia ạ! Em đã tìm nhưng không cái nào vừa ý. Cái hoạt động tốt trên CAD 2007 thì lại không tốt trên 2015, và ngược lại.
Chỉ có cái vướng mắc là lisp "N1" hoạt động tốt trên CAD 2009 đối với cả (line và polyline) nhưng trên 2015 lại lỗi khi nối 2 polyline (do nó không yêu cầu convert nên thừa đoạn nhập "y").
Của anh đây :)
(defun c:N1 (/ ss)
(vl-load-com)
(setvar "PEDITACCEPT" 1)
(if (setq ss (ssget '((0 . "*LINE,ARC"))))
(vl-cmdf ".pedit" "m" ss "" "j" "0" "")
)
(princ)
)
-
1
-
-
Cảm ơn anh đã chia sẽ.
Sau khi sử dụng "tiện ích khủng" này em dễ bỏ chú ASD luôn quá !!
Anh Khatamxd cho em hỏi tí:Cái phần Kata PRO (Full version) của anh ,khác phần free ở tính năng nào không ạ ??
-
Bạn có thể Scan chữ ký của bạn,sau đó dung SPline để đồ lại là được mà ^^
Hoặc dung lệnh Sketch để ký trực tiếp trên nền CAD luôn cũng được
Chúc thành công!
P/s:Cái này đã có nhiều trên diễn đàn rồi,bạn chịu khó search trước khi hỏi nhé!
-
Bạn tạo 1 layer có tên là CHU-250 là được
-
Thanks bạn Tr.CongSon trước nha! Tại vì sáng đi làm nên không có mở máy đươc nên không hồi âm bạn được. Với lại nếu bạn chia ra được 2 trường hợp thì giúp mình với(vẫn sử dụng lệnh btk nhưng gặp trường hợp nào thì xuất ra trường hợp đó):
1/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK có số 0.5) đầy đủ như này thì xuất ra--->PL120x0.5x4000->thì ok rồi
2/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK để trống) thì xuất ra---> FL120x4000->bạn giúp mình với
* (Các cột PIECE MARK và QTY vẫn giữ nguyên như bình thường)
Bạn thử xem nhé!
Cuối tuần bận quá nên giờ mới sửa được .
(defun TS:Getboundary (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;;;---------------------
(defun TS:sel (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Block \U+0111\U+1EC3 th\U+1ED1ng k\U+00EA : "))
(cond
((= 7 (getvar 'errno)) (princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i."))
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"INSERT"
)
(progn (setq ent (car ent))
nil
)
(princ "\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block.")
)
)
)
)
)
ent
)
;;;---------------------
(defun TS:eText (pt justify txt / Lst)
(setq Lst (list (cons 0 "TEXT")
(cons 8 "TAREA")
(cons 7 "Arial")
(cons 10 pt)
(cons 40 31.5)
(cons 41 1)
(cons 71 0)
(cons 1 txt)
)
)
(cond ((= justify "C")
(setq Lst (append Lst (list (cons 72 1) (cons 73 2) (cons 11 pt))))
)
((= justify "L")
(setq Lst (append Lst (list (cons 72 0) (cons 73 2) (cons 11 pt))))
)
)
(entmakex lst)
)
;;;---------------------
(defun TS:Eline (p1 p2)
(entmakex
(list
(cons 0 "LINE")
(cons 8 "TAREA")
(cons 10 p1)
(cons 11 p2)
)
)
)
;;;---------------------
(defun TS:MakeBTK (point / p1 p2 p3 p4 p5 p6)
(setq p1 (list (+ (car point) 68) (+ (cadr point) 30))
p2 (list (+ (car point) 274) (+ (cadr point) 30))
p3 (list (+ (car point) 424) (+ (cadr point) 30))
p4 (list (+ (car point) 1545) (+ (cadr point) 30))
p5 (list (car pt) (+ (cadr pt) 60))
p6 (list (+ (car pt) 1305) (+ (cadr pt) 60))
)
(TS:Eline p5 p6)
(mapcar 'TS:eText
(list p1 p2 p3 p4)
(list "C" "C" "L" "L")
(list (nth 2 lsttxt) (nth 1 lsttxt) txt_PL (nth 0 lsttxt)))
)
;;;;;;;------------------;;;;;;;;;;
(defun c:BTK (/ entblk i item ll lsttxt osm pt pt1 pt2 pt3 pt4 pt5 sstxt txt_pl ur)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ Detail SS")
(setvar "cmdecho" 0)
(command "Undo" "Be")
(setq osm (getvar "osmode"))
(setvar "osmode" 1)
(setq pt (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
)
i 0
)
(while (setq entblk (TS:sel))
(setq ll (car (TS:Getboundary entblk))
ur (cadr (TS:Getboundary entblk))
sstxt (acet-ss-to-list
(ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
(cons 62 2)
)
)
)
sstxt (vl-sort (vl-sort sstxt
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
'(lambda (x1 x2)
(> (caddr (assoc 10 (entget x1)))
(caddr (assoc 10 (entget x2)))
)
)
)
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
)
(if (= (length lsttxt) 6)
(setq txt_PL (strcat "PL" (nth 4 lsttxt) "x" (nth 5 lsttxt) "x" (nth 3 lsttxt)))
(setq txt_PL (strcat "FL" (nth 4 lsttxt) "x" (nth 3 lsttxt))))
(redraw entblk 3)
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(setq i (1+ i))
)
(setq pt1 (list (+ (car pt) 135) (cadr pt))
pt2 (list (+ (car pt) 412) (cadr pt))
pt3 (list (+ (car pt) 885) (cadr pt))
pt4 (list (+ (car pt) 1095) (cadr pt))
pt5 (list (+ (car pt) 1305) (cadr pt))
)
(TS:Eline pt1 (list (car pt1) (- (cadr pt1) (* i 60))))
(setvar "osmode" 0)
(command "_.copy" (entlast) "" "M" pt1 pt2 pt3 pt4 pt5 "")
(setvar "osmode" osm)
(command "regen")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
)
-
1
-
SpeedCAD 2.0 hỗ trợ Thiết Kế
trong AutoLisp
Đã đăng · Trả lời báo cáo
Bạn mở file LIsp của bạn lên
Tìm đoạn (defun c: Tên Lệnh (/ ) )
Đổi Tên Lệnh thành lệnh bạn muốn là được
Search trên diễn đàn đã bàn về vấn đề này nhiều rồi mà :)