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

bach1212

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

    193
  • Đã tham gia

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

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


  1. Nguyên tắc của nó là lập lưới tam giác từ tập hợp tất cả các cao độ trong bản vẽ bạn ah. Đây là cao độ của cả 1 khu đất. 
    Thực ra mình đang làm trên phần mềm nova, việc lập lưới tam giác và nội suy cao độ tại 1 điểm bất kỳ trên nova thì oki  rồi.
    Nhưng công việc thay số thủ công lại vào các text trong blog thấy lâu quá nên muốn nhờ các cao thủ trợ giúp, để làm sao với blog có sẵn đó thì cao  độ tại điểm cần nội suy có thể ed được luôn vào text trong blog.
    @tot77: lisp rất hay, nhưng blog của bạn tạo ra tại điểm pick nội suy ko có khả năng di chuyển hay xoay chiều như blog gốc bạn ah. Nếu như blog mà lisp xuất ra vẫn giữ nguyên được y như blog gốc thì hay quá (Để mình còn dịch chuyển, thay đổi vị trí cho ko đè lên các đối tượng khác). CÒn ko mình cần lisp ed kết quả vào text trong blog (mình sẽ tự chèn trước) là được rồi. 


  2. Có 1 tập hợp điểm các cao độ trên mặt bằng. và 1 số blog att trong đó có chứa text cần ghi kết quả nội suy cao độ

    Nhờ các cao thủ giúp mình viết lisp, cơ bản ý tưởng là:

    Từ các cao độ đó, nội suy được cao độ tại điểm cần pick, (do người dùng chọn)
    Kết quả sẽ được lựa chọn thay vào số có màu xanh, bên dưới của blog. (Theo như file bản vẽ ví dụ )

    File đính kèm minh họa
    https://www.mediafire.com/?wsgy472mpw3tkxd


  3. Mình có text ở dạng này: D400,L100 và 1 lisp tính tổng chiều dài các đoạn thẳng.
    Nhờ các bạn chỉnh sửa sao cho kết quả sau khi dùng lisp được gắn vào định dạng text như trên, ngay sau chữ L

    Ví dụ: Tổng chiều dài các đoạn tính ra được 107, thì kết quả sẽ là: D400,L107

    File cad để check: http://www.cadviet.com/upfiles/3/40304_bd_tnm.rar

    Lisp tính tổng pline đã có sẵn: http://www.cadviet.com/upfiles/3/40304_tgll.lsp
     


  4. hí hí, ngon roài. thanks phamthanhbinh.

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=57792&st=20
     
    ;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai
     
     
    (defun c:dk (/ oldos p d1 enlst i ht cn cd ort1)
    (vl-load-com)
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    (setq d1 (getreal (strcat "\n Nhap khoang cach giua cac text <" (if (/= d nil) (rtos d 2 2) "") ">: ")))
    (if d1 (setq d d1)) 
    (setq ort1 (getstring (strcat "\n Text co dinh nam ben Trai hay ben Phai <T or P> <" (if (/= ort nil) (strcase ort) "") ">: ")))
    (if (/= ort1 "") (setq ort ort1) (setq ort1 ort) )
    (prompt "\n Chon nhom text can sap xep")
    (setq  enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
    (while enlst
       	(command "undo" "be")
       	(setq i 0)
       	(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
       	(if (= (strcase ort) "T")
       	(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
                            (cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst))))  )
           		cn (cdr (assoc 72 (entget (car enlst))))
           		cd (cdr (assoc 73 (entget (car enlst))))
       	)
       	(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
                            (cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst))))  )
           		cn (cdr (assoc 72 (entget (last enlst))))
           		cd (cdr (assoc 73 (entget (last enlst))))
                   enlst (reverse enlst)
       	)
       	)
       	(foreach en enlst
                (setq encode (entget en)
                        ht (cdr (assoc 40 encode))                  
                        encode (subst (cons 72 cn) (assoc 72 encode) encode)
                        encode (subst (cons 73 cd) (assoc 73 encode) encode)                  
         		)
         		(if (= (strcase ort) "T")
             		(setq  encode (subst (cons 11 (list (+ (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
             		(setq  encode (subst (cons 11 (list (- (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
         		)
         		(entmod encode)
         		(setq  i (1+ i))
            )
       	;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
       	;;; (if (= (strcase ans) "Y")
       	;;; 	(progn
             		(prompt "\n Hay chon nhom text can sap xep tiep theo")
             		(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
       	;;; 	)
       	;;; 	(setq enlst nil)
       	;;; )
            (command "undo" "e")
    )
    (setvar "osmode" oldos)
     
    (princ)
    )            
    
    
    

  5. mình muốn nó lưu giữ thông số như dạng của lisp này bạn ạ:

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=4077&pid=192557&st=0entry192557
     
    (defun c:ths (/ Ename Elist Msg Oldtext Oldlist Newtext Newlist)
    (command "undo" "be")
    (setq donvi (/ (getvar "viewsize") 40))
    (setq ddd (entsel "\nChon text bi tru"))
    (while
     (or
       (null ddd)
       (/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
    )
    (princ "\nDoi tuong khong phai la text! Chon lai")
    (setq ddd (entsel "\nChon text bi tru"))
    )
    
      (setq DTDTT (car ddd))
      (setq DTTT (entget DTDTT))
      (setq NDTTT (cdr (assoc 1 DTTT)))
      (setq NDTTT (atof NDTTT))
      (setq DIEMVIETTEXT (cdr (assoc 10 DTTT)))
    (setq diemvt1 (polar DIEMVIETTEXT pi donvi))
    (setq diemvt2 (polar DIEMVIETTEXT (* 2 pi) donvi))
    (setq diemvt3 (polar DIEMVIETTEXT (/ pi 2) donvi))
    (setq diemvt4 (polar DIEMVIETTEXT (- 0 (/ pi 2)) donvi))
            	(grdraw diemvt1 diemvt2 3)
            	(grdraw diemvt3 diemvt4 3)
    (if (= droffln nil)
    (setq droffln1 2.00)
    (setq droffln1 droffln)
    )
    (setq
    droffln (GETdist (strcat "\nNhap hang so tru: <" (rtos droffln1 2 2) ">")) 
    )
    (if (= droffln nil)
    (setq droffln droffln1)
    )
    
    (setq ketquaxuat (- NDTTT droffln))
    (setq ketquaxuat (rtos ketquaxuat 2 2))
    (setq dddsn (entsel "\nChon text xuat ket qua"))
    (while
     (or
       (null dddsn)
       (/= "TEXT" (cdr (assoc 0 (entget (car dddsn)))))
    )
    (princ "\nDoi tuong khong phai la text! Chon lai")
    (setq dddsn (entsel "\nChon text tru"))
    )
    
           	(setq DTDTTsn (car dddsn))
           	(setq DTMs (entget DTDTTsn))
           	(setq DTMs (subst (cons 1 ketquaxuat) (assoc 1 DTMs) DTMs))
           	(entmod DTMs)
    
    (command "undo" "end")
      	(Princ))
     
    
    
    

  6. oa oa oa. phần biến thì đặt như nào bạn nhỉ?

    thay rồi sao lisp không chạy? :D

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=57792&st=20
     
    ;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai
     
     
    (defun c:dk (/ oldos p d1 enlst i ht cn cd ort1)
    (vl-load-com)
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    
    (setq d1 (getreal (strcat "\n Nhap khoang cach giua cac text <" (rtos d 2 2) ">: ")))
    (if d1 (setq d d1))
    
    (setq ort1 (getstring (strcat "\n Text co dinh nam ben Trai hay ben Phai <T or P> <" (strcase ort) ">: ")))
    (if (= ort1 "T") (setq ort ort1)(setq ort "P")) 
    
    
    
    ;;;(setq ;;;;; p (getpoint "\n Chon diem chuan ")
            d (getreal "\n Nhap khoang cach giua cac text: ") )
    ;;;;(setq ort (getstring "\n Text co dinh nam ben Trai hay Phai <T or P>: "))
    
    
    (prompt "\n Chon nhom text can sap xep")
    (setq  enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
    (while enlst
       	(command "undo" "be")
       	(setq i 0)
       	(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
       	(if (= (strcase ort) "T")
       	(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
                            (cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst))))  )
           		cn (cdr (assoc 72 (entget (car enlst))))
           		cd (cdr (assoc 73 (entget (car enlst))))
       	)
       	(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
                            (cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst))))  )
           		cn (cdr (assoc 72 (entget (last enlst))))
           		cd (cdr (assoc 73 (entget (last enlst))))
                   enlst (reverse enlst)
       	)
       	)
       	(foreach en enlst
                (setq encode (entget en)
                        ht (cdr (assoc 40 encode))                  
                        encode (subst (cons 72 cn) (assoc 72 encode) encode)
                        encode (subst (cons 73 cd) (assoc 73 encode) encode)                  
         		)
         		(if (= (strcase ort) "T")
             		(setq  encode (subst (cons 11 (list (+ (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
             		(setq  encode (subst (cons 11 (list (- (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
         		)
         		(entmod encode)
         		(setq  i (1+ i))
            )
       	;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
       	;;; (if (= (strcase ans) "Y")
       	;;; 	(progn
             		(prompt "\n Hay chon nhom text can sap xep tiep theo")
             		(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
       	;;; 	)
       	;;; 	(setq enlst nil)
       	;;; )
            (command "undo" "e")
    )
    (setvar "osmode" oldos)
     
    (princ)
    )            
    
    
    

  7. lưu giữ được giá trị d, nhưng ko lưu được bên trái hay phải bác ạ. (lặp lại lisp thì nó nhận luôn là "P")

    dòng nhắc không ghi được giá trị cũ.

    VD: trước đó điền d = 0.2. thì lặp lại lệnh dòng nhắc cần ghi: Nhap khoang cach giua cac text: <0.2> ......

    trước đó nhập "T" thì lặp lại lệnh dòng nhắc cần ghi: Text co dinh nam ben Trai hay Phai <T or P> <T>
     


  8. hề hề, cám ơn bác phamthanhbinh. Làm như bác hướng dẫn, các lần sau đã ko cần nhập lại khoảng cách "d" và bên trái hay phải nữa.

    Tuy nhiên, nếu cần phải thay đổi lại thông số nhập vào thì sao ạ?

    E mún là nó chỉ lưu giữ thông số nhập vào, vẫn hiện lên dòng nhắc.( Để nếu có chỉnh sửa thì nhập lại thông số đầu vào). Theo hướng dẫn của bác thì hiện tại là đang mất hẳn dòng nhắc rùi ự.

    http://www.cadviet.com/upfiles/3/40304_dan_text__dk_1.lsp

    Bản vẽ để bác check giùm ạ:

    http://www.cadviet.com/upfiles/3/40304_in_tdn.rar


  9. Cho mình hỏi, trong lisp này, muốn lưu giữ thông số: khoảng cách "d" giữa các text và bên căn chỉnh text trái hay phải "T or P" cho các lần thực hiện lisp tiếp sau thì cần chỉnh sửa như thế nào để không phải gõ lại ạ:

    http://www.cadviet.com/upfiles/3/40304_dan_text__dk.lsp

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=57792&st=20
     
    ;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai
     
     
    (defun c:dk (/ oldos p d enlst i ht cn cd ort)
    (vl-load-com)
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    (setq ;;;;; p (getpoint "\n Chon diem chuan ")
            d (getreal "\n Nhap khoang cach giua cac text: ") )
    (setq ort (getstring "\n Text co dinh nam ben Trai hay Phai <T or P>: "))
    (prompt "\n Chon nhom text can sap xep")
    (setq  enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
    (while enlst
       	(command "undo" "be")
       	(setq i 0)
       	(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
       	(if (= (strcase ort) "T")
       	(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
                            (cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst))))  )
           		cn (cdr (assoc 72 (entget (car enlst))))
           		cd (cdr (assoc 73 (entget (car enlst))))
       	)
       	(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
                            (cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst))))  )
           		cn (cdr (assoc 72 (entget (last enlst))))
           		cd (cdr (assoc 73 (entget (last enlst))))
                   enlst (reverse enlst)
       	)
       	)
       	(foreach en enlst
                (setq encode (entget en)
                        ht (cdr (assoc 40 encode))                  
                        encode (subst (cons 72 cn) (assoc 72 encode) encode)
                        encode (subst (cons 73 cd) (assoc 73 encode) encode)                  
         		)
         		(if (= (strcase ort) "T")
             		(setq  encode (subst (cons 11 (list (+ (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
             		(setq  encode (subst (cons 11 (list (- (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
         		)
         		(entmod encode)
         		(setq  i (1+ i))
            )
       	;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
       	;;; (if (= (strcase ans) "Y")
       	;;; 	(progn
             		(prompt "\n Hay chon nhom text can sap xep tiep theo")
             		(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
       	;;; 	)
       	;;; 	(setq enlst nil)
       	;;; )
            (command "undo" "e")
    )
    (setvar "osmode" oldos)
     
    (princ)
    )            
    
    
    

     


     


  10. Hiện tại mình có lisp tính tổng chiều dài các đường thẳng , và kết quả thay vào 1 số có sẵn.

    Mình muốn, kết quả đó được làm tròn số luôn thì phải làm như thế nào?

    Hiện tại mình có 2 lisp riêng lẻ này: 1 là tính chiều dài, 2 là làm tròn số, không biết kết hợp lại như thế nào để được như ý?

    ;; free lisp from cadviet.com
    ;;;--------------------------------------------------------------------
    (defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
    ;;;--------------------------------------------------------------------
    (defun C:TGL( / ss L e)
    (setq
    ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
    )
    (vl-load-com)
    (while (setq e (ssname ss 0))
    (setq L (+ L (length1 e)))
    (ssdel e ss)
    )
    
    
    (setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
    te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
    (entmod te)
    )
    ;;;--------------------------------------------------------------------
    
    ;; free lisp from cadviet.com
    ;;;-------------------------------------------------------
    (defun etype (e);;;Entity Type
    (cdr (assoc 0 (entget e)))
    )
    ;;;-------------------------------------------------------
    (defun C:LTT( / ss n i oldDimzin e d v S)
    (if (not n0) (setq n0 2))
    (setq
    ss (ssget '((0 . "TEXT,MTEXT")))
    n (getint (strcat "\nSo chu so thap phan <" (itoa n0) ">:"))
    i 0
    oldDimzin (getvar "dimzin")
    )
    (if n (setq n0 n) (setq n n0))
    (setvar "dimzin" 8)
    (repeat (sslength ss)
    (setq e (ssname ss i))
    (if (= (etype e) "MTEXT") (progn
    (command "explode" e "")
    (setq e (entlast))
    ))
    (setq
    d (entget e)
    v (atof (cdr (assoc 1 d)))
    S (rtos v 2 n)
    d (subst (cons 1 S) (assoc 1 d) d)
    )
    (entmod d)
    (setq i (1+ i))
    )
    (setvar "dimzin" oldDimzin)
    (princ)
    )
    

    http://www.cadviet.com/upfiles/3/40304_ltt_n.lsp

    http://www.cadviet.com/upfiles/3/40304_tgl.lsp


  11. Nhờ các bạn chỉ giúp mình cách làm cho kết quả điền ra luôn là số có 2 chữ số sau dấu phẩy

    Hiện tại, nếu kết quả mà chẵn: VD: 90.00 thì chỉ nhận được: 90

    (defun c:edt()
      (if (= tl nil) (progn
        (setq tl (getreal "\nDrawing scale<1/> : "))
        (setq ntl tl)
        (setq tl2 (* ntl ntl))
        )
      )
      (setq dtl 0)
      (setq ss (ssadd))
      (setq oslast (getvar "OSMODE"))
      (command "osnap" "")
      (print)
      (print)
      (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
      (while (/= pt1 nil)
        (command "-boundary" pt1 "")
        (setq et (entlast))
        (ssadd et ss)
        (command "area" "e" "last")
        (setq vsize ( /(getvar "VIEWSIZE") 3 ))
        (command "hatch" "ANSI31" vsize "0" "last" "")
        (setq et (entlast))
        (ssadd et ss)
        (setq dtcon (getvar "AREA"))
        (setq dtl (+ dtcon dtl))
        (print)
        (print)
        (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
      )
      (command "setvar" "OSMODE" oslast)
      (command "erase" ss "")
      (setq ss nil)
      (command "redraw" )
      (setq dtl (* dtl tl2))
      (print dtl)
      (setq elst (entget (car (entsel "Thay cho so: "))))
      (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
      (entmod elst)
    (command "setvar" "OSMODE" 15359)
    

    http://www.cadviet.com/upfiles/3/40304_edt.lsp


  12. mình làm trên bản vẽ new_mới tinh cũng ko được mà. đều báo lỗi như thế này khi chọn mũi tên:
    Command: rv
    Select reversible object:
    Select objects: Specify opposite corner: 1 found

    Select objects:  ; error: no function definition: REVLEADER

    File: http://www.cadviet.com/upfiles/3/40304_doi_chieu_mui_ten.dwg
    Mong trợ giúp!


     

×