Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Chutuyen

Sửa lisp

Các bài được khuyến nghị

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.!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

(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)
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 ?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
28 phút trước, Chutuyen đã nói:

không theo thứ tự b à? 

121.JPG

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×