Đến nội dung


Hình ảnh
- - - - -

Nhờ viết lisp thông kê giá trị trong block ATT


  • Please log in to reply
49 replies to this topic

#1 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 05 May 2015 - 01:30 PM

Nhờ cả nhà viết giúp mình lisp thống kê các giá trị trong block ATT như sau:

- Đánh lệnh THT, select chọn các block att cần thống kê giá trị

- Chọn một giá trị trong block att để làm giá trị lọc

- Chọn số thứ tự cột để lấy giá trị tổng các att có giá trị lọc như trên

- Chọn một Dtext hoặc Mtext để gán kết quả

Mọi người xem bản vẽ sẽ hiểu được ý của mình:

http://www.cadviet.c...80_thong_ke.dwg

Block att mình có gán giá trị Field nha các bạn

Mong mọi nguời viết giúp lisp hoặc có phương án nào để tổng hợp như trên thì xin chỉ giúp

Cảm ơn mọi người trước nha!


  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 05 May 2015 - 09:18 PM

Nhờ cả nhà viết giúp mình lisp thống kê các giá trị trong block ATT như sau:

- Đánh lệnh THT, select chọn các block att cần thống kê giá trị

- Chọn một giá trị trong block att để làm giá trị lọc

- Chọn số thứ tự cột để lấy giá trị tổng các att có giá trị lọc như trên

- Chọn một Dtext hoặc Mtext để gán kết quả

Mọi người xem bản vẽ sẽ hiểu được ý của mình:

http://www.cadviet.c...80_thong_ke.dwg

Block att mình có gán giá trị Field nha các bạn

Mong mọi nguời viết giúp lisp hoặc có phương án nào để tổng hợp như trên thì xin chỉ giúp

Cảm ơn mọi người trước nha!

Hề hề hề,

Thực ra thì cái yêu cầu của bạn không quá khó để thực hiện. Tuy nhiên mình chưa hiểu cái cách bạn "gán giá trị Field" cho các thuộc tính của block này ra sao nên việc trích các giá trị này ra để tính toán trong lisp hơi loằng ngoằng.

Bạn có thể giải thích giùm mình điều này để mình dễ hiểu hơn và có thể hoàn thành lisp được không????


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 06 May 2015 - 08:50 AM

Hề hề hề,

Thực ra thì cái yêu cầu của bạn không quá khó để thực hiện. Tuy nhiên mình chưa hiểu cái cách bạn "gán giá trị Field" cho các thuộc tính của block này ra sao nên việc trích các giá trị này ra để tính toán trong lisp hơi loằng ngoằng.

Bạn có thể giải thích giùm mình điều này để mình dễ hiểu hơn và có thể hoàn thành lisp được không????

Cảm ơn bạn đã quan tâm đến bài viết của mình nhé!

Mình dùng Fomular trong Field ATT để gán thuộc tính các giá trị trong block, bạn xem bản vẽ sẽ hiểu được ý mình muốn nói

http://www.cadviet.c...0_thong_ke1.dwg


  • 0

#4 Tuynh

Tuynh

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 06 May 2015 - 09:08 AM

Bạn pawuta dùng bảng thống kê này thì khi tính chiều dài nối thép tính ra sao?

 
  • 0

#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 06 May 2015 - 09:49 AM

Cảm ơn bạn đã quan tâm đến bài viết của mình nhé!

Mình dùng Fomular trong Field ATT để gán thuộc tính các giá trị trong block, bạn xem bản vẽ sẽ hiểu được ý mình muốn nói

http://www.cadviet.c...0_thong_ke1.dwg

Hề hề hề,

Cái công thức thì mình đã thây và hiểu được, nhưng cách nhập cái công thức và cách lấy giá trị của các tam số thì mình chưa hiểu. Bạn nhớ rằng lisp có cấu trúc các công thức tinh toán khác với CAD và phải có cách là cho lisp hiểu được sự khác biệt này thì nó mới tính toán cho bạn được.

Mình muốn biết cách nhập công thức và cách lấy tham số này để có thể thay thế vào trong lisp bạn ạ.

Trên bản vẽ của bạn các cột này đều hiển thị công thức chứ không phải giá trị của việc tính toán, Vì thế lisp không thể xử lý tính toán với các công thức này nếu như không chuyển ngữ cho lisp hiểu.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 06 May 2015 - 10:50 AM

Hề hề hề,

Cái công thức thì mình đã thây và hiểu được, nhưng cách nhập cái công thức và cách lấy giá trị của các tam số thì mình chưa hiểu. Bạn nhớ rằng lisp có cấu trúc các công thức tinh toán khác với CAD và phải có cách là cho lisp hiểu được sự khác biệt này thì nó mới tính toán cho bạn được.

Mình muốn biết cách nhập công thức và cách lấy tham số này để có thể thay thế vào trong lisp bạn ạ.

Trên bản vẽ của bạn các cột này đều hiển thị công thức chứ không phải giá trị của việc tính toán, Vì thế lisp không thể xử lý tính toán với các công thức này nếu như không chuyển ngữ cho lisp hiểu.

Mình trả lời như trong bản vẽ không biết đã đúng ý bạn hỏi chưa, bạn xem trong bản vẽ nha!

http://www.cadviet.c...thong_ke2_1.dwg


  • 0

#7 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 06 May 2015 - 11:06 AM

Nhờ cả nhà viết giúp mình lisp thống kê các giá trị trong block ATT như sau:

- Đánh lệnh THT, select chọn các block att cần thống kê giá trị

- Chọn một giá trị trong block att để làm giá trị lọc

- Chọn số thứ tự cột để lấy giá trị tổng các att có giá trị lọc như trên

- Chọn một Dtext hoặc Mtext để gán kết quả

Mọi người xem bản vẽ sẽ hiểu được ý của mình:

http://www.cadviet.c...80_thong_ke.dwg

Block att mình có gán giá trị Field nha các bạn

Mong mọi nguời viết giúp lisp hoặc có phương án nào để tổng hợp như trên thì xin chỉ giúp

Cảm ơn mọi người trước nha!

Dùng thử Lisp này xem sao : 15454_thongkechdai.png

(defun c:ThKl (/ doc)
  (vl-load-com)
  (princ "\nChon Block can tong hop :")
  (if (ssget (list (cons 0 "INSERT")(cons 66 1)))
    (tkatt (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))))
	   (vla-get-modelspace doc) "DK" "TCD" "TKL" )
    (princ "\nKhong chon duoc Block thuoc tinh."))
  (princ))
(defun tkatt (ssets msp idTag val1tag val2tag / asoc h i id lst pt row tblobj val1 val2 width)
    ;;  By : Gia_Bach, www.CadViet.com 2015 ;;
  (vlax-for obj ssets
    (setq id nil val1 nil val2 nil)
    (foreach att (vlax-invoke obj 'GetAttributes)
      (cond
	( (= (vla-get-TagString att) idTag)
	  (setq id (vla-get-TextString att)) )
	( (= (vla-get-TagString att) val1Tag)
	  (setq val1 (vla-get-TextString att)) )
	( (= (vla-get-TagString att) val2Tag)
	  (setq val2 (vla-get-TextString att)) ) ))
    (if (and id (distof id 2) val1 val2(setq val1 (distof val1 2))(setq val2 (distof val2 2)))
      (if (setq asoc (assoc id lst))
	(setq lst (subst (cons id (list (+ val1 (car(cdr asoc))) (+ val2 (cadr(cdr asoc))))) asoc lst))
	(setq lst (append lst (list (cons id (list val1 val2)))) )) ))
  (cond
    ( (not lst )
      (princ "\nKhong tim duoc so lieu.") )
    ( (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
      (if (setq pt (getpoint "\nDiem dat Bang tong hop:"))
	(progn
	  (setq h 1.8 width (* 6 h)
		TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 4 (* 2 h) width))
	  (vla-put-regeneratetablesuppressed TblObj :vlax-true)
	  (vla-put-vertcellmargin 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))
	  (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
	  (vla-setText TblObj 0 0 "Bang tong hop")
	  (vla-setText TblObj 1 0 "STT")
	  (vla-setText TblObj 1 1 idTag)
	  (vla-setText TblObj 1 2 val1Tag)
	  (vla-setText TblObj 1 3 val2Tag)
	  (setq row 2 i 1)
	  (foreach pt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
	    (vla-setText TblObj row 0 (itoa i))
	    (vla-setText TblObj row 1 (car pt))
	    (vla-setText TblObj row 2 (rtos(car(cdr pt))2 2))
	    (vla-setText TblObj row 3 (rtos(cadr(cdr pt))2 2))
	    (setq row (1+ row) i (1+ i))	)
	  (vla-put-regeneratetablesuppressed TblObj :vlax-false)
	  (vlax-release-object TblObj)  	  )))
    ( t
      (foreach it (vl-sort lst '(lambda (x y) (< (car x) (car y))))
	(princ (strcat "\n"(car it) " : " (rtos(car(cdr it))2 2) " : " (rtos(cadr(cdr it))2 2))))  ) )
  )

  • 1

#8 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 06 May 2015 - 02:35 PM

 

Dùng thử Lisp này xem sao : 15454_thongkechdai.png

(defun c:ThKl (/ doc)
  (vl-load-com)
  (princ "\nChon Block can tong hop :")
  (if (ssget (list (cons 0 "INSERT")(cons 66 1)))
    (tkatt (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))))
	   (vla-get-modelspace doc) "DK" "TCD" "TKL" )
    (princ "\nKhong chon duoc Block thuoc tinh."))
  (princ))
(defun tkatt (ssets msp idTag val1tag val2tag / asoc h i id lst pt row tblobj val1 val2 width)
    ;;  By : Gia_Bach, www.CadViet.com 2015 ;;
  (vlax-for obj ssets
    (setq id nil val1 nil val2 nil)
    (foreach att (vlax-invoke obj 'GetAttributes)
      (cond
	( (= (vla-get-TagString att) idTag)
	  (setq id (vla-get-TextString att)) )
	( (= (vla-get-TagString att) val1Tag)
	  (setq val1 (vla-get-TextString att)) )
	( (= (vla-get-TagString att) val2Tag)
	  (setq val2 (vla-get-TextString att)) ) ))
    (if (and id (distof id 2) val1 val2(setq val1 (distof val1 2))(setq val2 (distof val2 2)))
      (if (setq asoc (assoc id lst))
	(setq lst (subst (cons id (list (+ val1 (car(cdr asoc))) (+ val2 (cadr(cdr asoc))))) asoc lst))
	(setq lst (append lst (list (cons id (list val1 val2)))) )) ))
  (cond
    ( (not lst )
      (princ "\nKhong tim duoc so lieu.") )
    ( (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
      (if (setq pt (getpoint "\nDiem dat Bang tong hop:"))
	(progn
	  (setq h 1.8 width (* 6 h)
		TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 4 (* 2 h) width))
	  (vla-put-regeneratetablesuppressed TblObj :vlax-true)
	  (vla-put-vertcellmargin 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))
	  (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
	  (vla-setText TblObj 0 0 "Bang tong hop")
	  (vla-setText TblObj 1 0 "STT")
	  (vla-setText TblObj 1 1 idTag)
	  (vla-setText TblObj 1 2 val1Tag)
	  (vla-setText TblObj 1 3 val2Tag)
	  (setq row 2 i 1)
	  (foreach pt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
	    (vla-setText TblObj row 0 (itoa i))
	    (vla-setText TblObj row 1 (car pt))
	    (vla-setText TblObj row 2 (rtos(car(cdr pt))2 2))
	    (vla-setText TblObj row 3 (rtos(cadr(cdr pt))2 2))
	    (setq row (1+ row) i (1+ i))	)
	  (vla-put-regeneratetablesuppressed TblObj :vlax-false)
	  (vlax-release-object TblObj)  	  )))
    ( t
      (foreach it (vl-sort lst '(lambda (x y) (< (car x) (car y))))
	(princ (strcat "\n"(car it) " : " (rtos(car(cdr it))2 2) " : " (rtos(cadr(cdr it))2 2))))  ) )
  )

Cảm ơn bạn rất nhiều! Lisp chạy rất oke, nhưng mình có thêm chút ý kiến bạn sửa lại giúp mình một chút nữa nha!

- Mình muốn thay đổi các Text như sau: Bang tong hop -> TỔNG HỢP KHỐI LƯỢNG; DK -> ĐƯỜNG KÍNH; TCD -> TỔNG CHIỀU DÀI; TKL -> TỔNG KHỐI LƯỢNG (font: vni-helve; (cao chữ: 3.5)

- Các số thống kê bên dưới (font: vni-helve; (cao chữ: 2.5) và tự động thay đổi giá trị theo khi thay đổi các giá trị các block att.


  • 0

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 06 May 2015 - 04:05 PM

Mình trả lời như trong bản vẽ không biết đã đúng ý bạn hỏi chưa, bạn xem trong bản vẽ nha!

http://www.cadviet.c...thong_ke2_1.dwg

Hề hề hề,

Cám ơn bạn nhiều. Sở dĩ mình không hiểu vì lâu nay mình chỉ xài CAD2004 nên nó không có cái field này. Do vậy khi mỡ bản vẽ của bạn thì nó không hiện giá trị số mà chỉ hiện nội dung dòng text như công thức của bạn. Do vậy mình chưa biết cách làm.

Mình mới dùng CAD2008 để mở thử thì thấy nó đã hiện giá trị số và căn cứ vào đó mình làm cái lisp như dưới đây để bạn dùng thử coi có đúng ý bạn không nhé.

Do mình mới tập tọe xài CAD2008 nên không rõ nó có phù hợp với của bạn hay không. Nếu có gì chưa được thì hãy post lên để mình test lại.

(DEFUN C:THKL (/ ssl dtl dtt e1 e2 e3 ltt et goc)
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 66 1)))))
(setq dtl (cdr (assoc 1 (entget (setq e1 (car (nentsel "\n Chon thuoc tinh loc")))))))
(setq goc 0)
(setq dtt (cdr (assoc 2 (entget (setq e2 (car (nentsel "\n Chon thuoc tinh can tinh")))))))
(setq ltt (list))
(foreach e ssl
    (setq et (entnext e))
    (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
            (if (and (= (cdr (assoc 1 (entget et))) dtl) (= (cdr (assoc 2 (entget et))) (cdr (assoc 2 (entget e1)))))                          
                (setq ltt (append ltt (list e)))
            )
            (setq et (entnext et))
    )
)
(foreach e ltt
     (setq et (entnext e))
     (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
              (if (= (cdr (assoc  2 (entget et))) dtt)
                  (setq goc (+ goc (atof (cdr (assoc 1 (entget et))))))
              )
              (setq et (entnext et))
      )
)
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget (setq e3 (car (nentsel "\n Chon text can thay the"))))) (entget e3)))
(entupd e3)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#10 nhoclangbac

nhoclangbac

    biết vẽ circle

  • Members
  • PipPip
  • 38 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 06 May 2015 - 06:45 PM

 

Nể Bác  gia_bach viết code rất già dặn :) , chắc Bác là người chính chắn ko thix quậy phá như Nhoc

 

Cảm ơn bạn rất nhiều! Lisp chạy rất oke, nhưng mình có thêm chút ý kiến bạn sửa lại giúp mình một chút nữa nha!

- Mình muốn thay đổi các Text như sau: Bang tong hop -> TỔNG HỢP KHỐI LƯỢNG; DK -> ĐƯỜNG KÍNH; TCD -> TỔNG CHIỀU DÀI; TKL -> TỔNG KHỐI LƯỢNG (font: vni-helve; (cao chữ: 3.5)

- Các số thống kê bên dưới (font: vni-helve; (cao chữ: 2.5) và tự động thay đổi giá trị theo khi thay đổi các giá trị các block att.

Nhoc thêm thắt theo yêu cầu của pawuta chỉ chừa lại phần "Khoai" cho Bác gia_bach. Pawuta ơiii ! Bạn mới làm wen Lisp mà yêu cầu "Khoai" thế :wub: : tự động thay đổi giá trị theo khi thay đổi các giá trị các block att :wub: .

(defun c:ThKl (/ ft doc) (vl-load-com)
(setq ft (vla-get-activeTextStyle (vla-get-activedocument (vlax-get-acad-object))))
(vla-setfont ft "VNI-Helve" :vlax-False :vlax-False 0 32)
(princ "\nChon Block can tong hop :")
(if (ssget (list (cons 0 "INSERT") (cons 66 1)))
(tkatt (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(vla-get-modelspace doc) "DK" "TCD" "TKL" )
(princ "\nKhong chon duoc Block thuoc tinh."))
(princ))
(defun tkatt (ssets msp idTag val1tag val2tag / asoc h i id lst pt row tblobj val1 val2 width)
;  By : Gia_Bach, www.CadViet.com 2015 ;;
(vlax-for obj ssets
(setq id nil val1 nil val2 nil)
(foreach att (vlax-invoke obj 'GetAttributes)
(cond
( (= (vla-get-TagString att) idTag)
(setq id (vla-get-TextString att)) )
( (= (vla-get-TagString att) val1Tag)
(setq val1 (vla-get-TextString att)) )
( (= (vla-get-TagString att) val2Tag)
(setq val2 (vla-get-TextString att))	)))
(if (and id (distof id 2) val1 val2 (setq val1 (distof val1 2)) (setq val2 (distof val2 2)))
(if (setq asoc (assoc id lst))
(setq lst (subst (cons id (list (+ val1 (car (cdr asoc))) (+ val2 (cadr (cdr asoc))))) asoc lst))
(setq lst (append lst (list (cons id (list val1 val2)))) )) ))
(cond
( (not lst )
(princ "\nKhong tim duoc so lieu.") )
( (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
(if (setq pt (getpoint "\nDiem dat Bang tong hop:"))
(progn
(setq h 2.5 width (* 20 h)
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 4 (* 2 h) width))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-put-vertcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x) (vla-setTextStyle TblObj x (getvar 'textstyle))) 
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x) (vla-setTextHeight TblObj x h)) (list acDataRow) )
(mapcar '(lambda (x) (vla-setTextHeight TblObj x 3.5))
(list acTitleRow acHeaderRow) )
(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 3)) )))
(vla-setText TblObj 0 0 "TOÅNG HÔÏP KHOÁI LÖÔÏNG")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "ÑÖÔØNG KÍNH")
(vla-setText TblObj 1 2 "TOÅNG CHIEÀU DAØI")
(vla-setText TblObj 1 3 "TOÅNG KHOÁI LÖÔÏNG")
(setq row 2 i 1)
(foreach pt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car pt))
(vla-setText TblObj row 2 (rtos (car (cdr pt)) 2 2))
(vla-setText TblObj row 3 (rtos (cadr (cdr pt)) 2 2))
(setq row (1+ row) i (1+ i))	)
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj)	)))
(t (foreach it (vl-sort lst '(lambda (x y) (< (car x) (car y))))
(princ (strcat "\n"(car it) " : " (rtos (car (cdr it)) 2 2) " : " (rtos (cadr (cdr it)) 2 2))))  ))
)

Hề hề hề, Bác Hề hề hề rất nhiệt tình nhưng Lisp Bác chưa mang tính tổng quát như Bác gia_bach (Nhoc nhận xét sai thì bỏ wa nhe :P )

Nhoc thấy Lee có một số hàm lấy BlockAtt nè Bác Hề hề hề :P

http://www.lee-mac.c...efunctions.html


  • 1

#11 nhoclangbac

nhoclangbac

    biết vẽ circle

  • Members
  • PipPip
  • 38 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 06 May 2015 - 06:59 PM

 

 

Bác Hề hề hề nhiệt tình thật, nhưng Nhoc thấy Lisp của Bác chưa tổng quát bằng bác gia_bach (Nhoc nhận xét sai thì bỏ wa nhe :P )

Nhoc thấy một số Hàm về BlockAtt của Bác Lee nè Bác Hề hề hề :P :

http://www.lee-mac.c...efunctions.html

 


  • 0

#12 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 06 May 2015 - 09:32 PM

 

Hề hề hề,

Cám ơn bạn nhiều. Sở dĩ mình không hiểu vì lâu nay mình chỉ xài CAD2004 nên nó không có cái field này. Do vậy khi mỡ bản vẽ của bạn thì nó không hiện giá trị số mà chỉ hiện nội dung dòng text như công thức của bạn. Do vậy mình chưa biết cách làm.

Mình mới dùng CAD2008 để mở thử thì thấy nó đã hiện giá trị số và căn cứ vào đó mình làm cái lisp như dưới đây để bạn dùng thử coi có đúng ý bạn không nhé.

Do mình mới tập tọe xài CAD2008 nên không rõ nó có phù hợp với của bạn hay không. Nếu có gì chưa được thì hãy post lên để mình test lại.

(DEFUN C:THKL (/ ssl dtl dtt e1 e2 e3 ltt et goc)
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 66 1)))))
(setq dtl (cdr (assoc 1 (entget (setq e1 (car (nentsel "\n Chon thuoc tinh loc")))))))
(setq goc 0)
(setq dtt (cdr (assoc 2 (entget (setq e2 (car (nentsel "\n Chon thuoc tinh can tinh")))))))
(setq ltt (list))
(foreach e ssl
    (setq et (entnext e))
    (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
            (if (and (= (cdr (assoc 1 (entget et))) dtl) (= (cdr (assoc 2 (entget et))) (cdr (assoc 2 (entget e1)))))                          
                (setq ltt (append ltt (list e)))
            )
            (setq et (entnext et))
    )
)
(foreach e ltt
     (setq et (entnext e))
     (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
              (if (= (cdr (assoc  2 (entget et))) dtt)
                  (setq goc (+ goc (atof (cdr (assoc 1 (entget et))))))
              )
              (setq et (entnext et))
      )
)
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget (setq e3 (car (nentsel "\n Chon text can thay the"))))) (entget e3)))
(entupd e3)
)

Oke, lisp chạy rất tốt, đúng với yêu cầu mình đề ra luôn, hehe!

Bạn giúp mình thêm phần link giá trị kết quả khi thay đổi giá trị các att nguồn nhé. Cảm ơn bạn rất nhiều!


  • 0

#13 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 06 May 2015 - 09:46 PM

 

Nể Bác  gia_bach viết code rất già dặn :) , chắc Bác là người chính chắn ko thix quậy phá như Nhoc

 

Nhoc thêm thắt theo yêu cầu của pawuta chỉ chừa lại phần "Khoai" cho Bác gia_bach. Pawuta ơiii ! Bạn mới làm wen Lisp mà yêu cầu "Khoai" thế :wub: : tự động thay đổi giá trị theo khi thay đổi các giá trị các block att :wub: .

(defun c:ThKl (/ ft doc) (vl-load-com)
(setq ft (vla-get-activeTextStyle (vla-get-activedocument (vlax-get-acad-object))))
(vla-setfont ft "VNI-Helve" :vlax-False :vlax-False 0 32)
(princ "\nChon Block can tong hop :")
(if (ssget (list (cons 0 "INSERT") (cons 66 1)))
(tkatt (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(vla-get-modelspace doc) "DK" "TCD" "TKL" )
(princ "\nKhong chon duoc Block thuoc tinh."))
(princ))
(defun tkatt (ssets msp idTag val1tag val2tag / asoc h i id lst pt row tblobj val1 val2 width)
;  By : Gia_Bach, www.CadViet.com 2015 ;;
(vlax-for obj ssets
(setq id nil val1 nil val2 nil)
(foreach att (vlax-invoke obj 'GetAttributes)
(cond
( (= (vla-get-TagString att) idTag)
(setq id (vla-get-TextString att)) )
( (= (vla-get-TagString att) val1Tag)
(setq val1 (vla-get-TextString att)) )
( (= (vla-get-TagString att) val2Tag)
(setq val2 (vla-get-TextString att))	)))
(if (and id (distof id 2) val1 val2 (setq val1 (distof val1 2)) (setq val2 (distof val2 2)))
(if (setq asoc (assoc id lst))
(setq lst (subst (cons id (list (+ val1 (car (cdr asoc))) (+ val2 (cadr (cdr asoc))))) asoc lst))
(setq lst (append lst (list (cons id (list val1 val2)))) )) ))
(cond
( (not lst )
(princ "\nKhong tim duoc so lieu.") )
( (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
(if (setq pt (getpoint "\nDiem dat Bang tong hop:"))
(progn
(setq h 2.5 width (* 20 h)
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 4 (* 2 h) width))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-put-vertcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x) (vla-setTextStyle TblObj x (getvar 'textstyle))) 
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x) (vla-setTextHeight TblObj x h)) (list acDataRow) )
(mapcar '(lambda (x) (vla-setTextHeight TblObj x 3.5))
(list acTitleRow acHeaderRow) )
(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 3)) )))
(vla-setText TblObj 0 0 "TOÅNG HÔÏP KHOÁI LÖÔÏNG")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "ÑÖÔØNG KÍNH")
(vla-setText TblObj 1 2 "TOÅNG CHIEÀU DAØI")
(vla-setText TblObj 1 3 "TOÅNG KHOÁI LÖÔÏNG")
(setq row 2 i 1)
(foreach pt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car pt))
(vla-setText TblObj row 2 (rtos (car (cdr pt)) 2 2))
(vla-setText TblObj row 3 (rtos (cadr (cdr pt)) 2 2))
(setq row (1+ row) i (1+ i))	)
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj)	)))
(t (foreach it (vl-sort lst '(lambda (x y) (< (car x) (car y))))
(princ (strcat "\n"(car it) " : " (rtos (car (cdr it)) 2 2) " : " (rtos (cadr (cdr it)) 2 2))))  ))
)

Hề hề hề, Bác Hề hề hề rất nhiệt tình nhưng Lisp Bác chưa mang tính tổng quát như Bác gia_bach (Nhoc nhận xét sai thì bỏ wa nhe :P )

Nhoc thấy Lee có một số hàm lấy BlockAtt nè Bác Hề hề hề :P

http://www.lee-mac.c...efunctions.html

 

Nhóc ơi bị lỗi rồi, nhóc xem lại với nha

136880_capture.jpg


  • 0

#14 nhoclangbac

nhoclangbac

    biết vẽ circle

  • Members
  • PipPip
  • 38 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 07 May 2015 - 09:01 AM

Nhóc ơi bị lỗi rồi, nhóc xem lại với nha

136880_capture.jpg

Tình hình là rất tình hình máy pawuta chưa có cài font VNI-Helve. Nhoc thấy file của pawuta có font VNI-Helve-Condense :P .

Vậy thì pawuta sữa

(vla-setfont ft "VNI-Helve" :vlax-False :vlax-False 0 32)             thành :

(vla-setfont ft "VNI-Helve-Condense" :vlax-False :vlax-False 0 32)


  • 1

#15 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 07 May 2015 - 09:56 AM

Tình hình là rất tình hình máy pawuta chưa có cài font VNI-Helve. Nhoc thấy file của pawuta có font VNI-Helve-Condense :P .

Vậy thì pawuta sữa

(vla-setfont ft "VNI-Helve" :vlax-False :vlax-False 0 32)             thành :

(vla-setfont ft "VNI-Helve-Condense" :vlax-False :vlax-False 0 32)hề hêhề hêHềHê

Hề hề hề,

 1/- Cám ơn Nhoc nhiều vì đã quan tâm tới lisp do mình viết và đã chia xẻ một số lisp của Lee Mac.

 2/- Khen bác giabach thì khen cả ngày bởi bác ấy là dân chuyên chứ không phải dân Amateur như mình.

 3/- Mình viết theo cái sự mình hiểu về yêu cầu của chủ thớt chứ không phải hoàn thiện như yêu cầu của Nhóc. Vì năng lực có hạn nên khó có thể viết và đoán được hết các yêu cầu của người dùng, đành là làm được tới đâu hay tới đó vậy.

 4/- Để lập được cái bảng thống kê như bác Giabach cần có thêm bước tạo danh sách các đối tượng lọc và sau đó là bước lặp sử dụng khúc lisp của mình để tạo ra một danh sách các yêu cầu cần thống kê. Cuối cùng là việc tạo bảng.. Do mình sử dụng CAD2004 nên mình không thể tạo ra cái bảng đúng với yêu cầu như bác Giabach được vì không thể hiện được tiếng việt. Vậy nên mình chả muốn làm thêm nữa vì chắc chủ thớt cũng sẽ chả dùng,

 5/- Các hàm vl- vla- vlax- đối với mình vẫn là một khó khăn lớn khi sử dụng do cái sự hiểu về nó còn quá kém. Mình đang sưu tập các hàm này để ngâm cứu thêm. Nếu Nhoc có tài liêu hay kinh nghiệm gì về chúng, xin chia xẽ thêm để mình mót nhé.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#16 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 07 May 2015 - 10:02 AM

Oke, lisp chạy rất tốt, đúng với yêu cầu mình đề ra luôn, hehe!

Bạn giúp mình thêm phần link giá trị kết quả khi thay đổi giá trị các att nguồn nhé. Cảm ơn bạn rất nhiều!

Hề hề hề,

Với khả năng của mình thì việc link cái kết quả trong lisp với các tham số trên bản vẽ một cách tự động là chưa thể làm bạn ạ. Trên diễn đàn cũng thấy có một số yêu cầu về vấn đề này nhưng do năng lực có hạn nên mình thấy chưa có được giải pháp nào mà mình có thể dùng được cả. Do vậy dù muốn mót nhưng vẫn chưa mót được. Mong bạn thông cảm.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#17 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 07 May 2015 - 01:13 PM

Hehe, Cảm ơn mọi người nhiều nhé, có được 2 lisp này là mình cũng vui lắm rồi, để mình tự kết hợp qua lại cũng được!

Các bạn chỉnh sửa lại 2 lisp trên một chút nữa giúp mình nhé!

- Với lisp của bạn bach_gia thì chỉnh sửa giúp mình là bỏ 2 dòng trên text trên chỉ còn lại thế này: (không hiểu biết về viết lisp nên mò cả đêm hôm qua mà không được :(( )

136880_capture.png

- Với lisp của bạn phamthanhbinh thì tạo thêm vòng lặp để rút ngắn thao tác, cụ thể thao tác như thế này nhé:

Đánh lệnh THKL -> quyét chọn các block att cần tổng hợp -> chọn thuộc tính lọc -> chọn thuộc tính cần tính -> chọn text (att) cần thay thế

sau khi gán kết quả lisp tiếp tục hỏi: chọn thuộc tính lọc -> chọn thuộc tính cần tính -> chọn text (att) cần thay thế....

cho đến khi thoát lệnh.

Mong các bạn hiểu ý mình, hehe, Cảm ơn trước nha mọi người!


  • -2

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 07 May 2015 - 04:27 PM

Hehe, Cảm ơn mọi người nhiều nhé, có được 2 lisp này là mình cũng vui lắm rồi, để mình tự kết hợp qua lại cũng được!

Các bạn chỉnh sửa lại 2 lisp trên một chút nữa giúp mình nhé!

- Với lisp của bạn bach_gia thì chỉnh sửa giúp mình là bỏ 2 dòng trên text trên chỉ còn lại thế này: (không hiểu biết về viết lisp nên mò cả đêm hôm qua mà không được :(( )

136880_capture.png

- Với lisp của bạn phamthanhbinh thì tạo thêm vòng lặp để rút ngắn thao tác, cụ thể thao tác như thế này nhé:

Đánh lệnh THKL -> quyét chọn các block att cần tổng hợp -> chọn thuộc tính lọc -> chọn thuộc tính cần tính -> chọn text (att) cần thay thế

sau khi gán kết quả lisp tiếp tục hỏi: chọn thuộc tính lọc -> chọn thuộc tính cần tính -> chọn text (att) cần thay thế....

cho đến khi thoát lệnh.

Mong các bạn hiểu ý mình, hehe, Cảm ơn trước nha mọi người!

Hề hề hề,

Bậu down lại lisp này nhé

(DEFUN C:THKL (/ ssl dtl dtt e1 e2 e3 ltt et goc)
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 66 1)))))
(while (setq e1 (car (nentsel "\n Chon thuoc tinh loc")))
(setq dtl (cdr (assoc 1 (entget e1))))
(setq goc 0)
(setq dtt (cdr (assoc 2 (entget (setq e2 (car (nentsel "\n Chon thuoc tinh can tinh")))))))
(setq ltt (list))
(foreach e ssl
    (setq et (entnext e))
    (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
            (if (and (= (cdr (assoc 1 (entget et))) dtl) (= (cdr (assoc 2 (entget et))) (cdr (assoc 2 (entget e1)))))                          
                (setq ltt (append ltt (list e)))
            )
            (setq et (entnext et))
    )
)
(foreach e ltt
     (setq et (entnext e))
     (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
              (if (= (cdr (assoc  2 (entget et))) dtt)
                  (setq goc (+ goc (atof (cdr (assoc 1 (entget et))))))
              )
              (setq et (entnext et))
      )
)
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget (setq e3 (car (nentsel "\n Chon text can thay the"))))) (entget e3)))
(entupd e3)
)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 07 May 2015 - 06:38 PM

 

Hề hề hề,

Bậu down lại lisp này nhé

(DEFUN C:THKL (/ ssl dtl dtt e1 e2 e3 ltt et goc)
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 66 1)))))
(while (setq e1 (car (nentsel "\n Chon thuoc tinh loc")))
(setq dtl (cdr (assoc 1 (entget e1))))
(setq goc 0)
(setq dtt (cdr (assoc 2 (entget (setq e2 (car (nentsel "\n Chon thuoc tinh can tinh")))))))
(setq ltt (list))
(foreach e ssl
    (setq et (entnext e))
    (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
            (if (and (= (cdr (assoc 1 (entget et))) dtl) (= (cdr (assoc 2 (entget et))) (cdr (assoc 2 (entget e1)))))                          
                (setq ltt (append ltt (list e)))
            )
            (setq et (entnext et))
    )
)
(foreach e ltt
     (setq et (entnext e))
     (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
              (if (= (cdr (assoc  2 (entget et))) dtt)
                  (setq goc (+ goc (atof (cdr (assoc 1 (entget et))))))
              )
              (setq et (entnext et))
      )
)
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget (setq e3 (car (nentsel "\n Chon text can thay the"))))) (entget e3)))
(entupd e3)
)
)

Oke, cảm ơn bạn nhiều nhé, bạn sửa giúp mình cái lisp của bạn bach_gia luôn y!!


  • -1

#20 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 May 2015 - 10:22 PM

Hehe, Cảm ơn mọi người nhiều nhé, có được 2 lisp này là mình cũng vui lắm rồi, để mình tự kết hợp qua lại cũng được!

Các bạn chỉnh sửa lại 2 lisp trên một chút nữa giúp mình nhé!

- Với lisp của bạn bach_gia thì chỉnh sửa giúp mình là bỏ 2 dòng trên text trên chỉ còn lại thế này: (không hiểu biết về viết lisp nên mò cả đêm hôm qua mà không được :(( )

136880_capture.png

 

 

Mạn phép anh giabach Tue_NV sửa lại chút đỉnh cho  phù hợp với y/c của bạn pawuta

(defun c:ThKl (/ doc)
  (vl-load-com)
  (princ "\nChon Block can tong hop :")
  (if (ssget (list (cons 0 "INSERT")(cons 66 1)))
    (tkatt (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))))
  (vla-get-modelspace doc) "DK" "TCD" "TKL" )
    (princ "\nKhong chon duoc Block thuoc tinh."))
  (princ))
(defun tkatt (ssets msp idTag val1tag val2tag / asoc h i id lst pt row tblobj val1 val2 width)
    ;;  By : Gia_Bach, www.CadViet.com 2015 ;;
  (vlax-for obj ssets
    (setq id nil val1 nil val2 nil)
    (foreach att (vlax-invoke obj 'GetAttributes)
      (cond
( (= (vla-get-TagString att) idTag)
 (setq id (vla-get-TextString att)) )
( (= (vla-get-TagString att) val1Tag)
 (setq val1 (vla-get-TextString att)) )
( (= (vla-get-TagString att) val2Tag)
 (setq val2 (vla-get-TextString att)) ) ))
    (if (and id (distof id 2) val1 val2(setq val1 (distof val1 2))(setq val2 (distof val2 2)))
      (if (setq asoc (assoc id lst))
(setq lst (subst (cons id (list (+ val1 (car(cdr asoc))) (+ val2 (cadr(cdr asoc))))) asoc lst))
(setq lst (append lst (list (cons id (list val1 val2)))) )) ))
  (cond
    ( (not lst )
      (princ "\nKhong tim duoc so lieu.") )
    ( (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
      (if (setq pt (getpoint "\nDiem dat Bang tong hop:"))
(progn
 (setq h 1.8 width (* 6 h)
TblObj (vla-addtable msp (vlax-3d-point pt) (length lst) 4 (* 2 h) width))
(vla-unMergeCells TblObj 0 0 0 3)
 (vla-put-regeneratetablesuppressed TblObj :vlax-false)
 (vla-put-vertcellmargin 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-setText TblObj 0 0 "Bang tong hop")
 ;(vla-setText TblObj 1 0 "STT")
 ;(vla-setText TblObj 0 0 idTag)
 ;(vla-setText TblObj 1 2 val1Tag)
 ;(vla-setText TblObj 1 3 val2Tag)
 (setq row 0 i 1)
 (foreach pt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
   (vla-setText TblObj row 0 (itoa i))
   (vla-setText TblObj row 1 (car pt))
   (vla-setText TblObj row 2 (rtos(car(cdr pt))2 2))
   (vla-setText TblObj row 3 (rtos(cadr(cdr pt))2 2))
   (setq row (1+ row) i (1+ i)) )
 (vla-put-regeneratetablesuppressed TblObj :vlax-false)
 (vlax-release-object TblObj)     )))
    ( t
      (foreach it (vl-sort lst '(lambda (x y) (< (car x) (car y))))
(princ (strcat "\n"(car it) " : " (rtos(car(cdr it))2 2) " : " (rtos(cadr(cdr it))2 2))))  ) )
  )

  • 1