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

Tháng 9 10, 2010

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

Hề hề đúng như mình nghĩ. Đặt câu hỏi xong rồi mới nghĩ ra

Tháng 9 10, 2010

@ 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

Tháng 9 11, 2010

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

Hề hề hề,

Tại vì xào nấu mà quên mất mấy món gia vị trước đó nên nó bị xung đột với khẩu vị của bạn đây mà.

Ở cái lisp thứ nhất, nó không chạy là do gia vị mắm muối có hơi thiếu, bạn hãy bổ sung thêm các biến lst1 và lst2 vào trong cái hàm UPWB bạn nhé. Do các biến này là biến toàn cục nên phải khai báo vô hàm nó mới chạy được bạn ạ.

Còn ở lisp thứ hai nó không chạy hàm UPWB là do hơi dư mắm muối nên thằng lisp nó chê bạn ạ. Ở lisp này như đã nói trong bài trước là đâu có cần tới biến htlst và hdlst nữa, vậy mà ở hàm con UPWB mình lại quên béng không loại nó ra (vì tội lười nên mình copy cho nhanh mà không kiểm tra lại, thành thật xin lỗi bạn). Bây giờ bạn hãy bỏ các biến lst1 và lst2 ra khỏi các hàm UPWB là nó sẽ chạy thôi bạn ạ.

Túm lại là việc xào nấu lisp tuy có nhanh hơn việc viết lại nhưng rất dễ bỏ sót lỗi do không kiểm tra lại các biến có hợp lệ hay không bạn ạ. Bạn cũng nên lưu ý điều này khi xào nấu để tránh bị cái lỗi lười như mình.

Rất mong bạn thông cảm. (do khi làm lisp thì mình có kiểm tra và chạy thử nhưng khi post bài thì copy cho nhanh mà lại bị copy nhầm đúng cái lisp chưa sửa bạn ạ, khi sửa lisp mình luôn lưu lại lisp cũ để tham khảo khi cần mà.) Hề hề hề,....

Tháng 9 11, 2010

@tbinh: E loay hoay sửa mãi ko dc bác ợ. Làm như bác bảo ở cái (defun UPWB (....) mà cung ko xong. hjx

Tháng 9 11, 2010

Buồn quá có việc bận nên không offline cùng anh em cadviet được. Thật là tiếc!!!

Ngồi buồn quá dở cái lisp vẽ thang của bác hoành ra sửa lại tí chút cho đúng cấu tạo.

tiện thể port lên đây cho anh em nào cần thì nhậu.

lisp này kết hợp với lisp vẽ lan can sắt của mình thì rất tiện.

(defun c:vtb (/ p c r sb oldos nb bk MBTong1 tl1 angh1 MBTong2 tl2 angh2
MBTong3 tl3 angh3 d oldos di ang p2 p3 p4 dibt pbt1 
pbt2 pbt3 el1 el2 el3 ans)
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq tbl (tblsearch "layer" "_cat"))
(if (= tbl nil) (command "-layer" "n" "_cat" "c" "4" "_cat" ""))
(setq tbl1 (tblsearch "layer" "_hatch"))
(if (= tbl1 nil) (command "-layer" "n" "_hatch" "c" "8" "_hatch" ""))
(setq tbl2 (tblsearch "layer" "_thay"))
(if (= tbl2 nil) (command "-layer" "n" "_thay" "c" "23" "_thay" ""))
(setvar "clayer" "_cat")
(setq nb 20.0 bk 10.0
MBTong1 "ANSI32" tl1 100 angh1 0
MBTong2 "ar-conc" tl2 10 angh2 0
MBTong3 "ANSI31" tl3 200 angh3 0
MBTong4 "ar-sand" tl4 4 angh4 0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
d (getdist "\nVao be day ban thang be tong : ")
oldos (getvar "osmode")
di (* sb (sqrt (+ (* c c) (* r r)) ))
ang (atan (/ c r))
p01 (polar p 0 10)
p02 (polar p01 (/ (* 270 pi) 180) 20)
p03 (polar p02 ang (/ 20 (sin ang)))
p2 (polar p02 ang di)
p22 (polar p2 (/ (* 90 pi) 180) 20)
p222 (polar p22 (/ (* 180 pi) 180) 10)
p3 (polar p03 0 (/ d (sin ang)))
p33 (polar p02 0 (/ d (sin ang)))
p4 (polar p2 (/ (* 3 pi) 2) (/ d (cos ang))) 
dibt (/ 10 (cos ang))
pbt1 p02
pbt3 (polar p02 ang (/ (distance p02 p2) sb) ) 
pbt2 (list (car pbt1) (cadr pbt3) 0)
pbt4 (polar pbt2 (/ (* 90 pi) 180) 10)
)
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")
)
)
(command "")
(setq thay (entlast))
(initget "C K")
(setq ans (getkword "\n Ban muon cat qua cau thang hay khong < C / K > :"))
(if (= ans "K")
(progn
(command "pline" p p3 p4 p2 p22 p222 "")
(command "change" "l" "" "p" "la" "_thay" "")
(command "change" thay "" "p" "la" "_thay" "")
)
)
(if (= ans "C") 
(progn
(setvar "cmdecho" 0)
(command "line" p p01 "")
(setq el4 (entlast))
(command "pline" p02 p33 p4 p2 "c")
(setq eL (entlast))
(command "hatch" MBTong1 tl1 angh1 eL "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "hatch" MBTong2 tl2 angh2 eL "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "pline" pbt1 pbt2 pbt3 "C")
(setq eL1 (entlast))
(command "hatch" MBTong3 tl3 angh3 eL1 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL2 (entlast))
(command "line" pbt3 (list (car p) (cadr pbt3) 0) "")
(setq eL3 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" el1 el2 el3 el4 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(command "-BOUNDARY" pbt4 "")
(setq eL5 (entlast))
(command "rectang" p pbt2)
(setq eL6 (entlast))
(command "hatch" MBTong4 tl4 angh4 eL5 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL8 (entlast))
(command "hatch" MBTong4 tl4 angh4 el6 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL7 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" eL5 eL6 el7 el8 "" "R" "1" sb (/ di sb))
(command "ucs" "")
)
)
(setvar "osmode" oldos)
(setvar "clayer" old_layer)
(princ)
)

Tháng 9 12, 2010

Chào các anh trên diễn đàn!

Các a có thể viết giùm 1 lisp với nội dung như sau được không ạ!

"Có 1 đường pline khép kín, chọn đường pline đó, sau đó pick vào 1 điểm, nếu điểm đó nằm ngoài vòng khép kín của pline thì xóa các đối tượng là text và block nằm phía trong vòng khép kín của pline và ngược lại nếu pick điểm bên ngoài."

- Các a cho e hỏi thêm 1 điều nữa là các a có thể cho e biết code của lệnh "insert" 1 block ATT tạo sẵn vào bản vẽ bằng ngôn ngữ lisp được không a!

Thanks a lots!

Tháng 9 12, 2010

chào các anh, em co 1 lisp mà không biết sử dụng thế nào. em nhờ các anh chỉ dùm em cách sử dụng. đây là lisp vẽ đưòng con tích luỹ trông xây dựng đường. em không hiểu cách lập file text và lập toạ độ như thế nào để cad vẽ dúng cả. em xin cảm ơn.

http://www.mediafire.com/?jbuh5atdkp7cfbp

Tháng 9 13, 2010

@ 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 đó:

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

Bạn hãy dùng cái này xem nhé. Nếu được thì hãy xem lại cách học của bạn , còn nếu không được thì hãy chờ các cao thủ khác chỉ dạy vì mình chỉ biết đến vậy bạn ạ.

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

                   )
                   (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 lst1 lst2)
)
(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 tl bln ent els stl ht bld sd ent1
                  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 "))

)
(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 (         (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 )
          )          
         (setq i (1+ i))
)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun UPWB (blk  / 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))
)
)

Chúc bạn vui.

Tháng 9 13, 2010

Chào các anh trên diễn đàn!
Các a có thể viết giùm 1 lisp với nội dung như sau được không ạ!

"Có 1 đường pline khép kín, chọn đường pline đó, sau đó pick vào 1 điểm, nếu điểm đó nằm ngoài vòng khép kín của pline thì xóa các đối tượng là text và block nằm phía trong vòng khép kín của pline và ngược lại nếu pick điểm bên ngoài."

- Các a cho e hỏi thêm 1 điều nữa là các a có thể cho e biết code của lệnh "insert" 1 block ATT tạo sẵn vào bản vẽ bằng ngôn ngữ lisp được không a!

Thanks a lots!

Chào bạn vothanhdn,

Bạn trình bày vấn đề hơi khó hiểu, đề nghị bạn nói lại chính xác vấn đề bạn cần.

Việc insert block có chứ thuộc tính và không chứa thuộc tính về cơ bản là như nhau. Với block có thuộc tính thì bạn phải nhập thêm các giá trị thuộc tính cho phù hợp mà thôi. Cách mà lisp insert block vào bản vẽ là sử dụng với lệnh command bạn ạ.

(command "insert" "blockname" position "" "" att1 att2 .... "")

Bạn cứ làm đúng từng bước như trong khi thực hiện lệnh insert block là Ok.

Tháng 9 13, 2010

chào các anh, em co 1 lisp mà không biết sử dụng thế nào. em nhờ các anh chỉ dùm em cách sử dụng. đây là lisp vẽ đưòng con tích luỹ trông xây dựng đường. em không hiểu cách lập file text và lập toạ độ như thế nào để cad vẽ dúng cả. em xin cảm ơn.
http://www.mediafire.com/?jbuh5atdkp7cfbp

Chào bạn phatcui,

Căn cứ vào nội dung file lisp bạn gửi mình có thể giải thích cho bạn như sau:

Lisp dựa vào một file text được lập trước có cấu tạo như sau:

Mỗi dòng gồm hai chuỗi số liệu được cách nhau bởi một khoảng trắng. trong đó số liệu phía trước được gọi là biến s2 dùng để xác định giá trị biến a trong khi tạo điểm p2. Còn số liệu phía sau là biến s1 dùng để xác định biến d1 trong khi tạo điểm p3.

Do đó bạn cứ lập các bảng tọa độ có cấu tạo như trên mà chạy thử sẽ hiểu ra là bạn cần làm gì.

Rất mong bạn thành công.

Tháng 9 13, 2010

Bác nào cho em hỏi:

Lây tâm của đoạn pline cong thì làm thế nào.

Tháng 9 13, 2010

@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

Tháng 9 13, 2010

Chào bạn vothanhdn,
Bạn trình bày vấn đề hơi khó hiểu, đề nghị bạn nói lại chính xác vấn đề bạn cần.

Việc insert block có chứ thuộc tính và không chứa thuộc tính về cơ bản là như nhau. Với block có thuộc tính thì bạn phải nhập thêm các giá trị thuộc tính cho phù hợp mà thôi. Cách mà lisp insert block vào bản vẽ là sử dụng với lệnh command bạn ạ.

(command "insert" "blockname" position "" "" att1 att2 .... "")

Bạn cứ làm đúng từng bước như trong khi thực hiện lệnh insert block là Ok.

Cám ơn anh!

a xem bản vẽ file CAD này có lẽ dễ hiểu vấn đề hơn, a có thể viết giúp e được không ah.

Cám ơn!!!!

Down load bản vẽ

Tháng 9 14, 2010

Chào các anh trên diễn đàn!
Các a có thể viết giùm 1 lisp với nội dung như sau được không ạ!

"Có 1 đường pline khép kín, chọn đường pline đó, sau đó pick vào 1 điểm, nếu điểm đó nằm ngoài vòng khép kín của pline thì xóa các đối tượng là text và block nằm phía trong vòng khép kín của pline và ngược lại nếu pick điểm bên ngoài."

- Các a cho e hỏi thêm 1 điều nữa là các a có thể cho e biết code của lệnh "insert" 1 block ATT tạo sẵn vào bản vẽ bằng ngôn ngữ lisp được không a!

Thanks a lots!

Tham khảo LISP liên quan đến đường pline khép kín : Chọn - Xóa các đối tuợng trong và ngoài đường pline khép kín.

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

Như bác Bình đã viết :

Việc insert block có chứ thuộc tính và không chứa thuộc tính về cơ bản là như nhau. Với block có thuộc tính thì bạn phải nhập thêm các giá trị thuộc tính cho phù hợp mà thôi. Cách mà lisp insert block vào bản vẽ là sử dụng với lệnh command bạn ạ.

(command "insert" "blockname" position "" "" att1 att2 .... "")

Bạn cứ làm đúng từng bước như trong khi thực hiện lệnh insert block là Ok.

bổ sung thêm : khi chèn Block có chứa thuộc tính để bỏ qua các dòng nhắc liên quan đến thuộc tính, đặt biến hệ thống ATTREQ =0 truớc khi gọi lệnh.

Tháng 9 14, 2010

Mình là KTS giống như bao KTS khác đều ngại vẽ mặt cắt cầu thang. Chính vì vậy mình muốn xây dựng lisp để làm công việc này được nhanh chóng thuận lợi.

Mình đã xây dựng được code như thế này. Mong các bạn đóng góp ý kiến thêm để mình hoàn chỉnh.

đây là code

(defun c:cat ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq tbl (tblsearch "layer" "_cat"))
(if (= tbl nil) (command "-layer" "n" "_cat" "c" "4" "_cat" ""))
(setq tbl1 (tblsearch "layer" "_hatch"))
(if (= tbl1 nil) (command "-layer" "n" "_hatch" "c" "8" "_hatch" ""))
(setq tbl2 (tblsearch "layer" "_thay"))
(if (= tbl2 nil) (command "-layer" "n" "_thay" "c" "23" "_thay" ""))
(setvar "clayer" "_cat")
(setq pc1 (getpoint "\nChon diem thu nhat: "))
(setq pc2 (getpoint "\nChon diem thu hai: " pc1))
(command "-view" "s" "v1")
(setq p (getpoint "\nChon diem de ve mat cat: "))
(command "-view" "s" "v2")
(setq ct (getreal "\nVao chieu cao tang: "))
(setq sb1 (getint "\nVao so bac: "))
(command "-view" "r" "v1")
(setq catb (ssget "f" (list pc1 pc2)))
(setq i 0)
(setq listpoint nil)
(setq listbac nil)
(while (< i (sslength catb))
(setq n (ssname catb i))
(setq pl1 (cdr (assoc 10 (entget n))))
(setq pl2 (cdr (assoc 11 (entget n))))
(setq pcat (inters pc1 pc2 pl1 pl2))
(setq listpoint (append listpoint (list pcat)))
(setq i (1+ i))
)
(setq i1 0)
(setq sb 0)
(while (< (1+ i1) (length listpoint))
(setq po1 (nth i1 listpoint))
(setq po2 (nth (1+ i1) listpoint))
(setq bac (distance po1 po2))
(setq listbac (append listbac (list bac)))
(if (equal (nth 0 (reverse listbac)) (nth 1 (reverse listbac)))
(setq sb (+ i1 2))
)
(setq i1 (1+ i1))
)
(vethangthang)
)

(defun vethangthang ()
(setq nb 20.0 bk 10.0
MBTong1 "ANSI32" tl1 100 angh1 0
MBTong2 "ar-conc" tl2 10 angh2 0
MBTong3 "ANSI31" tl3 200 angh3 0
MBTong4 "ar-sand" tl4 4 angh4 0
r (car listbac)
c (/ ct sb1)
d 100
oldos (getvar "osmode")
di (* sb (sqrt (+ (* c c) (* r r))))
ang (atan (/ c r))
p01 (polar p 0 10)
p02 (polar p01 (/ (* 270 pi) 180) 20)
p03 (polar p02 ang (/ 20 (sin ang)))
p2 (polar p02 ang di)
p22 (polar p2 (/ (* 90 pi) 180) 20)
p222 (polar p22 (/ (* 180 pi) 180) 10)
p3 (polar p03 0 (/ d (sin ang)))
p33 (polar p02 0 (/ d (sin ang)))
p4 (polar p2 (/ (* 3 pi) 2) (/ d (cos ang))) 
dibt (/ 10 (cos ang))
pbt1 p02
pbt3 (polar p02 ang (/ (distance p02 p2) sb) ) 
pbt2 (list (car pbt1) (cadr pbt3) 0)
pbt4 (polar pbt2 (/ (* 90 pi) 180) 10)
)
(setvar "osmode" 0 )
(command "-view" "r" "v2")
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")
)
)
(command "")
(setvar "cmdecho" 0)
(command "line" p p01 "")
(setq el4 (entlast))
(command "pline" pbt1 pbt2 pbt3 "C")
(setq eL1 (entlast))
(command "hatch" MBTong3 tl3 angh3 eL1 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL2 (entlast))
(command "line" pbt3 (list (car p) (cadr pbt3) 0) "")
(setq eL3 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" el1 el2 el3 el4 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(command "-BOUNDARY" pbt4 "")
(setq eL5 (entlast))
(command "rectang" p pbt2)
(setq eL6 (entlast))
(command "hatch" MBTong4 tl4 angh4 eL5 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL8 (entlast))
(command "hatch" MBTong4 tl4 angh4 el6 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL7 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" eL5 eL6 el7 el8 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(vethangcong)
(setvar "osmode" oldos)
(setvar "clayer" old_layer)
(princ)
) 

(defun vethangcong ()
(setq goc01 (polar p ang di))
(setq i2 sb)
(setq ptt goc01)
(while (< i2 (length listbac))
(setq rbc (nth i2 listbac))
(command ".pline")
(command ptt)
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ 10 rbc)) ",0")
""
)
(setq ptt1 (polar ptt (/ (* 90 pi) 180) (- c (* 2.0 bk))))
(setq ptt2 (polar ptt1 0 10))
(setq ptt3 (polar ptt2 (/ (* 90 pi) 180) 10))
(command "rectang" ptt ptt2)
(command "hatch" MBTong4 tl4 angh4 "l" "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command ".pline")
(command ptt1)
(command
(strcat "@" (rtos (+ 10 rbc)) ",0")
(strcat "@0," (rtos (* 2.0 bk)))
(strcat "@" (rtos (- bk nb)) ",0")
""
)
(setq ptt (getvar "lastpoint"))
(command "-hatch" ptt3 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq i2 (1+ i2))
)
(setq pocuoi (polar ptt (/ (* 270 pi) 180) (/ (* c 2) 3)))
(setq pocuoi1 (polar pocuoi (/ (* 270 pi) 180) (/ (* c 2) 3)))
(command ".pline" p02 p2 "a" pocuoi "")
(setq noi1 (entlast))
(command "offset" "100" noi1 pocuoi1 "")
(setq noi2 (entlast))
(setq popcuoi (cdr (assoc 10 (reverse (entget noi2)))))
(setq popdau (cdr (assoc 10 (entget noi2))))
(command ".pline")
(command p02)
(command
(strcat "@-200,0")
(strcat "@0,-300")
(list (car popdau) (- (cadr p02)300))
)
(command popdau "")
(command "")
(setq noi3 (entlast))
(command ".pline" pocuoi popcuoi "")
(setq noi4 (entlast))
(command "pedit" noi1 "j" noi1 noi2 noi3 noi4 "" "")
(setq banbt (entlast))
(command "hatch" MBTong1 tl1 angh1 banbt "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "hatch" MBTong2 tl2 angh2 banbt "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "line" ptt pocuoi "")
(setq pohatch (polar goc01 0 20))
(command "-hatch" "p" MBTong3 tl3 angh3 pohatch "")
(command "change" "l" "" "p" "la" "_hatch" "")
)

Tháng 9 14, 2010

nhờ các cao thủ giúp đỡ, mình đang cần viết lisp để chọn (select) các dim có phần tiền tố (prefix) hay hậu tố(suffĩ) giống nhau mà không thấy trong danh sách thông tin của đối tượng (entget),lisp minh cần viết gần giống lệnh qselect. ai biết cách làm xin viết lisp giúp hay chỉ giùm mình cách làm cũng được.Thanks

hình minh họa

http://www.cadviet.com/upfiles/3/prefix.jpg

Tháng 9 14, 2010

@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

Chào bạn nguyentuyen6,

Quả thật mình không hiểu nó lỗi ở đâu nữa??? Đây là cái mình đã chạy thử bằng chính cái file bạn đã post lên diễn đàn và chính cáo lisp mà bạn bảo bị lỗi.

Đây là trước khi chạy lisp, trong đó có hai block chứa dimension nằm bên ngoài khung chữ nhật. một cái có kích thước dim nhỏ và một cái có kích thước dim lớn

Đây là hình ảnh sau khi chạy lisp ch với block nguồn có kich thước dim text nhỏ.

Đây là hình ảnh sau khi chạy lisp ch với block nguồn có kích thước dim text lớn

Đây là hình ảnh sau khi chạy lisp cs với hệ số tỷ lệ theo trục x, tlx , của block nguồn là 2

Đây là hình ảnh sau khi chạy lisp với hệ số tỷ lệ theo trục y tly của block nguồn là 2. Sở dĩ bạn thấy nó chả có xi nhê gì là do cái lisp cs bạn đã tự điều chỉnh bỏ đi phần lựa chọn cái hệ số tỷ lệ của mình mà mặc định là chọn theo tỷ lệ scale của trục x. mà cái block nguồn của mình lại có tỷ lệ scale theo trục x là 1.

Bằng các kết quả này chứng tỏ lisp không hề chết như bạn đã test và với các đối tượng nằm trong block nó vẫn xử lý được. Do đó bạn nên xem lại cấu tạo các block nguồn của bạn xem nhé. Cũng có thể là lỗi do một vài biến hệ thống nào đó của bạn mà mình thì mù tịt luôn nên bạn hãy kiểm tra lại các biến hệ thống và đặt nó về mặc định bạn ạ.

Mình gửi luôn ở đây cái file CAD mà mình đã dùng để bạn tiện kiểm tra.

Chúc bạn may mắn và tìm ra được cái lỗi của lisp nếu có. Mình thua rồi.

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

File CAD đây bạn nhé.

Tháng 9 14, 2010

Bác nào cho em hỏi:
Lây tâm của đoạn pline cong thì làm thế nào.

Chào bạn Phamngoctukts.

Bạn thử nghiên cứu cái hàm này xem sao, nó trả về vecto pháp tuyến của đường cong tại vị trí đang xét

vlax-curve-getSecondDeriv Function

Returns the second derivative (in WCS) of a curve at the specified location

(vlax-curve-getSecondDeriv curve-obj param)

Arguments

curve-obj

The VLA-object to be measured.

param

A number specifying a parameter on the curve.

Return Values

A 3D vector list, if successful; otherwise nil.

Examples

For the following example, assume that splineObj points to the spline shown in the example of the vlax-curve-getDistAtParam function.

Obtain the start parameter of the curve:

_$ (setq startSpline (vlax-curve-getStartParam splineObj))

0.0

Obtain the end parameter of the curve:

_$ (setq endSpline (vlax-curve-getEndParam splineObj))

17.1546

Determine the second derivative at the parameter midway along the curve:

_$ (vlax-curve-getSecondDeriv splineObj

( / (- endspline startspline) 2))

(0.0165967 0.150848 0.0)

Tháng 9 14, 2010

nhờ các cao thủ giúp đỡ, mình đang cần viết lisp để chọn (select) các dim có phần tiền tố (prefix) hay hậu tố(suffĩ) giống nhau mà không thấy trong danh sách thông tin của đối tượng (entget),lisp minh cần viết gần giống lệnh qselect. ai biết cách làm xin viết lisp giúp hay chỉ giùm mình cách làm cũng được.Thanks
hình minh họa

http://www.cadviet.com/upfiles/3/prefix.jpg

Bạn thử cái này nhé:

(defun c:qsd(/ ss)
(setq ss(ssget (list  (cons 0 "DIMENSION") 
		  (cons 1 (strcat (getstring t "\n Nhap tien to :")
			""
				  (getstring t "\n Nhap hau to :")
			  )
		  )
	   )
)
)
(sssetfirst ss ss)
(princ)
)

Tháng 9 14, 2010

nhờ các cao thủ giúp đỡ, mình đang cần viết lisp để chọn (select) các dim có phần tiền tố (prefix) hay hậu tố(suffĩ) giống nhau mà không thấy trong danh sách thông tin của đối tượng (entget),lisp minh cần viết gần giống lệnh qselect. ai biết cách làm xin viết lisp giúp hay chỉ giùm mình cách làm cũng được.Thanks
hình minh họa

http://www.cadviet.com/upfiles/3/prefix.jpg

Chào bạn nguyenh001,

Để lấy tiền tố của một đối tượng dimension, bạn có thể sử dụng hàm (vla-get-Alttextprefix obj)

Để lấy hậu tố của một đối tượng dimension, bạn có thể sử dụng hàm (vla-get-Alttextsuffix obj)

Trong đó obj là tên đối tượng VLA-OBJECT. Bạn có thể lấy nó từ hàm sau (vlax-ename->vla-object ent) với ent là tên cúng cơm của cái dimension bạn chọn trong CAD thường được gọi là entity name đó. Có nhiều cách để lấy dược thằng ent này, tùy thoe bạn lựa chọn.

Nếu bạn thấy khó khăn thì hãy post lên mọi người sẽ giúp bạn hoàn thành nguyện vọng thôi.

Tháng 9 14, 2010

Bạn thử cái này nhé:

(defun c:qsd(/ ss)
(setq ss(ssget (list  (cons 0 "DIMENSION") 
		  (cons 1 (strcat (getstring t "\n Nhap tien to :")
			"<>"
				  (getstring t "\n Nhap hau to :")
			  )
		  )
	   )
)
)
(sssetfirst ss ss)
(princ)
)

Cám ơn bạn Tue_NV nhiều, câu lệnh của bạn thật đơn giản và hiệu quả.Thank you so much

@thanhbinh: cám ơn bạn đã trả lời.cách của bạn hơi phức tạp đối với mình, hiện giờ mình sử dụng cách của tue_nv là đủ rồi, nếu cần truy xuất sâu hơn mình sẽ dùng cách của bạn, đến lúc đó mình sẽ hỏi bạn thêm, vì mấy hàm vl mình cũng chưa hiểu mấy

cám ơn mọi người.

Tháng 9 14, 2010

em xuất từ GPS ra file autocad thì các điểm định vị P001, P002, P003... là các block thuộc tính. nhờ các bác viết giúp em lisp chuyển từ block này thành các text có nội dung tương ứng. ví dụ: P514 thành 514. Em gửi kèm file để các bác làm giúp. Xin cảm ơn!

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

Tháng 9 14, 2010

em xuất từ GPS ra file autocad thì các điểm định vị P001, P002, P003... là các block thuộc tính. nhờ các bác viết giúp em lisp chuyển từ block này thành các text có nội dung tương ứng. ví dụ: P514 thành 514. Em gửi kèm file để các bác làm giúp. Xin cảm ơn!
http://www.cadviet.com/upfiles/3/test_2.dwg

bác save xuống cad thấp thấp anh em nhờ tốt nhất là CAD 2004

Tháng 9 14, 2010

LỆNH CẮT DIM SỬ DỤNG KO DC, NÓ BỊ LỖI NHƯ VẬY NÈ:

"Command: cd Unknown command "CD". Press F1 for help.

Command: ap APPLOAD Successfully loaded 2 files.

Command:

Sap xep dim, xd - free lisp from www.cadviet.com

Command:

Command: cd Please select dimension object!

Select objects: Specify opposite corner: 3 found

Select objects: Point to trim or extend:

Error: bad DXF group: (13)

Command: Specify opposite corner:

Command: *Cancel* "

CÓ ANH NÀO GIÚP EM VỚI.

Tháng 9 14, 2010

Hề hề đúng như mình nghĩ. Đặt câu hỏi xong rồi mới nghĩ ra

Bạn nào có phần mềm Qplot cho Mình xin với!Link trên diễn đàn Mình không down được!Xin cảm ơn rất nhiều!

Đăng nhập

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

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

phamngoctukts 714

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

nguyentuyen6 130

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

phamthanhbinh 3.146

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

nguyentuyen6 130

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

phamngoctukts 714

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

vothanhdn 5

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

phatcui 0

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

phamthanhbinh 3.146

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

phamthanhbinh 3.146

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

phamthanhbinh 3.146

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

phamngoctukts 714

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

nguyentuyen6 130

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

vothanhdn 5

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

gia_bach 1.549

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

phamngoctukts 714

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

nguyenh001 0

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

phamthanhbinh 3.146

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

phamthanhbinh 3.146

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

Tue_NV 3.912

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

phamthanhbinh 3.146