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

theducw87

Thành viên
  • Số lượng nội dung

    35
  • Đã tham gia

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

  • Ngày trúng

    2

Bài đăng được đăng bởi theducw87


  1. Mình cần một lisp chuyển nhanh tất cả các layer của các đối tượng của block về layer của block và vẫn giữ nguyên màu sắc của các đối tượng cũ. Bác nào biết chỉ giúp mình với. Mình tìm trên diễn đàn thì có lisp chuyển tất cả layer của đối tượng về layer của block nhưng lại thay đổi cả màu của các đối tượng trong block ấy.


  2. Hiện tại em có một cái lisp copy array theo vector nhưng nếu có text thì không tự động tăng thêm 1. Bác nào hiểu về lisp thì sửa hộ em với. Em dùng lisp này copy một hình chữ nhật bên trong có text number thì sẽ dc là 1111111

    Em muôn sửa lisp để sau khi sử dụng em sẽ được text tăng dần 1234567 như hình vẽ. Đây là lisp ban đầu của em.http://www.cadviet.com/upfiles/3/81217_arrvcopy_array.lsp81217_2.png

    81217_1_1.png


  3. Mình hay in bản vẽ nhưng mỗi lần in là mình lại phải bật hộp thoại layer lên để xem mã màu ( từ 1 đến 255 ) plot style của layer. Các bạn có thể giúp mình một cách nào đó hoặc một lisp nào đó mà khi mình kích vào layer nào đấy thì nó sẽ hiện lên mã màu plot style của nó như thông tin trên quick properties.


  4.  

    Cái này dựa trên lisp của anh Gia_Bach (thanks!), sửa lại vài tí cho bạn dùng.

    
    

    (defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd ss1 x)

     (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
      (defun list->3pair (old / new)
       (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                 old (cdddr old))) new)
      (setq i -1)
      (while (setq e (ssname ss (setq i (1+ i))))
       (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
        (setq lst_pt (append (list->3pair pts) lst_pt))))
      (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
     (vl-load-com)
     (setq cd (getreal "\nChieu dai moi doan chia: "))
     (if (and (setq pt1 (getpoint "\nDiem dau :"))
                   (setq pt2 (getpoint pt1 "\nDiem cuoi :"))
                   (setq pt3 (getpoint "\nDiem dat duong dim :")))
      (progn
       (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
       (repeat (1+ n)
        (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pt3a (polar px (+ (angle px pt3) pi) 1))
        (entmakex (list (cons 0 "LINE") (cons 10 pt3) (cons 11 pt3a)))
        (setq ss1 (ssadd (entlast) ss1))
        (setq x (1+ x)))
       (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
        (progn
         (entmakex (list (cons 0 "LINE") (cons 10 pt2) (cons 11 (polar pt2 (+ (angle pt2 pt3) pi) 1))))
         (setq ss1 (ssadd (entlast) ss1))))
       (setq ss (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
       (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
                 line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
       (setq pts (Get_pts_ss_inter_obj ss line))
       (if (> (vl-list-length pts) 1)
        (progn
         (setq sta (car pts) i 1)
         (repeat (- (vl-list-length pts)1)
          (setq end (nth i pts) i (1+ i))
          (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
          (setq sta end))))
       (vla-delete line)))
       (command "erase" ss1 "")
     (princ))

    Nó vẫn bị lỗi bạn à! mình chọn điểm đầu và điểm cuối của đoạn thẳng nhưng nếu có 2 line khác cắt ngang line đấy thì nó sẽ dim cả khoảng cách đoạn cắt đấy. Bạn có cách nào sửa không? mình chỉ muốn chia một đoạn thẳng mà mình chọn thôi, các đường khác không quan tâm đến.

×