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

Nguyễn Minh Chương

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

  • Số lượng nội dung

    11

  • Đã tham gia

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

Bài đăng được đăng bởi Nguyễn Minh Chương

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

     

    Vào lúc 9/1/2015 tại 07:56, Doan Van Ha đã nói:

    Lisp đếm block atrribute sưu tầm. Lệnh CAV.

     

    • cav nil_countattributevalues_attsum.lsp
      lisp help
    •   
    
;;-----------------=={ Count Attribute Values }==-------------;;
;  Counts the number of occurrences of attribute values in a selection of attributed blocks. Displays result in an AutoCAD Table object.
;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
(defun c:CAV nil (c:CountAttributeValues))
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )
  (defun _Dxf ( key alist ) (cdr (assoc key alist)))
  (defun _Assoc++ ( key alist )
    ((lambda ( pair )
        (if pair
          (subst (list key (1+ (cadr pair))) pair alist)
          (cons  (list key 1) alist)))
      (assoc key alist)))
  (defun _SumAttributes ( entity alist )
    (while
      (not
        (eq "SEQEND"
          (_dxf 0
            (entget
              (setq entity
                (entnext entity))))))
      (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))))
  (cond
    ((not
        (vlax-method-applicable-p
          (setq space
            (vlax-get-property
              (setq doc
                (vla-get-ActiveDocument (vlax-get-acad-object)))
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)))
          'AddTable))
      (princ "\n** This Version of AutoCAD Does not Support Tables **"))
    ((and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength ss))
          (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist)))
        (setq pt (getpoint "\nPick Point for Table: ")))
      (LM:AddTable space (trans pt 1 0) "Attribute Totals"
        (cons '("Value" "Total")
          (vl-sort
            (mapcar
              (function
                (lambda ( pair )
                  (list (car pair) (itoa (cadr pair)))))
              alist)
            (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))))))
  (princ))
;;-------------------=={ Attribute Sum }==--------------------;;
;  Sums numerical attributes of the same tag in a selection of attributed blocks. Displays result in AutoCAD Table object.
;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
(defun c:AttSum ( / _assoc+ doc space ss n lst pt )
  (vl-load-com)
  (defun _assoc+ ( key value lst )
    ((lambda ( pair )
        (if pair
          (subst (list key (+ (cadr pair) value)) pair lst)
          (cons  (list key value) lst)))
      (assoc key lst)))
  (cond
    ((not
        (vlax-method-applicable-p
          (setq space
            (vlax-get-property
              (setq doc
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)))
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)))
          'AddTable))
      (princ "\n** This Version of AutoCAD Does not Support Tables **"))
    ((and (ssget '((0 . "INSERT") (66 . 1)))
        (progn
          (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
            (mapcar
              (function
                (lambda ( attrib )
                  (if (setq n (distof (vla-get-TextString attrib)))
                    (setq lst (_assoc+ (vla-get-TagString attrib) n lst)))))
              (vlax-invoke obj 'GetAttributes)))
          (vla-delete ss)
          (setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst)))
        (setq pt (getpoint "\nPick Point for Table: ")))
      (LM:AddTable space (trans pt 1 0) "Attribute Totals"
        (cons '("Tag" "Total") (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))))))
  (princ))
;;---------------------=={ Add Table }==----------------------;;
;  Creates a VLA Table Object at the specified point, populated with title and data.
;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;  Arguments:                                                ;;
;  space - VLA Block Object                                  ;;
;  pt    - Insertion Point for Table                         ;;
;  title - Table title                                       ;;
;  data  - List of data to populate the table                ;;
;  Returns:  VLA Table Object                                ;;
(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)
  (defun _itemp ( collection item )
    (if
      (not
        (vl-catch-all-error-p
          (setq item
            (vl-catch-all-apply 'vla-item (list collection item)))))
      item))
  ((lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
      ((lambda ( row )
          (mapcar
            (function
              (lambda ( rowitem ) (setq row (1+ row))
                ((lambda ( column )
                    (mapcar
                      (function
                        (lambda ( item )
                          (vla-SetText table row
                            (setq column (1+ column)) item)))
                      rowitem))
                  -1)))
            data))
        0)
      table)
    ((lambda ( textheight )
        (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
          (* textheight
            (apply 'max
              (cons (/ (strlen title) (length (car data)))
                (mapcar 'strlen (apply 'append data)))))))
      (vla-getTextHeight
        (_itemp
          (_itemp
            (vla-get-Dictionaries
              (vla-get-ActiveDocument (vlax-get-acad-object)))
            "ACAD_TABLESTYLE")
          (getvar 'CTABLESTYLE))
        acDataRow))))
(princ)

    Sao mình thực hiện lisp trên nó báo lỗi là "error: no function definition: C:COUNTATTRIBUTEVALUES"

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

    9 phút trước, ngokiet đã nói:

    Dùng notepad mở file cc.lst

    Bạn sửa dòng thứ 7 dưới lên từ

    (cons 1 (strcat "L= " (rtos tl 2 0) " mm"))

    Thành 

    (cons 1 (strcat "L= " (rtos (/ tl 1000) 2 0) " m"))

    Cảm ơn bạn, nhưng mình muốn nó thể hiện số thập phân nữa thì sao bạn, khoảng 1 2 số để mình có thể làm tròn lên, làm tròn xuống kết quả đó.

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

    1 giờ} trướ}c, Bee đã nói:
    9 giờ trước, Nguyễn Minh Chương đã nói:

    Xuất ra vị trí tùy ý khi mình dùng chuột chọn vị trí đó, VD: khi mình chọn xong các đường để đo, space rồi nhập chuột trái 1 vị trí bất kỳ thì text tổng độ dài nó xuất hiện ở vị trí đó.

    Còn to nhỏ thì không thành vấn đề, chỉ cần nhìn thấy là được rồi.

    Cảm ơn bạn.

    Ok đã chỉnh nhé. ^_^ 

    
(defun c:cc  (/ ss tl n ent itm obj l txt)
  (setq ss (ssget)
        tl 0
        n  (1- (sslength ss)))
  (while (>= n 0)
    (setq ent (entget (setq itm (ssname ss n)))
          obj (cdr (assoc 0 ent))
          l   (cond
                ((= obj "LINE")
                 (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
                ((= obj "ARC")
                 (* (cdr (assoc 40 ent))
                    (if (minusp (setq l (- (cdr (assoc 51 ent))
                                           (cdr (assoc 50 ent)))))
                      (+ pi pi l)
                      l)))
                ((or (= obj "CIRCLE")
                     (= obj "SPLINE")
                     (= obj "POLYLINE")
                     (= obj "LWPOLYLINE")
                     (= obj "ELLIPSE"))
                 (command "_.area" "_o" itm)
                 (getvar "perimeter"))
                (t 0))
          tl  (+ tl l)
          n   (1- n)))

  (entmake
    (list
      (cons 0 "TEXT")
      (cons 100 "AcDbText")
      (cons 10 (trans (getpoint "\nCh\U+1ECDn v\U+1ECB trí \U+0111\U+1EB7t text: ") 1 0))
      (cons 40 (getvar 'TEXTSIZE))
      (cons 1 (strcat "L= " (rtos tl 2 0) " mm"))
      (cons 50 0.0)
      (cons 62 4)      
      )
    )
  (princ)
  )

     

    Woa Woa, cảm ơn bạn rất nhiều, bạn giỏi quá. Mà ngại quá, bạn chỉ mình cách chỉnh chữ lớn lên được ko, nó xuất ra cỡ chứ 1.5 à, mình phải zoom lên mấy vòng với thấy được.

    Cảm ơn bạn

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

    2 giờ trước, Bee đã nói:
    14 giờ trước, Nguyễn Minh Chương đã nói:

    Cảm ơn bạn "Bee" rất nhiều, mình ko biết làm sao để đính kèm bình luận trên, hjhjhj

    Bạn "Bee" cho mình hỏi tí, là làm sao để lệnh lisp đó nó xuất kết quả ra thành text luôn không cần phải ghi đè kết quả đó lên 1 text có sẵn.

    Cảm ơn bạn rất nhiều.

    Xuất thành text ở vị trí nào ? to hay nhỏ theo cỡ nào ? Phải xác định được các cái đó thì xuất text đơn giản thôi ^_^

    Xuất ra vị trí tùy ý khi mình dùng chuột chọn vị trí đó, VD: khi mình chọn xong các đường để đo, space rồi nhập chuột trái 1 vị trí bất kỳ thì text tổng độ dài nó xuất hiện ở vị trí đó.

    Còn to nhỏ thì không thành vấn đề, chỉ cần nhìn thấy là được rồi.

    Cảm ơn bạn.

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

    Chào mọi người, mình không hiểu lắm về lisp cad nên nhờ mọi người giúp đỡ.

    Mình có lisp tính tổng độ dài, hiện tại nó chỉ tính được đường Polyline và xuất kết quả ra 1 text đã có sẵn trên mặt bằng. Giờ mình muốn sửa lại lisp một tí là muốn nó tính được cả đường line và tự xuất ra text.

    Mong mọi người giúp đỡ ạ. (file mình có đính kèm)

     

    cc.lsp

×