Cầu đường Online
Cảm ơn bạn đã ghé thăm diễn đàn! Bạn chưa đăng kí để trở thành những Members!
Xem phim 3D - http://3dsmartcoffee.com.vn
Similar topics
    Đăng Nhập

    Quên mật khẩu

    Latest topics
    » Đăng tải hồ sơ năng lực xây dựng
    Thu Jun 23, 2016 11:10 am by dangtaixd

    » Thói quen thay dầu máy xe ô tô không đúng cách là nguyên nhân khiến động cơ ôtô nhanh xuống cấp
    Thu Apr 07, 2016 10:46 am by thuanit64

    » Chăm sóc bảo dưỡng bảo trì ôtô đúng cách
    Thu Apr 07, 2016 10:46 am by thuanit64

    » Khi nào cần thay nhớt động cơ xe hơi - ôtô
    Thu Apr 07, 2016 10:45 am by thuanit64

    » Tại sao phải chăm sóc thay dầu hộp số ô tô định kỳ
    Thu Apr 07, 2016 10:45 am by thuanit64

    » Mở lớp thẩm định giá tại Vũng Tàu, Khánh Hòa ngày 22/4
    Mon Mar 28, 2016 1:50 pm by viengiaoduc

    » Cơ hội có chứng chỉ hành nghề giám sát, thiết kế, khảo sát không phải thi sát hạch
    Mon Mar 14, 2016 3:08 pm by viengiaoduc

    » Học chứng chỉ thẩm định giá ở đâu tốt nhất
    Tue Mar 08, 2016 9:26 am by viengiaoduc

    » Học chứng chỉ an toàn leo cao, thoát hiểm nhà cao tầng, làm việc trong không gian kín
    Wed Feb 24, 2016 2:59 pm by viengiaoduc

    » Địa điểm học nhanh chứng chỉ giám sát thi công công nghệ thông tin
    Wed Feb 17, 2016 3:05 pm by viengiaoduc

    » Học chứng chỉ giám sát thi công công nghệ thông tin giá rẻ
    Mon Jan 25, 2016 4:09 pm by viengiaoduc

    » Hỗ trợ xin cấp nhanh chứng chỉ hành nghề tu bổ di tích
    Tue Jan 12, 2016 4:39 pm by viengiaoduc

    » Địa điểm học chứng chỉ lập và quản lý dự án công nghệ thông tin uy tín nhất
    Wed Dec 30, 2015 10:06 am by viengiaoduc

    » Tại sao cần công khai năng lực nhà thầu lên web bộ XD/0967343258
    Wed Dec 16, 2015 1:59 pm by viengiaoduc

    » Địa điểm học chứng chỉ bảo quản, tu bổ di tích nhanh nhất
    Sat Dec 05, 2015 9:55 am by viengiaoduc

    Statistics
    Diễn Đàn hiện có 6501 thành viên
    Chúng ta cùng chào mừng thành viên mới đăng ký: tiennguyenglobal

    Tổng số bài viết đã gửi vào diễn đàn là 1657 in 410 subjects
    Vận tải Xây dựng
    Số lượt truy cập
    0982.767.231

    CÀI LISP TRONG CAD 2007

    Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down

    NewPost CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Wed Dec 08, 2010 4:33 pm

    Anh admin chỉ giúp em lam sao để cài được UTILITYCAD V22009
    vào cad 2007 vậy anh.Nếu như ko cài được thì có lisp nào tương tự như UTILITYCAD V22009 ko,anh cho em xin với.vì em đang sử phần mềm TDT KSVN chỉ sử dụng trên cad 2007 thôi.nên mỗi lần sử dụng lâu lắm mong anh giúp dùm.cảm ơn trước nhé.

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by qkhs.live on Thu Dec 09, 2010 8:12 am

    Bạn cài bình thường như Cad 2005 và các Cad khác thôi mà. bạn vào APPLOAD (AP)/Contents /Add rồi chọn đến đường dẫn Design/UTILITYCAD/LOADUFC.VLX. Sau đó khởi động lại Cad2007 và vào lệnh MENUUFC sẽ hiện trên Menu tab UFC. Nếu không được bạn vào MENULOAD trên cửa sổ đó chọn BROWSE chọn đến đường dẫn Design/UTILITYCAD/Mns/UFC.cui rồi Load --> OK.

    qkhs.live
    Thiếu uý

    Posts : 78
    Points : 106
    Reputation : 1
    Join date : 28/08/2010
    Age : 35
    Đến từ : TAYBAC

    http://taybac.1talk.net

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Thu Dec 09, 2010 8:20 am

    thanks bạn trước nhé.để mình làm thử.

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by qkhs.live on Thu Dec 09, 2010 8:24 am

    Admin cho xin bộ UTILITYCAD 2010 được không? hoặc viết giúp mình lisp bật các lựa chọn truy bắt điểm : Endpoint, Midpoint, Center, Quadrant, Intersection, Perpendicular, Nearest.
    Cảm ơn Admin nhiều.

    qkhs.live
    Thiếu uý

    Posts : 78
    Points : 106
    Reputation : 1
    Join date : 28/08/2010
    Age : 35
    Đến từ : TAYBAC

    http://taybac.1talk.net

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Admin on Thu Dec 09, 2010 8:33 pm

    Cái này thì đơn giản thôi qkhs.live , bạn có thể tuỳ chỉnh đoạn code sau theo ý thích nhé.
    Code:

    (defun c:f3 ()
      (setvar "osmode" 131)
      (princ)
      )
    Tác dụng: Xác lập chế độ Osnaps (bắt điểm tự động)
    0= 0
    1= điểm cuối
    2= điểm giữa
    4= tâm
    8= nút
    16= cung 1/4
    32= giao điểm
    64= điểm chèn
    128= vuông góc
    256= gần nhất
    512= nhanh
    Như vậy bạn thấy cách quản lý biến theo các bit hệ thống, nếu bạn muốn hoạt động đồng thời nhiều hơn 1 biến thì lấy tổng của nó nhé, ví dụ: bạn muốn chọn điểm cuối, điểm giữa, vuông góc thì bằng 131 hoặc (+ 1 2 128)


    Chung tay xây dựng nền tảng vững chắc - Cầu đường Online
    Sàn giao dịch bất động sản - Cafe xem phim 3D Đà Nẵng

    Admin
    Admin

    Posts : 362
    Points : 663
    Reputation : 53
    Join date : 17/08/2010
    Age : 32
    Đến từ : Đà Nẵng

    http://nguyentaudn.findtalk.biz

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Fri Dec 10, 2010 9:42 am

    Anh em nào sửa lại giúp em lisp này với .Đây là lisp liệt kê tọa độ góc ranh lệnh là TD1.Khi xuất tọa độ góc ranh ra bảng thì cột STT có thể sửa lại bắt đầu từ M1,M2,.....(lisp xuất ra là 1,2,...)và đổi cột Y thành X và ngược lại,và cho font chữ về ARIAL được ko ,em xin cảm ơn trước .và đây là lisp:
    ;; free lisp from cadviet.com
    Code:

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
    ;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
    ;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
    ;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;PUBLIC FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (Defun DTR (x) (/ (* x pi) 180))
    ;;;change degree to radian, return REAL
    ;;;-------------------------------------------------------------------------------
    (defun lineP (p0 a r / p1)
    ;;;Line polar: point, degree angle, radius
      (setq p1 (polar p0 (dtr a) r))
      (command "line" p0 p1 "")
    )
    ;;;-------------------------------------------------------------------------------
    (defun linePX (p0 x) (lineP p0 0 x))
    ;;;Horizontal line: length x, from p0
    ;;;-------------------------------------------------------------------------------
    (defun linePY (p0 y) (lineP p0 90 y))
    ;;;Vertical line: length y, from p0
    ;;;-------------------------------------------------------------------------------
    (defun getVert (e / i L)
    ;;;Return list of all vertex from pline e
      (setq   i 0
       L nil
      )
      (vl-load-com)
      (repeat (fix (+ (vlax-curve-getEndParam e) 1))
        (setq L (append L (list (vlax-curve-getPointAtParam e i))))
        (setq i (1+ i))
      )
      L
    )

    ;;; First point of List rearrangement
    (defun relist(pt0 Lst / i rt)
      (setq i 0)
      (foreach pt Lst
        (if (equal pt0 pt 0.001)
          (setq rt i))
        (setq i (1+ i)))
      (append (append (member (nth rt Lst) Lst)
           (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
         (list (nth rt Lst)))
    )

    ;;;New Layer
    (defun newlayer(a b c d)
        (if (not (tblsearch "layer" a))
          (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
    )
    ;;;-------------------------------------------------------------------------------
    (defun wtxtMC (txt p h k)
    ;;;Write text Middle Center, specify text, point, height
      (entmake (list (cons 0 "TEXT")
           (cons 7 (getvar "textstyle"))
           (cons 1 txt)
           (cons 10 p)
           (cons 11 p)
           (cons 40 h)
           (cons 72 1)
           (cons 73 2)
           (if k (cons 51 (DTR 18)) (cons 51 0))
         )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect (e / e2 SS)
    ;;;Selection set from e to entlast
      (setq SS (ssadd))
      (ssadd e SS)
      (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
      SS
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect1   (e / ss)
    ;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
      (if (= e nil)
        (setq ss (collect (entnext)))
        (progn (setq ss (collect e)) (ssdel e ss))
      )
    )
    ;;;-------------------------------------------------------------------------------

    ;;;PRIVATE FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (defun txt1 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun txt2 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        p4 (polar p4 (* 0.5 pi) h)
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------


    ;;;MAIN PROGRAM
    ;;;-------------------------------------------------------------------------------
    (defun C:td1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
      (setvar "cmdecho" 0)

    ;;;New layer check
      (newlayer "kichthuoc" 7 "continuous" "default")
      (newlayer "stt" 1 "continuous" "default")
      (newlayer "bangtd" 7 "continuous" "default")

    ;;;GET TEXT HEIGHT
      (if (not h0)  (setq h0 1))
      (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
      (if (not h)  (setq h h0)  (setq h0 h))

    ;;;GET DECIMAL PRECISION
      (if (not ntp0)  (setq ntp0 2))
      (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
      (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

    ;;;GET CIRCLE RADIUS
      (if (not cr0)  (setq cr0 0.3))
      (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
      (if cr (setq cr0 cr))
     
    ;;;PICK & BASE POINT
      (initget "Y")
      (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
     
      (setq oldos (getvar "osmode")
       pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :")) 
     
      (while pdau
        (setq p (getpoint "\nPick 1 diem giua mien kin:")
         pvL nil pvL1 nil)
        (command "boundary" p "")
        (setq et (entlast)
              pvL1 (reverse (getvert et))) 
        (redraw et 3) 
        (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
        (command "erase" et "")
        (setq  p0 p00
              p01  (polar p00 (* 1.5 pi) (* h 3))   
              pvL  (relist pdau pvL1)
              n   (length pvL)
              p02   (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
        ) 
        (setvar "osmode" 0)
    ;;;HEADER
      (setvar "CLAYER" "bangtd")
      (linepx p0 (* 32 h))
      (command "copy" "L" "" "m" p00 p01 p02 "")
      (linepy p0 (- (distance p0 p02)))
      (command "copy" "L" "" "m"  p0
         (list (+ (car p0) (* 4 h)) (cadr p0))
         (list (+ (car p0) (* 14 h)) (cadr p0))
         (list (+ (car p0) (* 24 h)) (cadr p0))
         (list (+ (car p0) (* 32 h)) (cadr p0))
         "")
      (setq Lkqua nil)
      (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
         (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
           (* 1.2 h) nil)
      (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
      (setq Lkqua (append Lkqua (list Lkq)))
      (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

    ;;;MAKE RECORDS
      (setq   j  0
       pt nil)
      (repeat n
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (if   pt
          (setq S (rtos (distance pt pv) 2 ntp))
          (setq S "")
        )
        (setq
          txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
          Lkqua (append Lkqua (list txtL))
        )
        (txt2 txtL)
        (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
        (setq pt pv)
        (setq j (1+ j))
        (if   (= j (- n 1))  (setq j 0))
      )

    ;;;MAKE BLOCK
      (setq ss (collect1 et))
      (setq bn "1")
      (while (tblsearch "block" bn)
        (setq bn (itoa (1+ (atoi bn))))
      )
      (command "block" bn p00 ss "")
      (command "insert" bn p00 "" "" "")

    ;;;WRITE POINT NAME
      (setvar "CLAYER" "stt")
      (setq j 0)
      (repeat (1- n)
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (wtxtMC num (polar pv 0 h) h t)
        (command "circle" pv cr0)
        (command "hatch" "S" (setq vtron (entlast)) "")
        (command "erase" vtron "")
        (setq j (1+ j))
      )

    ;;;GHI CANH THUA
        (setvar "CLAYER" "kichthuoc")
        (ghicanh) 

    ;;;FINISH
        (savef)
        (setvar "osmode" oldos)
        (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
      ) 
      (setvar "cmdecho" 1)
      (princ)
    )

    ;;;-------------------------------------------------------------------------------
    (defun savef() 
      (if save
        (progn
          (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
        (vl-filename-base (vl-string-right-trim "" (getvar "dwgname"))) ".txt")) "a"))
          (foreach line Lkqua
       (setq line1 "")
       (foreach it line
         (setq line1 (strcat line1 " " it)))
       (write-line line1 file)
          )
          (close file)
          (princ (strcat "\nDa luu thanh file " tenfile))
        )
      )
    )

    ;;;PHAN BO SUNG CUA elleHCSC
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_TCA (S p a)
    ;;;Entmake text S at p with angle A - Top Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 3)
           )
        )
      )
    )
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_BCA (S p a)
    ;;;Entmake text S at p with angle A - Bottom Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 1)
           )
        )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
      (setq
        i   0 
        k   (1- (length pvL))
      )
      (repeat k
        (setq
          p1  (nth i pvL)
          p2  (nth (+ i 1) pvL)
          dist (distance p1 p2)
          rad  (angle p1 p2)
          x_mp (* (+ (car p1) (car p2)) 0.5)
          y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
          mp  (list x_mp y_mp)
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (progn
       (setq rad (+ rad pi))
       (Text_canh_TCA (rtos dist 2 2) mp rad)
          )
          (Text_canh_BCA (rtos dist 2 2) mp rad)
        )
        (setq i (1+ i))
      )
      ;; repeat k;
    )
    ;;;--------------------------
    lips này em đang sử dụng bình thường ko lỗi gi` hết.anh em rồi sử giúp em nha.cảm ơn anh nhiều.


    Được sửa bởi ro88 ngày Sat Dec 11, 2010 10:01 am; sửa lần 1.

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Admin on Fri Dec 10, 2010 10:05 am

    ro88 đã viết:Anh em nào sửa lại giúp em lisp này với .Đây là lisp liệt kê tọa độ góc ranh lệnh là TD1.Khi xuất tọa độ góc ranh ra bảng thì cột STT có thể sửa lại bắt đầu từ M1,M2,.....(lisp xuất ra là 1,2,...)và đổi cột Y thành X và ngược lại,và cho font chữ về ARIAL được ko ,em xin cảm ơn trước .và đây là lisp:
    ;; free lisp from cadviet.com
    Bạn xem thử nhé
    Code:

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
    ;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
    ;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
    ;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;PUBLIC FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (Defun DTR (x) (/ (* x pi) 180))
    ;;;change degree to radian, return REAL
    ;;;-------------------------------------------------------------------------------
    (defun lineP (p0 a r / p1)
    ;;;Line polar: point, degree angle, radius
      (setq p1 (polar p0 (dtr a) r))
      (command "line" p0 p1 "")
    )
    ;;;-------------------------------------------------------------------------------
    (defun linePX (p0 x) (lineP p0 0 x))
    ;;;Horizontal line: length x, from p0
    ;;;-------------------------------------------------------------------------------
    (defun linePY (p0 y) (lineP p0 90 y))
    ;;;Vertical line: length y, from p0
    ;;;-------------------------------------------------------------------------------
    (defun getVert (e / i L)
    ;;;Return list of all vertex from pline e
      (setq   i 0
       L nil
      )
      (vl-load-com)
      (repeat (fix (+ (vlax-curve-getEndParam e) 1))
        (setq L (append L (list (vlax-curve-getPointAtParam e i))))
        (setq i (1+ i))
      )
      L
    )

    ;;; First point of List rearrangement
    (defun relist(pt0 Lst / i rt)
      (setq i 0)
      (foreach pt Lst
        (if (equal pt0 pt 0.001)
          (setq rt i))
        (setq i (1+ i)))
      (append (append (member (nth rt Lst) Lst)
           (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
         (list (nth rt Lst)))
    )

    ;;;New Layer
    (defun newlayer(a b c d)
        (if (not (tblsearch "layer" a))
          (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
    )
    ;;;-------------------------------------------------------------------------------
    (defun wtxtMC (txt p h k)
    ;;;Write text Middle Center, specify text, point, height
      (entmake (list (cons 0 "TEXT")
           (cons 7 (getvar "textstyle"))
           (cons 1 txt)
           (cons 10 p)
           (cons 11 p)
           (cons 40 h)
           (cons 72 1)
           (cons 73 2)
           (if k (cons 51 (DTR 18)) (cons 51 0))
         )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect (e / e2 SS)
    ;;;Selection set from e to entlast
      (setq SS (ssadd))
      (ssadd e SS)
      (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
      SS
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect1   (e / ss)
    ;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
      (if (= e nil)
        (setq ss (collect (entnext)))
        (progn (setq ss (collect e)) (ssdel e ss))
      )
    )
    ;;;-------------------------------------------------------------------------------

    ;;;PRIVATE FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (defun txt1 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun txt2 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        p4 (polar p4 (* 0.5 pi) h)
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------


    ;;;MAIN PROGRAM
    ;;;-------------------------------------------------------------------------------
    (defun C:td1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
      (setvar "cmdecho" 0)

    ;;;New layer check
      (newlayer "kichthuoc" 7 "continuous" "default")
      (newlayer "stt" 1 "continuous" "default")
      (newlayer "bangtd" 7 "continuous" "default")

    ;;;GET TEXT HEIGHT
      (if (not h0)  (setq h0 1))
      (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
      (if (not h)  (setq h h0)  (setq h0 h))

    ;;;GET DECIMAL PRECISION
      (if (not ntp0)  (setq ntp0 2))
      (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
      (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

    ;;;GET CIRCLE RADIUS
      (if (not cr0)  (setq cr0 0.3))
      (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
      (if cr (setq cr0 cr))
     
    ;;;PICK & BASE POINT
      (initget "Y")
      (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
     
      (setq oldos (getvar "osmode")
       pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :")) 
     
      (while pdau
        (setq p (getpoint "\nPick 1 diem giua mien kin:")
         pvL nil pvL1 nil)
        (command "boundary" p "")
        (setq et (entlast)
              pvL1 (reverse (getvert et))) 
        (redraw et 3) 
        (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
        (command "erase" et "")
        (setq  p0 p00
              p01  (polar p00 (* 1.5 pi) (* h 3))   
              pvL  (relist pdau pvL1)
              n   (length pvL)
              p02   (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
        ) 
        (setvar "osmode" 0)
    ;;;HEADER
      (setvar "CLAYER" "bangtd")
      (linepx p0 (* 32 h))
      (command "copy" "L" "" "m" p00 p01 p02 "")
      (linepy p0 (- (distance p0 p02)))
      (command "copy" "L" "" "m"  p0
         (list (+ (car p0) (* 4 h)) (cadr p0))
         (list (+ (car p0) (* 14 h)) (cadr p0))
         (list (+ (car p0) (* 24 h)) (cadr p0))
         (list (+ (car p0) (* 32 h)) (cadr p0))
         "")
      (setq Lkqua nil)
      (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
         (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
           (* 1.2 h) nil)
      (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
      (setq Lkqua (append Lkqua (list Lkq)))
      (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

    ;;;MAKE RECORDS
      (setq   j  0
       pt nil)
      (repeat n
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (if   pt
          (setq S (rtos (distance pt pv) 2 ntp))
          (setq S "")
        )
        (setq
          txtL (list (stracat "M" num) (rtos (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S) ;;; Thay doi o vi tri nay
          Lkqua (append Lkqua (list txtL))
        )
        (txt2 txtL)
        (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
        (setq pt pv)
        (setq j (1+ j))
        (if   (= j (- n 1))  (setq j 0))
      )

    ;;;MAKE BLOCK
      (setq ss (collect1 et))
      (setq bn "1")
      (while (tblsearch "block" bn)
        (setq bn (itoa (1+ (atoi bn))))
      )
      (command "block" bn p00 ss "")
      (command "insert" bn p00 "" "" "")

    ;;;WRITE POINT NAME
      (setvar "CLAYER" "stt")
      (setq j 0)
      (repeat (1- n)
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (wtxtMC num (polar pv 0 h) h t)
        (command "circle" pv cr0)
        (command "hatch" "S" (setq vtron (entlast)) "")
        (command "erase" vtron "")
        (setq j (1+ j))
      )

    ;;;GHI CANH THUA
        (setvar "CLAYER" "kichthuoc")
        (ghicanh) 

    ;;;FINISH
        (savef)
        (setvar "osmode" oldos)
        (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
      ) 
      (setvar "cmdecho" 1)
      (princ)
    )

    ;;;-------------------------------------------------------------------------------
    (defun savef() 
      (if save
        (progn
          (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
        (vl-filename-base (vl-string-right-trim "" (getvar "dwgname"))) ".txt")) "a"))
          (foreach line Lkqua
       (setq line1 "")
       (foreach it line
         (setq line1 (strcat line1 " " it)))
       (write-line line1 file)
          )
          (close file)
          (princ (strcat "\nDa luu thanh file " tenfile))
        )
      )
    )

    ;;;PHAN BO SUNG CUA elleHCSC
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_TCA (S p a)
    ;;;Entmake text S at p with angle A - Top Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 3)
           )
        )
      )
    )
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_BCA (S p a)
    ;;;Entmake text S at p with angle A - Bottom Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 1)
           )
        )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
      (setq
        i   0 
        k   (1- (length pvL))
      )
      (repeat k
        (setq
          p1  (nth i pvL)
          p2  (nth (+ i 1) pvL)
          dist (distance p1 p2)
          rad  (angle p1 p2)
          x_mp (* (+ (car p1) (car p2)) 0.5)
          y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
          mp  (list x_mp y_mp)
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (progn
       (setq rad (+ rad pi))
       (Text_canh_TCA (rtos dist 2 2) mp rad)
          )
          (Text_canh_BCA (rtos dist 2 2) mp rad)
        )
        (setq i (1+ i))
      )
      ;; repeat k;
    )
    ;;;--------------------------


    Chung tay xây dựng nền tảng vững chắc - Cầu đường Online
    Sàn giao dịch bất động sản - Cafe xem phim 3D Đà Nẵng

    Admin
    Admin

    Posts : 362
    Points : 663
    Reputation : 53
    Join date : 17/08/2010
    Age : 32
    Đến từ : Đà Nẵng

    http://nguyentaudn.findtalk.biz

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Fri Dec 10, 2010 10:56 am

    vẫn như cũ anh ơi.Mà khi xuất ra sao ko có tọa độ mà cũng ko phải là block cũng ko có cạnh luôn.anh xem lại dùm nha.

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Admin on Fri Dec 10, 2010 1:57 pm

    ro88 đã viết:
    vẫn như cũ anh ơi.Mà khi xuất ra sao ko có tọa độ mà cũng ko phải là block cũng ko có cạnh luôn.anh xem lại dùm nha.
    Mình chỉ sửa nội dung theo ý bạn thôi, còn xuất hiện lỗi khi thực hiện thì do file gốc bạn đưa lên đã bị lỗi rồi mà
    Bạn post lại file gốc (nhớ test kỹ trước khi upload lên nha) mình sẽ xem lại cho đỡ tốn thời gian.
    Thân


    Chung tay xây dựng nền tảng vững chắc - Cầu đường Online
    Sàn giao dịch bất động sản - Cafe xem phim 3D Đà Nẵng

    Admin
    Admin

    Posts : 362
    Points : 663
    Reputation : 53
    Join date : 17/08/2010
    Age : 32
    Đến từ : Đà Nẵng

    http://nguyentaudn.findtalk.biz

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Fri Dec 10, 2010 4:32 pm

    thanks anh nha.để em gửi lại lisp.lisp này em đang dùng vẫn chạy tốt.anh text thử đi rồi sử dùm em nhé
    ;; free lisp from cadviet.com
    Code:

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
    ;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
    ;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
    ;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;PUBLIC FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (Defun DTR (x) (/ (* x pi) 180))
    ;;;change degree to radian, return REAL
    ;;;-------------------------------------------------------------------------------
    (defun lineP (p0 a r / p1)
    ;;;Line polar: point, degree angle, radius
      (setq p1 (polar p0 (dtr a) r))
      (command "line" p0 p1 "")
    )
    ;;;-------------------------------------------------------------------------------
    (defun linePX (p0 x) (lineP p0 0 x))
    ;;;Horizontal line: length x, from p0
    ;;;-------------------------------------------------------------------------------
    (defun linePY (p0 y) (lineP p0 90 y))
    ;;;Vertical line: length y, from p0
    ;;;-------------------------------------------------------------------------------
    (defun getVert (e / i L)
    ;;;Return list of all vertex from pline e
      (setq   i 0
       L nil
      )
      (vl-load-com)
      (repeat (fix (+ (vlax-curve-getEndParam e) 1))
        (setq L (append L (list (vlax-curve-getPointAtParam e i))))
        (setq i (1+ i))
      )
      L
    )

    ;;; First point of List rearrangement
    (defun relist(pt0 Lst / i rt)
      (setq i 0)
      (foreach pt Lst
        (if (equal pt0 pt 0.001)
          (setq rt i))
        (setq i (1+ i)))
      (append (append (member (nth rt Lst) Lst)
           (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
         (list (nth rt Lst)))
    )

    ;;;New Layer
    (defun newlayer(a b c d)
        (if (not (tblsearch "layer" a))
          (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
    )
    ;;;-------------------------------------------------------------------------------
    (defun wtxtMC (txt p h k)
    ;;;Write text Middle Center, specify text, point, height
      (entmake (list (cons 0 "TEXT")
           (cons 7 (getvar "textstyle"))
           (cons 1 txt)
           (cons 10 p)
           (cons 11 p)
           (cons 40 h)
           (cons 72 1)
           (cons 73 2)
           (if k (cons 51 (DTR 18)) (cons 51 0))
         )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect (e / e2 SS)
    ;;;Selection set from e to entlast
      (setq SS (ssadd))
      (ssadd e SS)
      (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
      SS
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect1   (e / ss)
    ;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
      (if (= e nil)
        (setq ss (collect (entnext)))
        (progn (setq ss (collect e)) (ssdel e ss))
      )
    )
    ;;;-------------------------------------------------------------------------------

    ;;;PRIVATE FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (defun txt1 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun txt2 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        p4 (polar p4 (* 0.5 pi) h)
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------


    ;;;MAIN PROGRAM
    ;;;-------------------------------------------------------------------------------
    (defun C:td1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
      (setvar "cmdecho" 0)

    ;;;New layer check
      (newlayer "kichthuoc" 7 "continuous" "default")
      (newlayer "stt" 1 "continuous" "default")
      (newlayer "bangtd" 7 "continuous" "default")

    ;;;GET TEXT HEIGHT
      (if (not h0)  (setq h0 1))
      (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
      (if (not h)  (setq h h0)  (setq h0 h))

    ;;;GET DECIMAL PRECISION
      (if (not ntp0)  (setq ntp0 2))
      (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
      (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

    ;;;GET CIRCLE RADIUS
      (if (not cr0)  (setq cr0 0.3))
      (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
      (if cr (setq cr0 cr))
     
    ;;;PICK & BASE POINT
      (initget "Y")
      (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
     
      (setq oldos (getvar "osmode")
       pdau (getpoint "\nPick diem dau tien (so thu tu = M1) :")) 
     
      (while pdau
        (setq p (getpoint "\nPick 1 diem giua mien kin:")
         pvL nil pvL1 nil)
        (command "boundary" p "")
        (setq et (entlast)
              pvL1 (reverse (getvert et))) 
        (redraw et 3) 
        (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
        (command "erase" et "")
        (setq  p0 p00
              p01  (polar p00 (* 1.5 pi) (* h 3))   
              pvL  (relist pdau pvL1)
              n   (length pvL)
              p02   (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
        ) 
        (setvar "osmode" 0)
    ;;;HEADER
      (setvar "CLAYER" "bangtd")
      (linepx p0 (* 32 h))
      (command "copy" "L" "" "m" p00 p01 p02 "")
      (linepy p0 (- (distance p0 p02)))
      (command "copy" "L" "" "m"  p0
         (list (+ (car p0) (* 4 h)) (cadr p0))
         (list (+ (car p0) (* 14 h)) (cadr p0))
         (list (+ (car p0) (* 24 h)) (cadr p0))
         (list (+ (car p0) (* 32 h)) (cadr p0))
         "")
      (setq Lkqua nil)
      (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
         (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
           (* 1.2 h) nil)
      (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
      (setq Lkqua (append Lkqua (list Lkq)))
      (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

    ;;;MAKE RECORDS
      (setq   j  0
       pt nil)
      (repeat n
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (if   pt
          (setq S (rtos (distance pt pv) 2 ntp))
          (setq S "")
        )
        (setq
          txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
          Lkqua (append Lkqua (list txtL))
        )
        (txt2 txtL)
        (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
        (setq pt pv)
        (setq j (1+ j))
        (if   (= j (- n 1))  (setq j 0))
      )

    ;;;MAKE BLOCK
      (setq ss (collect1 et))
      (setq bn "1")
      (while (tblsearch "block" bn)
        (setq bn (itoa (1+ (atoi bn))))
      )
      (command "block" bn p00 ss "")
      (command "insert" bn p00 "" "" "")

    ;;;WRITE POINT NAME
      (setvar "CLAYER" "stt")
      (setq j 0)
      (repeat (1- n)
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (wtxtMC num (polar pv 0 h) h t)
        (command "circle" pv cr0)
        (command "hatch" "S" (setq vtron (entlast)) "")
        (command "erase" vtron "")
        (setq j (1+ j))
      )

    ;;;GHI CANH THUA
        (setvar "CLAYER" "kichthuoc")
        (ghicanh) 

    ;;;FINISH
        (savef)
        (setvar "osmode" oldos)
        (setq pdau (getpoint "\nPick diem dau tien (so thu tu =M 1) :"))
      ) 
      (setvar "cmdecho" 1)
      (princ)
    )

    ;;;-------------------------------------------------------------------------------
    (defun savef() 
      (if save
        (progn
          (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
        (vl-filename-base (vl-string-right-trim "" (getvar "dwgname"))) ".txt")) "a"))
          (foreach line Lkqua
       (setq line1 "")
       (foreach it line
         (setq line1 (strcat line1 " " it)))
       (write-line line1 file)
          )
          (close file)
          (princ (strcat "\nDa luu thanh file " tenfile))
        )
      )
    )

    ;;;PHAN BO SUNG CUA elleHCSC
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_TCA (S p a)
    ;;;Entmake text S at p with angle A - Top Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 3)
           )
        )
      )
    )
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_BCA (S p a)
    ;;;Entmake text S at p with angle A - Bottom Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 1)
           )
        )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
      (setq
        i   0 
        k   (1- (length pvL))
      )
      (repeat k
        (setq
          p1  (nth i pvL)
          p2  (nth (+ i 1) pvL)
          dist (distance p1 p2)
          rad  (angle p1 p2)
          x_mp (* (+ (car p1) (car p2)) 0.5)
          y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
          mp  (list x_mp y_mp)
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (progn
       (setq rad (+ rad pi))
       (Text_canh_TCA (rtos dist 2 2) mp rad)
          )
          (Text_canh_BCA (rtos dist 2 2) mp rad)
        )
        (setq i (1+ i))
      )
      ;; repeat k;
    )
    ;;;--------------------------
    @ro88: lần sau bạn up code thì để trong thẻ [code] nhé

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by qkhs.live on Fri Dec 10, 2010 4:38 pm

    Admin đã viết:Cái này thì đơn giản thôi qkhs.live , bạn có thể tuỳ chỉnh đoạn code sau theo ý thích nhé.
    Code:

    (defun c:f3 ()
      (setvar "osmode" 131)
      (princ)
      )
    Tác dụng: Xác lập chế độ Osnaps (bắt điểm tự động)
    0= 0
    1= điểm cuối
    2= điểm giữa
    4= tâm
    8= nút
    16= cung 1/4
    32= giao điểm
    64= điểm chèn
    128= vuông góc
    256= gần nhất
    512= nhanh
    Như vậy bạn thấy cách quản lý biến theo các bit hệ thống, nếu bạn muốn hoạt động đồng thời nhiều hơn 1 biến thì lấy tổng của nó nhé, ví dụ: bạn muốn chọn điểm cuối, điểm giữa, vuông góc thì bằng 131 hoặc (+ 1 2 128)

    Cảm ơn Admin nhiều nhé, mình không biết lập trình nên vẫn chẳng hiểu gì cả.

    qkhs.live
    Thiếu uý

    Posts : 78
    Points : 106
    Reputation : 1
    Join date : 28/08/2010
    Age : 35
    Đến từ : TAYBAC

    http://taybac.1talk.net

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Admin on Fri Dec 10, 2010 4:42 pm

    ro88 đã viết:thanks anh nha.để em gửi lại lisp.lisp này em đang dùng vẫn chạy tốt.anh text thử đi rồi sử dùm em nhé
    ;; free lisp from cadviet.com
    Code:

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
    ;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
    ;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
    ;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;PUBLIC FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (Defun DTR (x) (/ (* x pi) 180))
    ;;;change degree to radian, return REAL
    ;;;-------------------------------------------------------------------------------
    (defun lineP (p0 a r / p1)
    ;;;Line polar: point, degree angle, radius
      (setq p1 (polar p0 (dtr a) r))
      (command "line" p0 p1 "")
    )
    ;;;-------------------------------------------------------------------------------
    (defun linePX (p0 x) (lineP p0 0 x))
    ;;;Horizontal line: length x, from p0
    ;;;-------------------------------------------------------------------------------
    (defun linePY (p0 y) (lineP p0 90 y))
    ;;;Vertical line: length y, from p0
    ;;;-------------------------------------------------------------------------------
    (defun getVert (e / i L)
    ;;;Return list of all vertex from pline e
      (setq   i 0
       L nil
      )
      (vl-load-com)
      (repeat (fix (+ (vlax-curve-getEndParam e) 1))
        (setq L (append L (list (vlax-curve-getPointAtParam e i))))
        (setq i (1+ i))
      )
      L
    )

    ;;; First point of List rearrangement
    (defun relist(pt0 Lst / i rt)
      (setq i 0)
      (foreach pt Lst
        (if (equal pt0 pt 0.001)
          (setq rt i))
        (setq i (1+ i)))
      (append (append (member (nth rt Lst) Lst)
           (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
         (list (nth rt Lst)))
    )

    ;;;New Layer
    (defun newlayer(a b c d)
        (if (not (tblsearch "layer" a))
          (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
    )
    ;;;-------------------------------------------------------------------------------
    (defun wtxtMC (txt p h k)
    ;;;Write text Middle Center, specify text, point, height
      (entmake (list (cons 0 "TEXT")
           (cons 7 (getvar "textstyle"))
           (cons 1 txt)
           (cons 10 p)
           (cons 11 p)
           (cons 40 h)
           (cons 72 1)
           (cons 73 2)
           (if k (cons 51 (DTR 18)) (cons 51 0))
         )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect (e / e2 SS)
    ;;;Selection set from e to entlast
      (setq SS (ssadd))
      (ssadd e SS)
      (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
      SS
    )
    ;;;-------------------------------------------------------------------------------
    (defun Collect1   (e / ss)
    ;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
      (if (= e nil)
        (setq ss (collect (entnext)))
        (progn (setq ss (collect e)) (ssdel e ss))
      )
    )
    ;;;-------------------------------------------------------------------------------

    ;;;PRIVATE FUNCTIONS
    ;;;-------------------------------------------------------------------------------
    (defun txt1 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun txt2 (txtL / p1 p2 p3 p4 pL i)
    ;;;Write texts in 1 row
      (setq
        p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
        p2 (polar p1 0 (* 7 h))
        p3 (polar p2 0 (* 10 h))
        p4 (polar p3 0 (* 9 h))
        p4 (polar p4 (* 0.5 pi) h)
        pL (list p1 p2 p3 p4)
        i  0
      )
      (repeat 4
        (wtxtMC (nth i txtL) (nth i pL) h t)
        (setq i (1+ i))
      )
    )
    ;;;-------------------------------------------------------------------------------


    ;;;MAIN PROGRAM
    ;;;-------------------------------------------------------------------------------
    (defun C:td1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
      (setvar "cmdecho" 0)

    ;;;New layer check
      (newlayer "kichthuoc" 7 "continuous" "default")
      (newlayer "stt" 1 "continuous" "default")
      (newlayer "bangtd" 7 "continuous" "default")

    ;;;GET TEXT HEIGHT
      (if (not h0)  (setq h0 1))
      (setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
      (if (not h)  (setq h h0)  (setq h0 h))

    ;;;GET DECIMAL PRECISION
      (if (not ntp0)  (setq ntp0 2))
      (setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
      (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

    ;;;GET CIRCLE RADIUS
      (if (not cr0)  (setq cr0 0.3))
      (setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
      (if cr (setq cr0 cr))
     
    ;;;PICK & BASE POINT
      (initget "Y")
      (setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
     
      (setq oldos (getvar "osmode")
       pdau (getpoint "\nPick diem dau tien (so thu tu = M1) :")) 
     
      (while pdau
        (setq p (getpoint "\nPick 1 diem giua mien kin:")
         pvL nil pvL1 nil)
        (command "boundary" p "")
        (setq et (entlast)
              pvL1 (reverse (getvert et))) 
        (redraw et 3) 
        (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
        (command "erase" et "")
        (setq  p0 p00
              p01  (polar p00 (* 1.5 pi) (* h 3))   
              pvL  (relist pdau pvL1)
              n   (length pvL)
              p02   (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
        ) 
        (setvar "osmode" 0)
    ;;;HEADER
      (setvar "CLAYER" "bangtd")
      (linepx p0 (* 32 h))
      (command "copy" "L" "" "m" p00 p01 p02 "")
      (linepy p0 (- (distance p0 p02)))
      (command "copy" "L" "" "m"  p0
         (list (+ (car p0) (* 4 h)) (cadr p0))
         (list (+ (car p0) (* 14 h)) (cadr p0))
         (list (+ (car p0) (* 24 h)) (cadr p0))
         (list (+ (car p0) (* 32 h)) (cadr p0))
         "")
      (setq Lkqua nil)
      (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
         (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
           (* 1.2 h) nil)
      (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
      (setq Lkqua (append Lkqua (list Lkq)))
      (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

    ;;;MAKE RECORDS
      (setq   j  0
       pt nil)
      (repeat n
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (if   pt
          (setq S (rtos (distance pt pv) 2 ntp))
          (setq S "")
        )
        (setq
          txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
          Lkqua (append Lkqua (list txtL))
        )
        (txt2 txtL)
        (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
        (setq pt pv)
        (setq j (1+ j))
        (if   (= j (- n 1))  (setq j 0))
      )

    ;;;MAKE BLOCK
      (setq ss (collect1 et))
      (setq bn "1")
      (while (tblsearch "block" bn)
        (setq bn (itoa (1+ (atoi bn))))
      )
      (command "block" bn p00 ss "")
      (command "insert" bn p00 "" "" "")

    ;;;WRITE POINT NAME
      (setvar "CLAYER" "stt")
      (setq j 0)
      (repeat (1- n)
        (setq
          pv  (nth j pvL)
          num (itoa (1+ j))
        )
        (wtxtMC num (polar pv 0 h) h t)
        (command "circle" pv cr0)
        (command "hatch" "S" (setq vtron (entlast)) "")
        (command "erase" vtron "")
        (setq j (1+ j))
      )

    ;;;GHI CANH THUA
        (setvar "CLAYER" "kichthuoc")
        (ghicanh) 

    ;;;FINISH
        (savef)
        (setvar "osmode" oldos)
        (setq pdau (getpoint "\nPick diem dau tien (so thu tu =M 1) :"))
      ) 
      (setvar "cmdecho" 1)
      (princ)
    )

    ;;;-------------------------------------------------------------------------------
    (defun savef() 
      (if save
        (progn
          (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
        (vl-filename-base (vl-string-right-trim "" (getvar "dwgname"))) ".txt")) "a"))
          (foreach line Lkqua
       (setq line1 "")
       (foreach it line
         (setq line1 (strcat line1 " " it)))
       (write-line line1 file)
          )
          (close file)
          (princ (strcat "\nDa luu thanh file " tenfile))
        )
      )
    )

    ;;;PHAN BO SUNG CUA elleHCSC
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_TCA (S p a)
    ;;;Entmake text S at p with angle A - Top Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 3)
           )
        )
      )
    )
    ;;;------------------------------------------------------------------------------------
    (defun Text_canh_BCA (S p a)
    ;;;Entmake text S at p with angle A - Bottom Center
      (if (/= p nil)
        (entmake (list
             (cons 0 "TEXT")
             (cons 62 5)
             (cons 10 p)
             (cons 40 h)
             (cons 1 S)
             (cons 50 a)
             (cons 41 0.7)
             (cons 7 (getvar "textstyle"))
             (cons 72 1)
             (cons 11 p)
             (cons 73 1)
           )
        )
      )
    )
    ;;;-------------------------------------------------------------------------------
    (defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
      (setq
        i   0 
        k   (1- (length pvL))
      )
      (repeat k
        (setq
          p1  (nth i pvL)
          p2  (nth (+ i 1) pvL)
          dist (distance p1 p2)
          rad  (angle p1 p2)
          x_mp (* (+ (car p1) (car p2)) 0.5)
          y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
          mp  (list x_mp y_mp)
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
        )
        (if   (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
          (progn
       (setq rad (+ rad pi))
       (Text_canh_TCA (rtos dist 2 2) mp rad)
          )
          (Text_canh_BCA (rtos dist 2 2) mp rad)
        )
        (setq i (1+ i))
      )
      ;; repeat k;
    )
    ;;;--------------------------
    @ro88: lần sau bạn up code thì để trong thẻ [code] nhé
    Đoạn code bạn up mình vẫn dùng bị lỗi, bạn có thể gửi email file lisp cho mình xem nhé. Minh không có nhiều thời gian để nghiên cứu lại từ đầu, thông cảm.


    Chung tay xây dựng nền tảng vững chắc - Cầu đường Online
    Sàn giao dịch bất động sản - Cafe xem phim 3D Đà Nẵng

    Admin
    Admin

    Posts : 362
    Points : 663
    Reputation : 53
    Join date : 17/08/2010
    Age : 32
    Đến từ : Đà Nẵng

    http://nguyentaudn.findtalk.biz

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by ro88 on Fri Dec 10, 2010 5:10 pm

    email của anh là gì vậy .ah mà anh nói nó bị lỗi gì vậy ?

    ro88
    Binh nhất

    1 .Aeanoid
    Posts : 19
    Points : 34
    Reputation : 2
    Join date : 28/09/2010
    Age : 28
    Đến từ : nha trang

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Admin on Fri Dec 10, 2010 9:47 pm

    ro88 đã viết:email của anh là gì vậy .ah mà anh nói nó bị lỗi gì vậy ?
    nguyentaudn@gmail.com - lỗi không xuất được kết quả, mình chưa check lại hết được


    Chung tay xây dựng nền tảng vững chắc - Cầu đường Online
    Sàn giao dịch bất động sản - Cafe xem phim 3D Đà Nẵng

    Admin
    Admin

    Posts : 362
    Points : 663
    Reputation : 53
    Join date : 17/08/2010
    Age : 32
    Đến từ : Đà Nẵng

    http://nguyentaudn.findtalk.biz

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by cauduongqng01 on Wed May 23, 2012 9:52 pm

    Ăn nói tục tĩu không có văn hóa trên diễn đàn. Đề nghị Admin xóa nick

    cauduongqng01
    Binh nhì

    Posts : 10
    Points : 14
    Reputation : 0
    Join date : 07/03/2011

    Về Đầu Trang Go down

    NewPost Re: CÀI LISP TRONG CAD 2007

    Bài gửi by Sponsored content Today at 2:49 am


    Sponsored content


    Về Đầu Trang Go down

    Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang

    - Similar topics

     
    Permissions in this forum:
    Bạn không có quyền trả lời bài viết