Sửa lisp

[Chutuyen 3]

Nhờ các bác sửa giúp đoạn lisp em sưu tầm được:

đoạn lisp coppy theo thứ tự từ trái qua phải, em muốn sửa thành coppy từ trên xuống dưới mong, các bác giúp đỡ? xin chân thành cảm ơn.!

[Chutuyen 3]

(defun C:TCC (/ lst str txt 2ClipB) ;***** TCC = copy *****

  (vl-load-com)

  (princ "\nChon cac Text/Mtext/Dimension can copy...")

  (setq lst (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION")))))

  (setq str "")

  (foreach n lst

    (cond

      ((= (cdr (assoc 0 (entget n))) "TEXT")
       (setq txt (cdr (assoc 1 (entget n))))
      )

      ((= (cdr (assoc 0 (entget n))) "MTEXT")
       (setq txt (cdr (assoc 1 (entget n))))
      )

      ((= (cdr (assoc 0 (entget n))) "DIMENSION")

       (if (= (cdr (assoc 1 (entget n))) "")

     (setq txt (rtos (cdr (assoc 42 (entget n)))2 0))

     (setq txt (cdr (assoc 1 (entget n))))
       )
      )
    )

    (setq str (strcat str txt "\n"))
  )
  (vlax-invoke
    (vlax-get
      (vlax-get    (setq 2ClipB (vlax-create-object "htmlfile"))
        'ParentWindow
      )
      'ClipBoardData
    )
    'SetData
    "Text"
    str
  )
  (vlax-release-object 2ClipB)
(princ)
)

;*********************************************

(defun C:DD (/ ss->vla s1 s2 s3 s11 s12 n e1 e2 i j i1 ii) ;***** DD -> da'n *****
(vl-load-com)

    (setq s11 (QGetClipText))
    
    (princ "\nSelect Texts to Paste value:  ")
    
    (setq s2 (ssget '((0 . "*TEXT"))))

    (command "_.undo" "_be")
    ;*******************
    (setq ii 0)
    (While (> (vl-string-search "\n" s11) 0)
        (setq s11 (vl-string-subst "*" "\n" s11))
        (setq ii (+ 1 ii))
    )
    ;******************

    (setq s1 (vl-sort (ss_vla s2)
                 '(lambda (a b)
                (< (car (vlax-get a 'InsertionPoint))
                   (car (vlax-get b 'InsertionPoint))
                )
                  )
          )
    )

    (setq s2 (vl-sort (ss_vla s2)
                 '(lambda (a b)
                (< (car (vlax-get a 'InsertionPoint))
                   (car (vlax-get b 'InsertionPoint))
                )
                  )
          )
    )

    ;******************
    (If (> ii (vl-list-length s2))
        (Progn
            (Alert "So kich thuoc copy nhieu hon so kich thuoc can da'n !")
            (command "_.undo" "_end")
            (Ext)
        )
    )
    ;******************

    (setq i1 -1)
    (setq s12 "")
    (While (> (strlen s11) 0)
        (setq s12 (substr s11 1 (vl-string-search "*" s11)))
        (setq s11 (vl-string-subst "" (strcat s12 "*") s11))
        (vla-put-textstring (nth (setq i1 (1+ i1)) s1) s12)
    )
    
    ;**********************

    (setq s3 "")
    (setq i 0)
    (setq j 1)
    (While (< i (- ii 1))
        (While (< j ii)
            (if (> (atof (vla-get-textstring (nth i s1))) (atof (vla-get-textstring (nth j s1))))
                (Progn
                (setq s3 (vla-get-textstring (nth i s1)))
                (vla-put-textstring (nth i s1) (vla-get-textstring (nth j s1)))
                (vla-put-textstring (nth j s1) s3)
                )

                )    
            (setq j (+ 1 j))
        )
        (setq  j (+ 1 i))
        (setq i (+ 1 i))
    )

    (setq n  (min (vl-list-length s1) (vl-list-length s2)))

    (setq i  -1)
    (repeat n
        (vla-put-textstring
            (nth (setq i (1+ i)) s2)
            (vla-get-textstring (nth i s1))
        )
    )
    (command "_.undo" "_end")

(princ)
)

[Bee 154]

Thay hết 

 (< (car (vlax-get a 'InsertionPoint))
                   (car (vlax-get b 'InsertionPoint))

 

thành

 (> (cadr (vlax-get a 'InsertionPoint))
                   (cadr (vlax-get b 'InsertionPoint))

[Chutuyen 3]

em làm theo hướng dẫn mà không được bác à?

[Bee 154]

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

em làm theo hướng dẫn mà không được bác à?

   (setq s1 (vl-sort (ss_vla s2)
                 '(lambda (a b)
                (< (car (vlax-get a 'InsertionPoint))
                   (car (vlax-get b 'InsertionPoint))
                )
                  )
          )
    )

    (setq s2 (vl-sort (ss_vla s2)
                 '(lambda (a b)
                (< (car (vlax-get a 'InsertionPoint))
                   (car (vlax-get b 'InsertionPoint))
                )
                  )
          )
    ) 

thay cả 2 dòng này chưa ?

[Chutuyen 3]

em thay cả 2 rồi mà,

[Bee 154]

Chayj lisp thì nó báo gì trên CAD. Bạn copy paste lên đây xem nào .

[Chutuyen 3]

không theo thứ tự b à? 

[Bee 154]

28 phút trước, Chutuyen đã nói:

không theo thứ tự b à? 

gửi lại file cad lên đây. Có ghi rõ trước và sau khi chạy lisp nhé b.

[Chutuyen 3]

KIỂU NÀY B ƠI

COPPY LOAT.dwg