Viết lisp theo yêu cầu [phần 2]

[nguyentuyen6 130]

BẠn tìm cái líp MPLOT cua bác NguyenHoanh ý. Đỡ phải đặt tên block

[phamngoctukts 714]

Cám ơn bác Duy và bác Bình. Nhờ ơn 2 bác mà lisp cua em chay ầm ầm.

(defun nhapsolieu ()
(initget 1)
(setq goc1 (getangle p01 "chon diem thu 2 theo huong hoac nhap goc: "))
(setq goc (/ (* goc1 180) pi))
(setq xulygoc (- 45 (/ goc 2)))
(setq gocra (/ (* pi xulygoc) 180))
(setq sina (sin gocra))
(setq cosa (sqrt (- 1 (expt sina 2))))
(setq tang (/ sina cosa))
(setq a (distance p2 p3))
(setq duongcheo (* a (sqrt 2)))
(setq b (/ duongcheo (* 2 tang)))
(setq anso (- b (/ duongcheo 2)))
(setq x (* anso 2))
(setq hs (+ (/ x duongcheo) 1))
)

(defun chondoituong ()
(princ "\nchon doi tuong: ")
(setq ssa (ssget))
(command ".copy" ssa "" "0,0" "0,0")
(setq ssb (ssget "l"))
(setq n (sslength ssb))
(setq i 0)
(while (< i n)
(setq n (sslength ssb))
(setq ent (ssname ssb i))
(setq name (cadr (entget ent)))
(if (equal name '(0 . "INSERT"))
(progn
(command "explode" ent)
(setq ssc (ssget "p"))
(setq n1 (sslength ssc))
(setq i1 0)
(while (< i1 n1)
(setq ent1 (ssname ssc i1))
(setq ssb (ssadd ent1 ssb))
(setq i1 (1+ i1))
)
)
)
(setq i (1+ i))
(setq n (sslength ssb))
)
)

(DEFUN stretchblock()
(batdau)  
(chondoituong)
 (setq P01 (getpoint "\nChon diem chen: "))
(delblock)
 (command "-Block" "vkc_temp1" "0,0" ssb "")
 (command "-insert" "vkc_temp1" "0,0" "" "" "")
 (setq sstt1 (entlast))
 (setq sstt (ssget "l"))
(blockrectang)
(nhapsolieu)
 (command "_.explode" sstt1)
 (setq ss0 (ssget "p"))
 (command "-block" "vkc_temp1" "y" p1 ss0 "")
 (command "line" p2 p1 "")
 (setq re (ssget "l"))
 (command "_.move" re "" p1 p01)
 (command "_.rotate" re "" p01 "45")
 (command "-insert" "vkc_temp1" "r" "45" p01 "" "")
 (setq blgoc (entlast))
 (Command "Explode" blgoc)
 (setq bl (ssget "p")) 
 (command "-Block" "vkc_temp2" P01 re "")
 (command "-Block" "vkc_temp3" P01 bl "")
 (Command "-Insert" "vkc_temp3" P01 "" hs "")  
 (setq dt1 (entlast))
 (Command "-Insert" "vkc_temp2" P01 "" hs "")  
 (Command "_.Explode" "l" "")
 (setq dt2 (entlast))
 (setq tt1 (entget dt2))
 (setq tt1 (vl-remove-if '(lambda (x) (/= 10 (car x))) tt1))
 (setq dinh11 (cdr (nth 0 tt1)))
 (setq quay (- 90 (/ (* (angle p01 dinh11) 180) pi)))
 (setq aa (distance p01 dinh11))
 (setq bb (distance p1 p2))
 (setq ab (/ bb aa))
 (command "_.rotate" dt1 "" p01 quay)
 (command ".scale" dt1 "" p01 ab)
 (command "_.erase" dt2 "")
 (command "_.explode" dt1)
(delblock)
(ketthuc)
 (princ)
)

(defun c:stb ()
(stretchblock)
)

(defun batdau ()
 (command "undo" "be")
 (setvar "cmdecho" 0)
 (setq 
    old_er *error*
    *error* myerror
 ) 
)

(defun myerror (errmsg)
(ketthuc)
(command "undo" "")
)

(defun ketthuc ()
 (setq *error* old_er)
 (setvar "cmdecho" 1)
 (command "undo" "e")
)
(defun delblock ()
(Command "-Purge" "B" "vkc_temp1" "Y" "Y")
(Command "-Purge" "B" "vkc_temp2" "Y" "Y")
(Command "-Purge" "B" "vkc_temp3" "Y" "Y")
)

(defun blockrectang ()
(while (setq e (ssname sstt 0))
(setq sstt (ssdel e sstt)
tmp (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3) 
p1 (list (car p1) (cadr p1))
p3 (list (car p3) (cadr p3))
p2 (list (car p1) (cadr p3))
p4 (list (car p3) (cadr p1))
)
) 
)

Gà như mình còn viết được code này mà bon nó bán tận 27$

http://www.rayburndrafting.com/prod_desc_I...AT.html?sno=298

[phamthanhbinh 3146]

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

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

[phamthanhbinh 3146]

Cám ơn bác Duy và bác Bình. Nhờ ơn 2 bác mà lisp cua em chay ầm ầm.

 

Gà như mình còn viết được code này mà bon nó bán tận 27$

http://www.rayburndrafting.com/prod_desc_I...AT.html?sno=298

Hề hề hề,

Vậy là bác này đủ xìn đi offline rùi, hê hê, có khi còn dư để bao thêm một ẻm nữa ấy chứ. Mà bác cũng nên tự thưởng cho mình một chầu offline chứ nhẩy. Hẹn gặp bác tại buổi offline nhé.....

Hề hề hề ,l lạc đề tí cho vui, các bác đừng giận nha.

[phamngoctukts 714]

Bác nào có bảng đầy đủ các mã DXF không cho em xin cái. Tìm trên diễn đàn mỏi mắt không thấy.

[duy782006 1559]

Bác nào có bảng đầy đủ các mã DXF không cho em xin cái. Tìm trên diễn đàn mỏi mắt không thấy.

Mua quách quyển sách dạy lisp mà tra bác ạ!

[phamngoctukts 714]

Mua quách quyển sách dạy lisp mà tra bác ạ!

Em tìm được rồi bác ạ. Tiện thể up lên đây ai có cần thì lây

ma DXF

[nguyentuyen6 130]

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

[nguyentuyen6 130]

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

[hdg2318 31]

Em tìm được rồi bác ạ. Tiện thể up lên đây ai có cần thì lây

ma DXF

mình mới chập chững nghiên cứu, ko biết cái mã DXF này dùng để làm gì?? :undecided: :bigsmile:

[bachngoctung 11]

- Anh em quên bài này à http://www.cadviet.com/forum/index.php?sho...st&p=106697

- Xem giúp mình với :undecided:

[TRUNGNGAMY 91]

- Anh em quên bài này à http://www.cadviet.com/forum/index.php?sho...st&p=106697

- Xem giúp mình với :undecided:

Kg hiểu sao mình kg down đc bv của bạn nhỉ

[nhiemhan 0]

BẠn tìm cái líp MPLOT cua bác NguyenHoanh ý. Đỡ phải đặt tên block

Chào bạn nguyentuyen6!

Cảm ơn bạn đã chỉ mình tìm MPlot nhưng mình vẫn chưa sử dụng được .Mình muốn có cách in giống như in bên word được không bạn?Tức là chọn trang nào in trang đó.Bạn thấy có thể thực hiện không?Hi..Mong các bạn giúp đỡ!Mình cảm ơn rất nhiều.

[thiep 365]

- Anh em quên bài này à http://www.cadviet.com/forum/index.php?sho...st&p=106697

- Xem giúp mình với :undecided:

Chào bạn bachngoctung, có phải bạn muốn các Text cao độ có vị trí gióng (Alignment) trùng với vị trí chèn điểm phải không?

Thiep xem bản vẽ của bạn có 2 hệ thống text:

- 1 hệ thống text có độ cao là 1.0, có 2 số lẻ, đây có phải là text cao độ?

- 1 hệ thống text có độ cao là 0.8, là số tự nhiên, đây có phải là text STT điểm? mà sao nó không cùng góc quay với Text cao độ?

Sao bạn không tách thành 2 lớp cho dễ làm?

[phamthanhbinh 3146]

Bác nào có bảng đầy đủ các mã DXF không cho em xin cái. Tìm trên diễn đàn mỏi mắt không thấy.

Bác vào Developer Help của CAD sẽ có dủ mà.

[phamthanhbinh 3146]

mình mới chập chững nghiên cứu, ko biết cái mã DXF này dùng để làm gì?? :undecided: :bigsmile:

Chào bạn hdg2318.

Cad quản lý các đối tượng thông qua các mã DXF này của đối tượng bạn ạ. Khi bạn hiểu rõ về các mã DXF này bạn có thể thay đổi các đối tượng này theo hướng bạn mong muốn.

Về lý thuyết thì không phải tất cả các mã này bạn đều có thể sử dụng được vì có một số mã do Cad tự sinh ra trong quá trình hình thành đối tượng để quản lý nó. Tuy nhiên có rất nhiều mã mà người dùng có thể can thiệp vào được để thay đổi đối tượng. Cái này thì phải làm dần sẽ vỡ ra mà thôi. Bản thân mình cũng chỉ hiểu sơ sơ như vậy và cứ thế mà vọc từ từ thôi.

Rất mong bạn hiểu rõ hơn về các mã này.

@ Bạn nguyentuyen6: Khi có các mã DXF của đối tượng, bạn phải sử dụng các hàm như entmake, entmakes để tạo đối tượng mới, Hàm subst để thay thế các mã DXF đã có thành các mã dxf mới của đối tượng và hàm entmod để hiển thị lại đối tượng đã được thay thế mã dxf. Cụ thể hơn bạn có thể tìm hiểu trong Developer Help của CAD bạn ạ.

[phamthanhbinh 3146]

- Anh em quên bài này à http://www.cadviet.com/forum/index.php?sho...st&p=106697

- Xem giúp mình với :undecided:

Chào Bachngoctung,

Quên ư???

Bạn có theo dõi vấn đề bạn đặt ra hay không vậy??? Bản thân mình đã có bài phản hồi , nhưng có thấy bạn ứ hự gì đâu mà bảo quên với nhớ.

Bạn muốn mọi người giúp bạn thì phải cung cấp đầy đủ thông tin về vấn đề bạn đưa ra, đồng thời phải theo dõi và trả lời các câu hỏi mà mọi người đặt ra quanh vấn đề của bạn chứ.

Bạn muốn bắt mọi người phải hiểu vấn đề y như bạn hiểu sao???? Khó đấy, không phải ai cũng giỏi về cái chuyên môn của bạn như bạn đâu.

Hơn nữa với cùng một vấn đề sẽ có thể có nhiều giải pháp để giải quyết chứ không phải chỉ có một giải pháp duy nhất. Do vậy mỗi thành viên sẽ có cách suy nghĩ khác nhau để giải quyết vấn đề của bạn. Mình cũng như những người khác vậy thôi, chả ai muốn làm một việc vô ích cả, do vậy mới có những câu hỏi ngược trở lại để hiểu rõ hơn cũng như đề xuất các giải pháp có thể giúp bạn. Nếu bạn không trả lời thì làm sao để xác tín rằng cái việc mình sẽ làm là phù hợp với yêu cầu của bạn. Và như vậy thì làm làm chi cho mất công nhể???

Diễn đàn là một nơi công cộng, bạn nên tôn trọng mọi người trước khi yêu cầu mọi người phải tôn trọng bạn bạn ạ. Đừng chỉ biết đòi hỏi ở người khác mà không quan tâm xem người khác nghĩ gì...

Vài lời góp ý mong bạn chớ giận......

[phamthanhbinh 3146]

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

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 (         (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é.

[bumchiu2005 0]

Các bác cho em hỏi về lisp tạo hệ thống lưới toạ độ với ạ !

[nguyentuyen6 130]

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.

[ndtnv 481]

- Anh em quên bài này à http://www.cadviet.com/forum/index.php?sho...st&p=106697

- Xem giúp mình với :undecided:

Một cách rất độc đáo để mã hóa bản vẽ.

Mình đã tìm cách mà text có align left (mã dxf 72 và 73 = 0) mà có dxf 11 khác với (0 0 0) nhưng không được

thì đã xuất hiện trong bản vẽ của bạn.

Bạn dùng thử file này

http://www.cadviet.com/upfiles/3/text_alignment_new.dwg

Bạn xem topic này để biết lý do mình không post code lên

http://www.cadviet.com/forum/index.php?showtopic=860

Bạn có yêu cầu gì thêm cho file trên thì mình sẽ sửa tiếp.

Nếu không tiện viết lên đây thì hãy gửi vào ndtnve@yahoo.com

[phamthanhbinh 3146]

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:

 

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.

Chào bạn nguyentuyen6.

1/- Bạn cho mình biết bạn đã sử dụng như thế nào mà lisp lại không chạy. Bạn nhớ là nếu bạn chọn vào một block có tỷ lệ scale theo trục bạn chọn là 1 thì đừng mong nó có thay đổi gì. Hơn nữa khi bạn chọn tỷ lệ scale nếu không nhập đúng là các chuỗi tlx, tly hay tlz thì lisp sẽ mặc định biến tl =1 và như vậy thì bạn có muốn nó thay đổi cũng không được bạn ạ. Bạn nên chúy ý tới kết cấu của lisp để chạy mới mong nó chạy đúng được. Lisp này mình dã chạy thử trên file bạn gửi thì trăm phát ăn cả trăm, vậy mà bạn nói không chạy được thì mình thắc mắc quá. Rất mong bạn kiểm chứng lại, nếu cần thì mình sẽ gửi cho bạn file kết quả mình chạy để bạn làm bằng chứng. Hề hề hề

2/- Về cái lisp mà bạn đã sửa lại , mình rất mứng là bạn đã có cố gắng vọc để tìm ra cái bạn cần. song bạn cho mình ít thời gian để mình kiểm lại có gì mình sẽ trao đổi với bạn sau nhé. Hiện tại mình hơi xin xỉn rồi nên khó mà đọc lisp được mong bạn tha lỗi.

Hề hề hề.....

[phamngoctukts 714]

Các bác cho em hỏi cái:

Làm thế nào để lấy được giá trị góc âm. Ví dụ (angle p1 p2) bao giờ cũng ra số dương. Mình muốn lấy góc lơn 180 độ là góc âm và nhỏ hơn 180 độ là góc dương thì làm thế nao? Thank

[phamthanhbinh 3146]

Các bác cho em hỏi cái:

Làm thế nào để lấy được giá trị góc âm. Ví dụ (angle p1 p2) bao giờ cũng ra số dương. Mình muốn lấy góc lơn 180 độ là góc âm và nhỏ hơn 180 độ là góc dương thì làm thế nao? Thank

Hề hề hề,

Có phải bạn Phamngoctukts muốn cái này không???

(setq a (* (angle p1 p2) (/ 180 pi)))
(if (> a 180)
   (setq a (- a 360))
)

[phamthanhbinh 3146]

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

Chào bạn nguyentuyen6,

Đọc cái lisp bạn sửa mình thấy có một vài vấn đề muốn trao đổi lại như sau:

1/- Việc bạn tự chỉnh lisp được như vầy là khá tốt rồi mặc dù nó chưa hoàn chỉnh. Nếu bạn chú ý và tìm hiểu kỹ hơn về cái lisp gốc của mình thì sẽ chỉnh được nó ngon lành mà thôi.

2/- Quá trình chỉnh lisp bạn cần căn cứ vào sự thay đổi trong yêu cầu làm lisp thì bạn mới chỉnh tốt được. Rõ ràng hai lần bạn yêu cầu là hai vấn đề khác nhau nên việc bạn giữ gần như nguyên vẹn cái lisp cũ của mình là không hợp lý.

Lần đầu bạn yêu cầu là các text và dim text trong tập đích phải được chỉnh có chiều cao của các text và dim text có cùng stye và dimstyle với nó trong block nguồn. Vì vậy mới có cái việc mình phải tạo ro hai list là htlst và hdlst để lưu giữ các tham số của các text và các dim text trong block nguồn.

Và do đó trong quá trình sử lý các đối tượng trong tập đich mới có việc sử dụng các hàm foreach để lặp qua các phần tử của các list này.

Lần sau bạn chỉ yêu cầu là thay đổi chiều cao của các text và dim text trong tập đích để chúng có chiều cao bằng tích số của chiều cao hiện có với một trong ba tỷ lệ scale theo các trục x,y,z của một block nguồn. Do vậy đâu cần tới việc tạo các list htlst và hdlst làm chi nữa. và như thế thì các hàm foreach trong quá trình xử lý các đối tượng trong tập đích cũng hết sứ mạng của nó rồi bạn ạ.

3/- Mặc dù bạn nói rằng cái lisp bạn sửa chạy tốt cho trường hợp các text và mtext nhưng thực ra trong đó chứa quá nhiều điều không hợp lý. Sở dĩ nó vẫn chạy là do may mắn các text hay mtext trong tập đích bạn chọn có cùng style với một trong các text có trong block nguồn mà thôi. Giả sử có text hay mtext có style khác thì các text này sẽ chả thay đổi được chi cả. Còn với dim text, sở dĩ của bạn chạy sai vì cái (caddr ls1) đâu có liên quan gì tới chiều cao của dim text trong tập đích mà đó là cái tham số dính tới chiều cao của dim text trong tập nguồn bạn ạ. Hoàn toàn chả đúng với cái yêu cầu của bạn nên nó sai là không oan.

4/- Như đã phân tích ở trên nên mình không muốn sửa lại cái bạn đã sửa nữa. Bạn hãy đọc kỹ lại cái lisp mình gửi để thấy sự khác nhau giữa hai lisp và mình khẳng định lại rằng mình đã chạy kiểm tra, lisp đó chạy ngon lành. Chỉ yêu cầu bạn thực hiện đúng các bước như sau:

- Khi lisp yêu cầu bạn chọn block nguồn, bạn phải chọn một block mà có một trong các tỷ lệ scale theo các trục là khác 1, vì nếu bạn chọn block có tỷ lệ scale theo tất cả các trục là 1 thì đương nhiên kết quả sẽ không có sự thay đổi nào cả.

- Khi lisp yêu cầu bạn chọn tỷ lệ scale, bạn phải nhập 1 trong ba chuỗi ký tự có trong ngoặc đơn là tlx, tly hay tlz mà cái giá trị tương ứng của nó là khác 1. Bạn hãy chú y đoạn code:

(if (= ans "tlx") (setq tl tlx)

(if (= ans "tly") (setq tl tly)

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

Đoạn code này nói rằng nếu chuỗi ký tự bạn nhập không phải là một trong ba chuỗi tlx, tly, tlz nói ở trên thì lisp sẽ tự lấy biến tl là 1 và như thế thì cũng chớ có mong có sự thay đổi nào ở trong tập đích.

Lisp này có nhược điểm là không cho bạn biết các biến tlx, tly, tlz có giá trị là bao nhiêu nên việc bạn chọn thằng nào bạn phải tự cân nhắc sao cho nó khác 1 bạn nhé.

Nếu bạn muốn có cái bảng thông báo giá trị của các biến này bạn hãy bổ sung thêm đoạn code sau đây vào dưới dòng code (alert "/n Chon tap doi tuong dich"):

(alert (strcat "/n Gia tri ty le scale theo truc x (tlx) là: " (rtos tlx 2 2) "/n Gia tri ty le scale theo truc y (tly) là: " (rtos tly 2 2) "/n Gia tri ty le scale theo truc z (tlz) là: " (rtos tlz 2 2)))

Như vậy bạn có thể yên tâm để không chọn nhầm chuỗi ký tự cần nhập khi lisp yêu cầu.

 

Vậy nhé. chúc bạn đạt được nguyện vọng. Hề hề hề