Chuyển đến nội dung
Diễn đàn CADViet

vtd_xd

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    40

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi vtd_xd

  3. Đã đăng · Trả lời báo cáo

    Mình có 1 ứng dụng đang free cho anh em trên AppStore làm đúng cái việc trên. anh em có thể tải về sài theo link dưới.

    https://apps.autodesk.com/ACD/en/Detail/Index?id=1455487038690013482&appLang=en&os=Win32_64

     

    Đây là lisp mà anh em đồng nghiệp đánh giá là đáng giá nhất trong tất cả các lisp mình đã viết. giúp giảm rất nhiều thời gian làm việc với Cad.

    Ps: Không cần like bài này. Anh em tải về đừng quên vote 5* cho app để mềnh lấy tiếng nhớ.  :D

     

    Không dùng đuợc cho cad 2007 àh bạn

  8. Đã đăng · Trả lời báo cáo

     

    Chào bác giabach, bác có thể thêm phần lựa chọn "thêm 1 thanh, bớt 1 thanh hoặc giữ nguyên giá trị" trước khi tính toán được không?

    - Khi tính toán thêm hàm làm tròn (Round) giống như excel được không vậy, Lisp rất tiện lợi, thanks bác nhiều

    Bác nào ra tay giúp e với, e đang cần chương trình này, thanks các bác

  9. Đã đăng · Trả lời báo cáo

    Thêm 1 phương án :

    (defun C:bt(/ ctc ss)
 (or *ctc* (setq *ctc* 200))
 (initget 6)
 (setq ctc (getint (strcat"\nNhap buoc thep <" (itoa *ctc*) ">:")) )
 (if ctc (setq *ctc* ctc))
 (if (setq ss (ssget"_:L" (list (cons 0 "DIMENSION")) ))
(progn
 	(command "_.undo" "_begin")    
 	(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextOverride (vlax-ename->vla-object ent)
  (strcat (itoa (fix(/ (cdr (assoc 42 (entget ent))) *ctc*)))
"x" (itoa *ctc*) "=<>"))	)
 	(command "_.undo" "_end") (princ)  )))
(defun C:10(/ num ss)
 (if (setq ss (ssget"_:L"))
(progn
 	(command "_.undo" "_begin")
 	(or *num* (setq *num* 15))
 	(initget 4)
 	(setq num (getint (strcat"\nNhap color <" (itoa *num*) ">:")) )
 	(while (not (if num (<= num 256)T) )
(princ "\nGia tri <=256.")
(setq num (getint (strcat"\nNhap color <" (itoa *num*) ">:")) ))
 	(if num (setq *num* num))
 	(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-Color (vlax-ename->vla-object ent)*num* )	)
 	(command "_.undo" "_end") (princ)  )))

     

    Chào bác giabach, bác có thể thêm phần lựa chọn "thêm 1 thanh, bớt 1 thanh hoặc giữ nguyên giá trị" trước khi tính toán được không?

    - Khi tính toán thêm hàm làm tròn (Round) giống như excel được không vậy, Lisp rất tiện lợi, thanks bác nhiều

  16. Đã đăng · Trả lời báo cáo

    Lisp "link" cho đối tượng Block thuộc tính.

    (link tất cả thuộc tính của Block)

    (defun c:linkBA (/ e i obj obj1 ss1 ss2 vallst val); link Block Attribute
 (vl-load-com)
 (if (and
(princ "\nChon Block nguon :")
(setq ss1 (ssget "+.:S:N" (list (cons 0 "INSERT") (cons 66 1))))
(setq obj1 (vlax-Ename->Vla-Object (ssname ss1 0)))
(princ "\nChon Block dich :")
(setq ss2 (ssget "_:L" (list (cons 0 "INSERT") (cons 2 (vla-get-name obj1))))))
   (progn
     (foreach att (vlax-invoke obj1 'GetAttributes)
(setq valLst (cons (cons (vla-get-TagString Att)
			 (vla-get-ObjectId Att)) valLst)) )
     (setq i -1)
     (while (setq e (ssname ss2 (setq i (1+ i))))
(setq obj (vlax-Ename->Vla-Object e))
(foreach att (vlax-invoke obj 'GetAttributes)
  (if (setq val (assoc (vla-get-TagString att) valLst))
    (vla-put-TextString Att (strcat
			      "%<\\AcObjProp Object(%<\\_ObjId "
			      (vl-princ-to-string (cdr val))
			      ">%).TextString >%")) ))	)  ) )
 (princ))

     

     

    Cám ơn bạn Gia Bach nhiều, lisp chạy rất ổn

  19. Đã đăng · Trả lời báo cáo

    Cũng không rõ nữa vẫn báo lỗi thế này.

    1_14.jpg

    Nhưng thôi kệ nó đã. Bác test lại với block của bác nhé

    (defun c:textblock (/ C40 ENT H I M N N40 SS SSN ENT1 SSN1 RONG C10 C11 C41 C72 C73 N41 N72 N73)
(vl-load-com)
(princ "\nChon block")
(setq ss (ssget '((0 . "INSERT"))))
(setq i 0)
(setq n (sslength ss))
(setq m -1)
(setq h (getreal "\n Nhap chieu cao chu: "))
(setq rong (getreal "\n Nhap be rong chu: "))
(while (< i n)
(setq ssn (ssname ss (setq m (1+ m))))
(setq ent (entget ssn))
(if(= (cdr(assoc 66 ent)) 1)
(progn
(setq ssn1(entnext ssn))
(setq ent1(entget ssn1))
(while (/= (cdr(assoc 0 ent1)) "SEQEND")
(setq c40 (assoc 40 ent1))
(setq n40 (cons 40 h))
(setq c41 (assoc 41 ent1))
(setq n41 (cons 41 rong))
(if (and(/= (cdr(assoc 72 ent1)) 1)(/=(cdr(assoc 73 ent1)) 2))
 (progn
   (setq c11 (assoc 11 ent1))
   (setq c10 (cons 11 (cdr(assoc 10 ent1))))
   (setq c72 (assoc 72 ent1))
   (setq c73 (assoc 73 ent1))
   (setq n72 (cons 72 1))
   (setq n73 (cons 73 2))
   (setq ent1 (subst c10 c11 ent1))
   (setq ent1 (subst n72 c72 ent1))
   (setq ent1 (subst n73 c73 ent1))
   )
 )
(setq ent1 (subst n40 c40 ent1))
(setq ent1 (subst n41 c41 ent1))  
(entmod ent1)
(setq ssn1(entnext ssn1))
(setq ent1(entget ssn1))
)
)
)
(setq i (+ 1 i))
)
(entupd ssn)
(princ)
)

    Nếu còn bị nhảy thì báo lại cho mình nhé.

     

     

    Text không nhảy nữa, nhưng cho tôi hỏi, nếu trong Block đó có nhiều text ATTRIBUTE thi nó đều thay đổi hết, bạn thử chỉnh lại nếu kich vào text nào trong block thì chỉ có text đó thay đổi thôi

    Thank bạn

  20. Đã đăng · Trả lời báo cáo

    Dựa vào code của anh gia_bach, Tue_NV chỉnh lại 1 chút cho phù hợp với yêu cầu của bạn vtd_xd.

    Banj vtd_xd thử nhé : 

    (defun c:LinkD (/ ss objlst obj_reactor); Link DIMENSION
 (if (setq ss (ssget  '((0 . "DIMENSION"))) )
   (progn
     (vl-load-com)
     (setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
     (setq obj_reactor (vlr-object-reactor  objlst  nil '((:vlr-modified . callback))))
     )
   )
 )
(defun callback (notifier-object obj_reactor parameter-list / objlist newT)
 (setq objlist (vlr-owners obj_reactor))
 (setq newT (vla-get-TextOverride notifier-object))
 (foreach obj objlist
   (if (/= (vla-get-TextOverride obj) newT)
     (vla-put-TextOverride obj newT)
     )
   )
 )

     

    Cám ơn bạn Tue_VN nhé

  24. Đã đăng · Trả lời báo cáo

    Chào bạn vtd_xd,

    Đây là cái lisp để bạn dùng thử. Mình viết lại dựa theo cái lisp của bác Tue_NV viết để thống kê vòng tròn. Nếu có gì chưa phù hợp bạn hãy post lên.

    (defun c:tkck (/ ltxt ltst)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "TEXT") (cons 8 "_text") (cons 7 "TKCK")))
ltxt (list)
ltst (list)
i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ltxt (append ltxt (list(cdr (assoc 1 (entget ent)))))))
(foreach x ltxt
(if (setq old (cdr (assoc x ltst)))
(setq ltst (subst (cons x (1+ old) ) (assoc x ltst) ltst))
(setq ltst (append ltst (list (cons x 1))))))
(setq k 1
p (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao text: ")
d (getreal "\n Nhap do rong cot: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 h) (cons 1 "THONG KE CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "TEN CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "SO LUONG")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "GHI CHU")))
(foreach x1 ltst
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos k 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (car x1))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos (cdr x1) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h (1+  k)))))
(cons 40 h) (cons 1 "" )))
(setq k (1+ k)))
(command "undo" "e")
(princ)
)

     

    Trong lisp này mình căn cứ vào bản vẽ bạn post và giả định là các text cần đếm của bạn nằm trên lớp "_text" và có style là "TKCK". Với các bản vẽ mà text cần phân loại không có các thuộc tính như trên thì bạn có thể đổi lại mã trong dòng code này cho phù hợp:

    (ssget (list (cons 0 "TEXT") (cons 8 "_text") (cons 7 "TKCK")))

    Chúc bạn vui.

     

    Cám ơn bạn nhé, nếu có các đường line kẻ thành bảng thì tốt qua, thanks

  25. Đã đăng · Trả lời báo cáo

    Chào bạn vtd_xd,

    Việc thống kê các text này không khó nếu trên bản vẽ chỉ có rặt một loại text như vậy, nhưng trên thực tế, theo mình biết thì trên bản vẽ còn rất nhiều loại text khác nữa và chắc là bạn chả muốn thống kê chúng. Vậy bạn có thể cho biết các text cần thống kê của bạn có đặc tính gì khác với các text mà bạn không muốn thống kê???

    Việc liên kết bảng thống kê với các dữ liệu trên bản vẽ, quả thật mình chưa biết cách nên không thể giúp bạn được, mà chỉ có thể làm một cái lisp để bạn chạy mỗi lần cần thống kê mà thôi.

    Điều này có nghĩa mỗi khi bạn thay đổi số lượng các text đó trên bản vẽ, bạn sẽ phải chạy lại lisp một lần bạn ạ. Nếu bạn nhất trí mình có thể giúp bạn viết ra cái lisp đó.

    Chúc bạn vui.

     

    Như vậy cũng là tốt lắm rồi, bạn cố gắng giúp tôi nhé, text trên bản vẽ tôi chỉ dùng Dtext thôi, Nếu dùng attribute chắc sẽ gán nhiều thuộc tính hơn với chúc năng "Insert field"

    - Text tôi muốn thống kê là một vùng trong bản vẽ

    Cám ơn bạn trước nhé

×