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

nguyentuyen6

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    212

  • Đã tham gia

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

  • Ngày trúng

    3

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

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

    Mình cũng làm thử 1 cái,

    cái này chọn circle nào thì no' insert lên circle đó

     

    (defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun c:isb (/ cir i OldOs tam)
(BatDauVe)
(setq i 0)
(setq ss (ssget '((0 . "*CIRCLE"))))
     (while (< i (sslength ss))
  (setq cir (ssname ss i))
  (setq tam (cdr (assoc 10 (entget cir))))
 (command "-INSERT" "hk" tam "" "" "")
 (setq i (1+ i))
);_ end while
(KetThucVe)
);_ end defun

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

    Mình có câu hỏi như vậy. Nếu trong lisp có đoạn code sau:

     

    		(initget "C K") ;;;Init keywords
                    (setq ans (getkword "\nBan co muon... [C/K] :")) ;;;Get answer from user
                    (if (= ans "C") (Command ,,,,,))

     

    khi chạy líp nó bắt mình nhập C hoặc K nhưng chỉ thấy có hàm if cho C mà không có hàm if dùng cho K. Vậy có phải là khi mình không nhập gì mà ấn ENTER hoặc Space luôn thì nó tự nhận giá trị là K luôn à ????.

    Thank!!!!

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

    Mình thử sửa lại cái code của 1 bác trên 4rôm để đc cái líp quay text mà no không chạy đc!! ai xem giup mình với

     

    (defun c:rot (/ txt newang newrad i)
(setq ss (ssget '((0 . "*text")))
      newang (getreal "\nNhap goc quay: ")
      newrad ((/ (* newang pi) 180))
      i 0
 )  
(while (< i (sslength ss))
  (setq txt (ssname ss i))
  (entmod (subst (cons 50 newrad) (assoc 50 (entget txt)) (entget txt)))
 (setq i (1+ i))
);_ end while
);_ end defun

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

    Cũng cái líp trên nhưng khi mình thêm hàn IF để chia trường hợp thì nó lại báo lỗi

    Select objects: Specify opposite corner: 3 found

    Select objects: ; error: bad argument type: 2D/3D point: nil

    Các bác giúp e xem nó bị làm sao vơi nhé. Thank!!!

     

    ;; free lisp from cadviet.com

(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun LayDiem() p1 (polar tam 0.0 (+ bk k))
  p2 (polar tam pi (+ bk k))
  p3 (polar p2 (/ pi 2) (+ bk k))
  p4 (polar p1 (/ (* pi 3) 2 ) (+ bk k)))
(defun c:ct (/ ten tam bk i p1 p2 p3 p4 k )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i)
     tam (cdr (assoc 10 (entget ten)))
     bk (cdr (assoc 40 (entget ten))))
  (if (>= bk 300) 
     (setq k 75) 
        )
  (if (and (< bk 300) (> bk 100))
     (setq k 50)) 

  (if (<= bk 100)
     (setq k 25) 
        )
     (LayDiem)
  (BatDauVe)
  (command "CIRCLE" tam (+ bk k))
  (command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

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

    Ai sửa giúp e đoạn code này với

    E nghi nó hỏng chỗ lấy tâm của đg tròn:

     

    ;; free lisp from cadviet.com
(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun c:vidu (/ ten tam bk i p1 p2 p3 p4 )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i))
     tam (cdr (assoc 10 ss))
     bk (cdr (assoc 40 ss))
     p1 (polar tam 0.0 (+ bk 75))
  p2 (polar tam pi (+ bk 75))
  p3 (polar p2 (/ pi 2) (+ bk 75 ))
  p4 (polar p1 (/ (* pi 3) 2 ) (+ bk 75 ))
;(setvar "clayer" "manh")
(BatDauVe)
(command "CIRCLE" tam (+ bk 50))
;;;----------
;(setvar "clayer" "thay")
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

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

    Ai viết giùm mình1 líp như thể này để mình đọc rùi ứng dụng cho những T/h khác với:

     

    1)Chọn điểm 1, chọn điểm 3. chọn điểm 3.................... chọn điểm n. ( thích chọn bao nhiêu điểm cũng đc )

     

    2)Sau khi chọn xong các điểm thì Vẽ các line nối điểm 1 và 2, 2 và 3.........n-1 và n.

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

    Ai có thể giúp mình 1 cái tut về sử dụng các hàm ssget, entmake, subst, entmod, while với.

     

    Vídu: Chọn 1 vùng rồi lọc text chẳng hạn, nhập chiều cao mới của text , dùng các hàm trên để sửa chiều cao của nó theo chiều cao vừa nhập.

     

    Cách dùng các hàm trong líp này ra sao, có tác dụng gì.. Thank nhiều...

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

    Co ai giúp em với.Có lisp nào xoá tất cả các block trong 1 bản vẽ ko.em ngồi xoá từng cái block một mệt quá

     

    Mình chọc ngoáy linh tinh cũng đc cái líp này. Bạn dùng thử xem nhé:

    ;; free lisp from cadviet.com
(defun c:xbl ( / tbl)
(alert "\n Chon vung co block")
(setq tbl (ssget (list (cons 0 "INSERT"))))
     (command "erase" tbl "")
      )

    • Vote tăng 2

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

    @thanhbinh:

     

    cái dòng Command: undo Current settings: Auto = On, Control = All, Combine = Yes có là do trong líp có gọi lệnh Undo begin và undo end. E cũng chưa hiểu tác dụng của cái lệnh này như thế nào cả. khi xóa cà 2 dòng này trong líp đi thì nó sẽ không hiện lên nữa mặc dù em chả hiểu nó có ảnh hưởng gì không nữa. e cung sửa upwb thành upwb1 và chạy cả 2 líp rất ngon. chỉ còn cái vấn đề dim trong block đích thì thôi mặc kệ nó bác ah. Cảm ơn bác rất nhiều.

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

    Nó báo lỗi gì vậy??? Bạn hãy post cái báo lỗi của nó lên nhé. Mình vẫn chưa hiểu lắm vì cái mình chạy thì như bạn đã thấy. Vậy là sao cà????

    Tình hình là như thế này này bac bình ạ:

    Với cái file tét bác gửi lại trên 4r mình nhé:

    ........Lúc đầu e chỉ load líp CH: Thì các text sẽ chuyển về đúng yêu cầu kể cả Text có nằm trong 1 Block ( cao đích - cao nguồn ). Nhưng riêng Dim ở trong BLOCK thì không thay đổi gì cả. ở command thì thông báo như vầy:

     

    Command:

    Chon doi tuong block nguon

    Select objects: Specify opposite corner: 9 found

    Select objects: regen Regenerating model.

    Command: regen Regenerating model.

    Command: regen Regenerating model.

    Command: undo Current settings: Auto = On, Control = All, Combine = Yes

    Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

    <1>: e

     

    Nhưng khi e tiếp tục load líp CS vào thì cái líp CH lại lỗi nếu trong nguồn có block: thông báo nhu* vầy :

     

    Command:

    Chon doi tuong block nguon

    Select objects: Specify opposite corner: 9 found

    Select objects: ; error: too many arguments

     

    Còn nếu chỉ load nguyên Líp CS thì: Với cả text trong đích kể cả nằm trong block vẫn hoạt động tốt ( scale đích theo tỉ lệ X của block nguồn). Nhưng riêng với Dim trong Block thì không biến đổi gi` cả.

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

    @thanhbinh:

    E vữa thử 2 líp bác vữa đưa ra nhưng vẫn không đc bác ợ.

    - Trong líp đầu (ch) nếu đối tượng đích ko có blok thì không sao, líp chạy tốt. Nhưng nếu có cả block thì nó báo :

    Select objects: ; error: too many arguments và không chạy líp.

    - Trong líp thứ 2 (sc). Thì nếu đối tượng đích mà có block thì dim trong block vẫn giữ nguyên, còn text thì vẫn tốt.

    Đây là file cad e dùng để Test:

     

    FileTEST

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

    @ bác Tbinh:

    HỀ hề hề.

    E rất cảm ơn bác đã giúp đỡ và chỉ dẫn rất tận tình cho em các vấn đề e mắc phải.

    Tại dốt quá nhìn cái líp của bác cứ tưởng là 2 trong 1. Không biết là bác tách 2 líp ra khác nhau nên cứ đòi đánh 1 lệnh thì "ăn luôn". Bác thông cảm cho e nhé

    Còn 2 cái líp này để em sẽ "ngâm cứu" cho nó vào chung 1 lệnh cho phù hợp hơn với công việc của em. CẢm ơn bác rất nhiều....

     

    Đây là 2 cái líp đó:

     

    ;; free lisp from cadviet.com
;; Chuyen ve = nhau
(defun c:ch ( / bng ebl stlst htlst sdlst hdlst bln ent els stl ht bld sd ent1
                         els1 std hd sdlst hdlst sst n i et el st bl e1 s1 el1 e2 e3 k m pt)
(vl-load-com)
(command "undo" "be")
(setq bng (car (entsel " \n Chon doi tuong block nguon "))
       stlst (list)
       htlst (list)
       sdlst (list)
       hdlst (list)

)
(while bng
(setq ebl (entget bng))
(if (= (cdr (assoc 0 ebl)) "INSERT")       
   (progn
            (setq  bln (cdr (assoc 2 ebl))
                     ent (cdr (assoc -2 (tblsearch "block"  bln)))         
             )
    )
   (progn
          (alert "\n Doi tuong chon khong phai la block, \n Hay chon lai block chua cac doi tuong nguon")
          (setq bng (car (entsel "\n Chon block chua cac doi tuong nguon")))
    )
)
(setq bng nil)
)
(while ent
        (setq els (entget ent))
        (if  (= (cdr (assoc 0 els)) "TEXT" )
            (progn
                    (setq stl (cdr (assoc 7 els))
                            ht (cdr (assoc 40 els))
                            stlst (append stlst (list stl))
                            htlst (append htlst (list(append stlst (list ht))))
                            stlst (list)
                    )
              )
         )
         (if (= (cdr (assoc 0 els )) "DIMENSION")
            (progn 
                   (setq bld (cdr (assoc 2 els))
                           sd (cdr (assoc 3 els))
                           ent1 (cdr (assoc -2 (tblsearch "block" bld)))
                   )
                   (while ent1
                            (setq els1 (entget ent1))
                            (if (= (cdr (assoc 0 els1)) "MTEXT")
                                (progn
                                      (setq std (cdr (assoc 7 els1))
                                              hd (cdr(assoc 40 els1))
                                              sdlst (append sdlst (list sd))
                                              sdlst (append sdlst (list std))
                                              hdlst (append hdlst (list (append sdlst (list hd))))
                                              sdlst (list)
                                       )
                                   )
                               )
                               (setq ent1 (entnext ent1))
                    )
              )
           )

         (setq ent (entnext ent))
)

(alert "\n Chon tap doi tuong dich")
(setq sst (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION,INSERT")))
       n (sslength sst)
       i 0
)
(while (< i n)
        (setq et (ssname sst i)
                el (entget et)
        )
        (if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls htlst
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (cadr ls)) (assoc 40 el) el))
                      ) 
                      (entmod el)
                )
             )
         )

         (If (= (cdr(assoc 0 el)) "DIMENSION")
             (progn
                   (setq bl (cdr (assoc 2 el))
                           s1 (cdr (assoc 3 el))
                           e1 (cdr (assoc -2 (tblsearch "block" bl)))
                           e2 (entnext (entnext e1))
                           e3 (entnext e2)
                   )
                   (foreach ls1 hdlst
                           (if (= (car ls1) s1)
                               (progn
                                      (setq di (vlax-ename->vla-object et))
                                      (vla-put-textheight di (caddr ls1))
                                )
                             )
                     )
                     (command "regen")
               )
            )
            (if (= (cdr (assoc 0 el)) "INSERT")
                (upwb et htlst hdlst)
            )

         (setq i (1+ i))
)
(command "undo" "e")
(princ)

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk lst1 lst2 / e el s st bl e1 s1 el1 k m pt )
(setq s (cdr (assoc 2 (entget blk))))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (wcmatch (cdr (assoc 0 el)) "INSERT")
(UPWB e)
)
(if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls lst1
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (cadr ls)) (assoc 40 el) el))
                      ) 
                      (entmod el)
                )
             )
         )

(If (= (cdr(assoc 0 el)) "DIMENSION")
   (progn
           (setq bl (cdr (assoc 2 el))
                   s1 (cdr (assoc 3 el))
                   e1 (cdr (assoc -2 (tblsearch "block" bl)))
           )
           (foreach ls1 lst2
                   (if (= (car ls1) s1)
                       (progn
                               (setq di (vlax-ename->vla-object e))
                               (vla-put-textheight di (caddr ls1))
                        )
                    )
           )
           (command "regen")

    )
)

(setq e (entnext e))
)
)     
;;;;

     

    ;; free lisp from cadviet.com
;; Scale theo he so scale cua block nguon

(defun c:cs ( / bng ebl stlst htlst sdlst hdlst bln ent els stl ht bld sd ent1
                  els1 std hd sdlst hdlst sst n i et el st bl e1 s1 el1 e2 e3 k m pt)
(vl-load-com)
(command "undo" "be")
(setq bng (car (entsel " \n Chon doi tuong block nguon "))
       stlst (list)
       htlst (list)
       sdlst (list)
       hdlst (list)
)
(while bng
(setq ebl (entget bng))
(if (= (cdr (assoc 0 ebl)) "INSERT")       
   (progn
            (setq  tl (cdr (assoc 41 ebl))

             )
             (setq bng nil)
    )
   (progn
   (alert "\n Doi tuong chon khong phai la block, hay chon lai block chua cac doi tuong nguon")
   (setq bng (car (entsel "\n Chon block chua cac doi tuong nguon")))
    )
)
)
(alert "\n Chon tap doi tuong dich")
;(alert (strcat "\n Gia tri ty le scale theo truc x (tlx) la: " (rtos tl 2 2)))
(setq sst (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION,INSERT")))
       n (sslength sst)
       i 0
      )
(while (< i n)
        (setq et (ssname sst i)
                el (entget et)

        )



        (if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  ht (cdr (assoc 40 el)))                 
                (setq el (subst (cons 40 (* tl ht)) (assoc 40 el) el))
                (entmod el)                 
             )
         )

         (If (= (cdr(assoc 0 el)) "DIMENSION")
             (progn
                    (setq bl (cdr (assoc 2 el))
                           s1 (cdr (assoc 3 el))
                           e1 (cdr (assoc -2 (tblsearch "block" bl)))
                    )
                   (While e1
                            (setq el1 (entget e1))
                            (if (= (cdr (assoc 0 el1)) "MTEXT")
                               (progn
                                      (setq  k (cdr (assoc 40 el1)) )                                                     
                                )
                             )
                             (setq e1 (entnext e1))
                     )
                     (setq di (vlax-ename->vla-object et))
                     (vla-put-textheight di (* k tl))                            
                     (command "regen")
             )
          )
          (if (= (cdr (assoc 0 el)) "INSERT")
                (upwb et htlst hdlst)
          )          
         (setq i (1+ i))
)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk lst1 lst2 / e el s st bl e1 s1 el1 k m pt )
(setq s (cdr (assoc 2 (entget blk))))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (wcmatch (cdr (assoc 0 el)) "INSERT")
(UPWB e)
)
(if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  ht (cdr (assoc 40 el)))
                (setq el (subst (cons 40 (* tl ht)) (assoc 40 el) el))
                (entmod el)                
             )
)


(If (= (cdr(assoc 0 el)) "DIMENSION")
   (progn
           (setq bl (cdr (assoc 2 el))
                   s1 (cdr (assoc 3 el))
                   e1 (cdr (assoc -2 (tblsearch "block" bl)))
           )
           (While e1
                   (setq el1 (entget e1))
                   (if (= (cdr (assoc 0 el1)) "MTEXT")
                       (progn
                              (setq  k (cdr (assoc 40 el1)) )                                                     
                        )
                    )
                    (setq e1 (entnext e1))
             )
             (setq di (vlax-ename->vla-object e))
             (vla-put-textheight di (* k tl))  
	                (command "regen")                     
    )
)
(setq e (entnext e))
)
)

     

    P/S: hàm defun UPWB dùng để lặp lại các lệnh bên trên nếu trong đối tượng Đích có block, Tuy nhiên khi dùng 2 líp này thì nếu đích có blok thì nó lại không chỉnh cho mình mà vẫn giữ nguyên bác à. Bác xem giúp cho e với nhé. Thankss

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

    Bạn xài thử cái này và hãy so sánh nó với cái trước để tìm sự khác biệt trong đó bạn nhé. Mình cũng chỉ xào nấu lại thôi mà. Gia vị thì cứ tùy miệng thôi. Hề hề hề....

    (defun c:chsize ( / bng ebl stlst htlst sdlst hdlst bln ent els stl ht bld sd ent1
                  els1 std hd sdlst hdlst sst n i et el st bl e1 s1 el1 e2 e3 k m pt)
(vl-load-com)
(command "undo" "be")
(setq bng (car (entsel " \n Chon doi tuong block nguon "))
       stlst (list)
       htlst (list)
       sdlst (list)
       hdlst (list)
)
(while bng
(setq ebl (entget bng))
(if (= (cdr (assoc 0 ebl)) "INSERT")       
   (progn
            (setq  tlx (cdr (assoc 41 ebl))
                     tly (cdr (assoc 42 ebl))
                     tlz (cdr (assoc 43 ebl))        
             )
             (setq bng nil)
    )
   (progn
   (alert "\n Doi tuong chon khong phai la block, hay chon lai block chua cac doi tuong nguon")
   (setq bng (car (entsel "\n Chon block chua cac doi tuong nguon")))
    )
)
)
(alert "\n Chon tap doi tuong dich")
(setq sst (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION,INSERT")))
       n (sslength sst)
       i 0
       ans (getstring "\n Chon ti le scale (tlx or tly or tlz): ")
)
(while (< i n)
        (setq et (ssname sst i)
                el (entget et)

        )
        (if (= ans "tlx") (setq tl tlx)
        (if (= ans "tly") (setq tl tly) 
        (if (= ans "tlz") (setq tl tlz)  (setq tl 1))))

        (if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  ht (cdr (assoc 40 el)))                 
                (setq el (subst (cons 40 (* tl ht)) (assoc 40 el) el))
                (entmod el)                 
             )
         )

         (If (= (cdr(assoc 0 el)) "DIMENSION")
             (progn
                    (setq bl (cdr (assoc 2 el))
                           s1 (cdr (assoc 3 el))
                           e1 (cdr (assoc -2 (tblsearch "block" bl)))
                    )
                   (While e1
                            (setq el1 (entget e1))
                            (if (= (cdr (assoc 0 el1)) "MTEXT")
                               (progn
                                      (setq  k (cdr (assoc 40 el1)) )                                                     
                                )
                             )
                             (setq e1 (entnext e1))
                     )
                     (setq di (vlax-ename->vla-object et))
                     (vla-put-textheight di (* k tl))                            
                     (command "regen")
             )
          )
          (if (= (cdr (assoc 0 el)) "INSERT")
                (upwb et htlst hdlst)
          )          
         (setq i (1+ i))
)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk lst1 lst2 / e el s st bl e1 s1 el1 k m pt )
(setq s (cdr (assoc 2 (entget blk))))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (wcmatch (cdr (assoc 0 el)) "INSERT")
(UPWB e)
)
(if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  ht (cdr (assoc 40 el)))
                (setq el (subst (cons 40 (* tl ht)) (assoc 40 el) el))
                (entmod el)                
             )
)

(If (= (cdr(assoc 0 el)) "DIMENSION")
   (progn
           (setq bl (cdr (assoc 2 el))
                   s1 (cdr (assoc 3 el))
                   e1 (cdr (assoc -2 (tblsearch "block" bl)))
           )
           (While e1
                   (setq el1 (entget e1))
                   (if (= (cdr (assoc 0 el1)) "MTEXT")
                       (progn
                              (setq  k (cdr (assoc 40 el1)) )                                                     
                        )
                    )
                    (setq e1 (entnext e1))
             )
             (setq di (vlax-ename->vla-object e))
             (vla-put-textheight di (* k tl))          
             (command "regen")                     
    )
)
(setq e (entnext e))
)
)

     

    PS: Vì là xào nấu lại nên vẫn còn những tàn dư của code cũ mà mình chưa sửa vì nó không ảnh hưởng gì nhiều tới kết quả. Rất mong bạn cố gắng xử lý nốt các thằng vô tích sự ấy nhé.

     

    E down cái này về dùng không được bác ạ. Dùng líp xong nó vẫn trơ trơ ra. Nhưng cũng dựa vào nó để sửa được một đoạn như thế nay:

     

    ;; free lisp from cadviet.com

(defun c:cs ( / bng ebl stlst htlst sdlst hdlst bln ent els stl ht bld sd ent1
             els1 std hd sdlst hdlst sst n i et el st bl e1 s1 el1 e2 e3 k m pt)
(vl-load-com)
(command "undo" "be")
(setq bng (car (entsel " \n Chon doi tuong block nguon "))
       stlst (list)
       htlst (list)
       sdlst (list)
       hdlst (list)
)
(while bng
(setq ebl (entget bng))
(if (= (cdr (assoc 0 ebl)) "INSERT")       
   (progn
            (setq  bln (cdr (assoc 2 ebl))
                     ent (cdr (assoc -2 (tblsearch "block"  bln)))         
             )
 (setq  tlx (cdr (assoc 41 ebl)))
    )
   (progn
   (alert "\n Doi tuong chon khong phai la block, hay chon lai block chua cac doi tuong nguon")
   (setq bng (car (entsel "\n Chon block chua cac doi tuong nguon")))
    )
)
(setq bng nil)
)
(while ent
        (setq els (entget ent))
        (if  (= (cdr (assoc 0 els)) "TEXT" )
            (progn
                    (setq stl (cdr (assoc 7 els))
                            ht (cdr (assoc 40 els))
                            stlst (append stlst (list stl))
                            htlst (append htlst (list(append stlst (list ht))))
                            stlst (list)
                    )
              )
         )
         (if (= (cdr (assoc 0 els )) "DIMENSION")
            (progn 
                   (setq bld (cdr (assoc 2 els))
                           sd (cdr (assoc 3 els))
                           ent1 (cdr (assoc -2 (tblsearch "block" bld)))
                   )
                   (while ent1
                            (setq els1 (entget ent1))
                            (if (= (cdr (assoc 0 els1)) "MTEXT")
                                (progn
                                      (setq std (cdr (assoc 7 els1))
                                              hd (* tlx (cdr(assoc 40 els1)));;;;;;;;;
                                              sdlst (append sdlst (list sd))
                                              sdlst (append sdlst (list std))
                                              hdlst (append hdlst (list (append sdlst (list hd))))
                                              sdlst (list)
                                       )
                                   )
                               )
                               (setq ent1 (entnext ent1))
                    )
              )
           )

         (setq ent (entnext ent))
)

(alert "\n Chon tap doi tuong dich")
(setq sst (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION,INSERT")))
       n (sslength sst)
       i 0
)
(while (< i n)
        (setq et (ssname sst i)
                el (entget et)
        )
        (if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls htlst
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (* tlx (cadr ls))) (assoc 40 el) el))
                      ) 
                      (entmod el)
                )
             )
         )

         (If (= (cdr(assoc 0 el)) "DIMENSION")
             (progn
                   (setq bl (cdr (assoc 2 el))
                           s1 (cdr (assoc 3 el))
                           e1 (cdr (assoc -2 (tblsearch "block" bl)))
                           e2 (entnext (entnext e1))
                           e3 (entnext e2)
                   )
                   (foreach ls1 hdlst
                           (if (= (car ls1) s1)
                               (progn
                                      (setq di (vlax-ename->vla-object et))
                                      ;(vla-put-textheight di (* tlx (caddr ls1)))
								   (vla-put-textheight di (caddr ls1))
                                )
                             )
                     )
                     (command "regen")
               )
            )
            (if (= (cdr (assoc 0 el)) "INSERT")
                (upwb et htlst hdlst)
            )

         (setq i (1+ i))
)
(command "undo" "e")
(princ)

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk lst1 lst2 / e el s st bl e1 s1 el1 k m pt )
(setq s (cdr (assoc 2 (entget blk))))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (wcmatch (cdr (assoc 0 el)) "INSERT")
(UPWB e)
)
(if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls lst1
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (* tlx (cadr ls))) (assoc 40 el) el))

                      ) 
                      (entmod el)
                )
             )
         )

(If (= (cdr(assoc 0 el)) "DIMENSION")
   (progn
           (setq bl (cdr (assoc 2 el))
                   s1 (cdr (assoc 3 el))
                   e1 (cdr (assoc -2 (tblsearch "block" bl)))
           )
           (foreach ls1 lst2
                   (if (= (car ls1) s1)
                       (progn
                               (setq di (vlax-ename->vla-object e))
                               ;(vla-put-textheight di (* tlx (caddr ls1)))
							(vla-put-textheight di (caddr ls1))
                        )
                    )
           )
           (command "regen")

    )
)

(setq e (entnext e))
)
)

     

    Với TEXT va` MTEXT thì dùng rất ngon, nhưng với Dim thì lại bị sai. Bác chỉnh lại giúp e cái vụ DIM với nhé. Chỉnh theo líp này luôn vì e không muốn mình nhập cái tỷ lệ block 1 cách thủ công bác a.

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

    Chào bạn nguyentuyen6,

    Thực ra yêu cầu này của bạn không phải quá khó, nhất là khi bạn đã có cái lisp mình viết vừa rồi. Vấn đề của bạn khác với cái lisp vừa rồi chỉ ở mỗi cái phần lấy chiều cao text ở tập hợp nguồn mà thôi. Do đó thay vì các đoạn code lấy giá trị chiều cao text của các text và chiều cao text của các dim trong tập chọn

    bạn sẽ điền vào các đoạn code lấy giá trị tỷ lệ scale của block theo các trục tùy ý bạn chọn.

     

    Sau đó ở phần xừ lý các đối tượng trong tập đích thay vì các đoạn code lấy giá trị của chiều cao text mới, bạn điền vào các code để lấy chiều cao đó bằng giá trị của tỷ lệ scale mà bạn chọn và nhân với chiều cao của text hiện hành.

     

    Đoạn code sau đây sẽ lấy giá trị của tỷ lệ scale theo trục x của một block được chọn:

    (setq tlx (cdr (assoc 41 (entget (car (entsel "\n Chon block nguon"))))))

     

    Mong bạn hãy cố gắng thử làm xem sao. Rất mong bạn thành công.

    Trường hợp bạn không thể, hãy nói rõ bạn chưa hiểu chỗ nào, mình sẽ hướng dẫn thêm bạn nhé.

     

    Thank bác Tbình nhiều.

    Hixx. E bây h mới bắt đầu tìm hiểu về líp. bây h nhìn luôn vào code của bác thực sự em thấy hoa hết cả mắt. Em cũng đã thu? sửa lại code của bác mà không hiểu đc gì nhiều. Tự nhiên tiếp xúc với bao nhiêu hàm mà không hiểu gì về nó nhiều. đọng đến cái gì cũng phải giở HELP cả. Chưa hiểu được bản chất của hàm nên việc đọc - hiểu cũng đá khó khăn lắm rùi. Về hàm:

    (setq tlx (cdr (assoc 41 (entget (car (entsel "\n Chon block nguon")))))) thực ra e cũng đã xào nấu lại được trước khi hỏi bác rùi nhưng ko thể sửa dc. Ví dụ như khi dùng hàm ssg để lấy thông tin DFX của OBJ thì lại kô biết làm sao để MODIFIY nó. E tìm hiểu thì hình như dùng hàm "entmod" gì đó. Hix. Mong bác giúp e.......

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

    Chào bạn nguyentuyen6,

    Thực ra yêu cầu này của bạn không phải quá khó, nhất là khi bạn đã có cái lisp mình viết vừa rồi. Vấn đề của bạn khác với cái lisp vừa rồi chỉ ở mỗi cái phần lấy chiều cao text ở tập hợp nguồn mà thôi. Do đó thay vì các đoạn code lấy giá trị chiều cao text của các text và chiều cao text của các dim trong tập chọn

    bạn sẽ điền vào các đoạn code lấy giá trị tỷ lệ scale của block theo các trục tùy ý bạn chọn.

     

    Sau đó ở phần xừ lý các đối tượng trong tập đích thay vì các đoạn code lấy giá trị của chiều cao text mới, bạn điền vào các code để lấy chiều cao đó bằng giá trị của tỷ lệ scale mà bạn chọn và nhân với chiều cao của text hiện hành.

     

    Đoạn code sau đây sẽ lấy giá trị của tỷ lệ scale theo trục x của một block được chọn:

    (setq tlx (cdr (assoc 41 (entget (car (entsel "\n Chon block nguon"))))))

     

    Mong bạn hãy cố gắng thử làm xem sao. Rất mong bạn thành công.

    Trường hợp bạn không thể, hãy nói rõ bạn chưa hiểu chỗ nào, mình sẽ hướng dẫn thêm bạn nhé.

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

    Chào bạn nguyentuyen6,

    Bạn xài thử xem còn gì chưa ổn không nhé.

    (defun c:chsize ( / bng ebl stlst htlst sdlst hdlst bln ent els stl ht bld sd ent1
                         els1 std hd sdlst hdlst sst n i et el st bl e1 s1 el1 e2 e3 k m pt)
(vl-load-com)
(command "undo" "be")
(setq bng (car (entsel " \n Chon doi tuong block nguon "))
       stlst (list)
       htlst (list)
       sdlst (list)
       hdlst (list)
)
(while bng
(setq ebl (entget bng))
(if (= (cdr (assoc 0 ebl)) "INSERT")       
   (progn
            (setq  bln (cdr (assoc 2 ebl))
                     ent (cdr (assoc -2 (tblsearch "block"  bln)))         
             )
    )
   (progn
          (alert "\n Doi tuong chon khong phai la block, hay chon lai block chua cac doi tuong nguon")
          (setq bng (car (entsel "\n Chon block chua cac doi tuong nguon")))
    )
)
(setq bng nil)
)
(while ent
        (setq els (entget ent))
        (if  (= (cdr (assoc 0 els)) "TEXT" )
            (progn
                    (setq stl (cdr (assoc 7 els))
                            ht (cdr (assoc 40 els))
                            stlst (append stlst (list stl))
                            htlst (append htlst (list(append stlst (list ht))))
                            stlst (list)
                    )
              )
         )
         (if (= (cdr (assoc 0 els )) "DIMENSION")
            (progn 
                   (setq bld (cdr (assoc 2 els))
                           sd (cdr (assoc 3 els))
                           ent1 (cdr (assoc -2 (tblsearch "block" bld)))
                   )
                   (while ent1
                            (setq els1 (entget ent1))
                            (if (= (cdr (assoc 0 els1)) "MTEXT")
                                (progn
                                      (setq std (cdr (assoc 7 els1))
                                              hd (cdr(assoc 40 els1))
                                              sdlst (append sdlst (list sd))
                                              sdlst (append sdlst (list std))
                                              hdlst (append hdlst (list (append sdlst (list hd))))
                                              sdlst (list)
                                       )
                                   )
                               )
                               (setq ent1 (entnext ent1))
                    )
              )
           )

         (setq ent (entnext ent))
)

(alert "\n Chon tap doi tuong dich")
(setq sst (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION,INSERT")))
       n (sslength sst)
       i 0
)
(while (< i n)
        (setq et (ssname sst i)
                el (entget et)
        )
        (if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls htlst
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (cadr ls)) (assoc 40 el) el))
                      ) 
                      (entmod el)
                )
             )
         )

         (If (= (cdr(assoc 0 el)) "DIMENSION")
             (progn
                   (setq bl (cdr (assoc 2 el))
                           s1 (cdr (assoc 3 el))
                           e1 (cdr (assoc -2 (tblsearch "block" bl)))
                           e2 (entnext (entnext e1))
                           e3 (entnext e2)
                   )
                   (foreach ls1 hdlst
                           (if (= (car ls1) s1)
                               (progn
                                      (setq di (vlax-ename->vla-object et))
                                      (vla-put-textheight di (caddr ls1))
                                )
                             )
                     )
                     (command "regen")
               )
            )
            (if (= (cdr (assoc 0 el)) "INSERT")
                (upwb et htlst hdlst)
            )

         (setq i (1+ i))
)
(command "undo" "e")
(princ)

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk lst1 lst2 / e el s st bl e1 s1 el1 k m pt )
(setq s (cdr (assoc 2 (entget blk))))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (wcmatch (cdr (assoc 0 el)) "INSERT")
(UPWB e)
)
(if (or (= (cdr (assoc 0 el)) "TEXT") (= (cdr (assoc 0 el)) "MTEXT"))
            (progn
                (setq  st (cdr (assoc 7 el)))
                (foreach ls lst1
                      (if (= (car ls) st)
                         (setq el (subst (cons 40 (cadr ls)) (assoc 40 el) el))
                      ) 
                      (entmod el)
                )
             )
         )

(If (= (cdr(assoc 0 el)) "DIMENSION")
   (progn
           (setq bl (cdr (assoc 2 el))
                   s1 (cdr (assoc 3 el))
                   e1 (cdr (assoc -2 (tblsearch "block" bl)))
           )
           (foreach ls1 lst2
                   (if (= (car ls1) s1)
                       (progn
                               (setq di (vlax-ename->vla-object e))
                               (vla-put-textheight di (caddr ls1))
                        )
                    )
           )
           (command "regen")

    )
)

(setq e (entnext e))
)
)

     

    Việc sửa lại lisp không khó lắm đâu, chỉ cần bạn thích và kiên trì là sẽ được, với kiến thức của bạn nên tập dần việc sửa này để dần dần có thể làm chủ được công việc của mình, chả phải sợ thằng Tây nào cả bạn ạ.

    Thực ra trong cái lisp này còn khá nhiều đoạn thừa, không cần thiết do quá trình viết lần trước mình lựa chọn nhiều hướng đi mà không được, nhưng vì mình lười nên cứ kệ nó đấy để viết tiếp và sửa lại. Nếu bạn rảnh hãy cố gắng tìm các chỗ đó, sửa đi sẽ được cái lisp ngon lành hơn bạn ạ. Thông cảm cho cái tính lười cố hữu của mình.

    Chúc bạn vui.

     

    Cảm ơn bác tbinh rất nhiều!

    Em vừa mới tìm hiểu líp nên chưa đâu vào đâu cả. hjx. Bác giúp e nốt cái này với nhé, nó như viên gạch chốt của vòm xây = gạch ý, ko có nó thì ko dùng đc:

     

    Khi chọn block nguồn đó thì sẽ lấy giá trị scale của block đó ( theo trục X hay Y hay Z ( 1 trong 3 cái đó thôi) để nhân lên chiều cao của text và đim đích.

    Ví Dụ: Giả sử Block nguồn bị scale lên 2 lần thì thì chiều cao của TEXT và TEXT_dim trong đối tượng đích được nhân lên 2 lần.

    ----------------Block nguồn bị scale lên 3 lần thì thì chiều cao của TEXT và TEXT_dim trong đối tượng đích được nhân lên 3 lần.

     

     

    ....................................

     

     

    Yêu cầu trên của em là bởi vì: Khi scale cái block nguồn thì chièu cao của text và đim bên trong blok sẽ ko đổi >>>> mà tỷ lệ block nguồn với block khung tên là không đổi>>>> khi scale khung tên+block nguồn bao nhiêu đi nữa thì chiều cao text và đim khi dùng líp này trong bản vẽ ở bất kỳ tỷ lệ block nguồn nào cũng đều = nhau

    PS: Sry Bác vì e đã ko lường hết được các trường hợp nên khi bác viết xong mới có thêm yêu cầu như vậy. Hjx

     

    Thank Bác rất nhiều!!!!

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

    cái này mình hay dùng

     

     

    ;**********************************************************************
*********
;* WRITTEN BY DAO NGUYEN THANG 94X3 - HANOI ARCHITECTURAL UNIVERSITY (VIETNAM) *
;*******************************************************************************

(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                     ; while this command is active...
 (cond
   ((= s "quit / exit abort") (princ))
   ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
 )
 (setvar "cmdecho" CMD)             ; Restore saved modes
 (setvar "osmode" OSM)
 (setq *error* OLDERR)               ; Restore old *error* handler
 (princ)
)
;*******************************************************************************

(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
               PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Chon doi tuong Dimension!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Diem cat Dimension:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT13I (POLAR PT13 GOCY 2))
	(SETQ PT14I (POLAR PT14 GOCY 2))
	(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
	(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
	(SETQ O13 (ASSOC 13 DS))
	(SETQ O14 (ASSOC 14 DS))
	(SETQ N13 (CONS 13 PT13N))
	(SETQ N14 (CONS 14 PT14N))
	(SETQ DS (SUBST N13 O13 DS))
	(SETQ DS (SUBST N14 O14 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
               PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Chon doi tuong dimension!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Diem di chuyen den:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT10I (POLAR PT10 GOCY 2))
	(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
	(SETQ KC (DISTANCE PT10 PT10N))
	(SETQ O10 (ASSOC 10 DS))
	(SETQ N10 (CONS 10 PT10N))
	(SETQ DS (SUBST N10 O10 DS))
	(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
	(SETQ O11 (ASSOC 11 DS))
	(SETQ N11 (CONS 11 PT11N))
	(SETQ DS (SUBST N11 O11 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

    • Vote tăng 1

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

    @ nguyentuyen6: Bạn có thể xài cái này cho trường hợp của bạn. Nếu bạn không thể hãy post lên nhé.

     

    Bac làm giúp mình cai multi nứa đc ko ? e loay hoay 1 lúc thì tắc tịt.

     

    Nghĩa là chọn 1 vùng (Có thể có block hoặc không) >>>> lọc dim (nếu có block thì lấy lấy cả dim trong block luôn)

    rồi áp dụng lệnh này với các dim vừa lọc xong ý. Cảm ơn bác.. hehe

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

    Em có việc này nhờ các cao thủ, em đã search trên diễn đàn và biết được bác NguyenHoanh có viết một đoạn code mà khi pick chọn một DIM sẽ xuất ra text các thông số của DIM đó, ví dụ DIMSCALE........... nhưng giờ em muốn thay vì xuất ra text như thế các bác có thể viết giúp em một lisp mà sau khi pick chọn DIM đó sẽ ra một dòng nhắc người dùng các giá trị hiện tại (cụ thể em chỉ cần giá trị Dim scale overal) và yêu cầu nhập giá trị mới cần thay đổi. sau khi người dùng nhập thì sẽ áp dụng giá trị đó cho DIM.

    Cảm ơn các bác rât nhiều.

     

    Cái líp đó ở đây. http://www.cadviet.com/forum/index.php?showtopic=2423

     

    Trong đó cái text hight dc quy đinh mã là :140. Qua líp này không biết bac thanhbinh có thể giúp em nốt cái líp kia không?. chỉ áp dụng cho dim. Chỉ khác tý là nguồn của dim bây h là 1 DTEXT (Có style giống style textdim và khác style của các TEXT nguồn )để khi scale thì text hight cũng thay đổi theo. Cảm ơn bác nhiêu. Hy vọng là em nghĩ đúng

×