Em cần sửa lisp TCountV1-2.lsp ạ

[Xuân Lộc 5]

Em muốn sửa lisp này nó sắp xếp theo thứ tự 1,2,3,4,5,6,7,8,9,10,11 thay vì 1,11,12,2,22,23. Phần đếm số lượng thì để 2 số thay vì 1 số như trong bảng ạ. Khi đặt bảng có tuỳ chọn chiều cao text nữa. ong mọi người hỗ trợ, giúp đỡ

TCountV1-2.lsp

[tannguyen291 135]

Sửa lisp của lee mac là cái gì đó rất mệt. Bạn nên đặt tên thống nhất số phía sau thì oke hơn. ví dụ thay vì S1 thì đặt là S01

tuy nhiên muốn sửa lisp thì cũng có thể nhưng nó sẽ không hoạt động ổn định với những String quá đặc biệt

tìm dòng 180 có đoạn (function (lambda ( a b ) (< (car a) (car b))))

thay bằng 

(function

  (lambda ( a b / a1 a2 b1 b2)

    (setq

      a1 (vl-string-right-trim "0123456789" a)

      a2 (atoi (substr a (1+ (strlen a1))))

      b1 (vl-string-right-trim "0123456789" b)

      b2 (atoi (substr b (1+ (strlen b1))))

    )

    (if (= a1 b1) (< a2 b2) (< a1 b1))

  )

)

[Xuân Lộc 5]

1 giờ} trướ}c, tannguyen291 đã nói:

Sửa lisp của lee mac là cái gì đó rất mệt. Bạn nên đặt tên thống nhất số phía sau thì oke hơn. ví dụ thay vì S1 thì đặt là S01

tuy nhiên muốn sửa lisp thì cũng có thể nhưng nó sẽ không hoạt động ổn định với những String quá đặc biệt

tìm dòng 180 có đoạn (function (lambda ( a b ) (< (car a) (car b))))

thay bằng 

(function

  (lambda ( a b / a1 a2 b1 b2)

    (setq

      a1 (vl-string-right-trim "0123456789" a)

      a2 (atoi (substr a (1+ (strlen a1))))

      b1 (vl-string-right-trim "0123456789" b)

      b2 (atoi (substr b (1+ (strlen b1))))

    )

    (if (= a1 b1) (< a2 b2) (< a1 b1))

  )

)

(defun c:tCount

   ( /

    *error*
    _StartUndo
    _EndUndo
    _Assoc++
    _SumAttributes
    _GetTextString
    _ApplyFooToSelSet

    acdoc
    acspc
    alist
    data
    pt

  )

;;------------------------------------------------------------;;
  
  (defun *error* ( msg )
    (if acdoc (_EndUndo acdoc))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  )

;;------------------------------------------------------------;;

  (defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
  )
  
;;------------------------------------------------------------;;

  (defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
  )

;;------------------------------------------------------------;;

  (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"
          (cdr
            (assoc 0
              (entget
                (setq entity (entnext entity))
              )
            )
          )
        )
      )
      (setq alist (_Assoc++ (_GetTextString entity) alist))
    )
  )

;;------------------------------------------------------------;;
  
  (defun _GetTextString ( entity )    
    (
      (lambda ( string )
        (mapcar
          (function
            (lambda ( pair )
              (if (member (car pair) '(1 3))
                (setq string (strcat string (cdr pair)))
              )
            )
          )
          (entget entity)
        )
        string
      )
      ""
    )
  )

;;------------------------------------------------------------;;

  (defun _ApplyFooToSelSet ( foo ss / i )
    (if ss (repeat (setq i (sslength ss)) (foo (ssname ss (setq i (1- i))))))
  )

;;------------------------------------------------------------;;

  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
  )
  (cond
    ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
      (princ "\nCurrent Layer Locked.")
    )
    ( (not (vlax-method-applicable-p acspc 'AddTable))
      (princ "\nTable Object not Available in this version.")
    )
    ( (and
        (setq data
          (_ApplyFooToSelSet
            (lambda ( entity / typ )
              (setq alist
                (cond
                  ( (eq "INSERT" (setq typ (cdr (assoc 0 (entget entity)))))
                    (_SumAttributes entity alist)
                  )
                  ( (eq "MULTILEADER" typ)
                    (_Assoc++ (cdr (assoc 304 (entget entity))) alist)
                  )
                  ( (wcmatch typ "*DIMENSION")
                    (_Assoc++ (cdr (assoc 1 (entget entity))) alist)
                  )
                  ( (_Assoc++ (_GetTextString entity) alist) )
                )
              )
            )
            (ssget
             '(
                (-4 . "<OR")
                  (0 . "TEXT,MTEXT,MULTILEADER")
                  (-4 . "<AND")
                    (0 . "INSERT")
                    (66 . 1)
                  (-4 . "AND>")
                  (-4 . "<AND")
                    (0 . "*DIMENSION")
                    (1 . "*?*")
                  (-4 . "AND>")
                (-4 . "OR>")
              )
            )
          )
        )
        (setq pt (getpoint "\nSpecify Point for Table: "))
      )
      (_StartUndo acdoc)
      (LM:AddTable acspc (trans pt 1 0) "String Count"
        (cons (list "String" "Instances")
          (vl-sort
            (mapcar
              (function

  (lambda ( a b / a1 a2 b1 b2)

    (setq

      a1 (vl-string-right-trim "0123456789" a)

      a2 (atoi (substr a (1+ (strlen a1))))

      b1 (vl-string-right-trim "0123456789" b)

      b2 (atoi (substr b (1+ (strlen b1))))

    )

    (if (= a1 b1) (< a2 b2) (< a1 b1))

  )

)
          )            
        )
      )
      (_EndUndo acdoc)
    )
  )
  (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 / _isAnnotative textheight style )

  (defun _isAnnotative ( style / object annotx )
    (and
      (setq object (tblobjname "STYLE" style))
      (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
      (= 1 (cdr (assoc 1070 (reverse annotx))))
    )
  )

  (
    (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)) textheight
          (* 0.8 textheight
            (apply 'max
              (cons (/ (strlen title) (length (car data)))
                (mapcar 'strlen (apply 'append data))
              )
            )
          )
        )
      )
      (* 2.
        (/
          (setq textheight
            (vla-gettextheight
              (setq style
                (vla-item
                  (vla-item
                    (vla-get-dictionaries (vla-get-document space)) "ACAD_TABLESTYLE"
                  )
                  (getvar 'CTABLESTYLE)
                )
              )
              acdatarow
            )
          )
          (if (_isAnnotative (vla-gettextstyle style acdatarow))
            (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 ))
            1.0
          )
        )
      )
    )
  )
)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

em thay nhưng lisp ko hoạt động anh ạ, nếu ko đc anh giúp em cho cái chọn text chữ trước khi chèn cũng đc ạ, tại cứ phải scan chữ lên mà ko phải lúc nào cũng cùng 1 cỡ chữ

[tannguyen291 135]

Thay lại nhé mình viết thiếu

            (function

              (lambda ( a b / a1 a2 b1 b2)

                (setq

                  a (car a)

                  b (car b)

                  a1 (vl-string-right-trim "0123456789" a)

                  a2 (atoi (substr a (1+ (strlen a1))))

                  b1 (vl-string-right-trim "0123456789" b)

                  b2 (atoi (substr b (1+ (strlen b1))))

                )

                (if (= a1 b1) (< a2 b2) (< a1 b1))

              )

            )

[NTHAHT 83]

38 phút trước, Xuân Lộc đã nói:

em thay nhưng lisp ko hoạt động anh ạ, nếu ko đc anh giúp em cho cái chọn text chữ trước khi chèn cũng đc ạ, tại cứ phải scan chữ lên mà ko phải lúc nào cũng cùng 1 cỡ chữ

Chiều cao chữ thì bạn có thể hiệu chỉnh trong Table style.