CÀI LISP TRONG CAD 2007

Code:


(defun c:f3 ()
  (setvar "osmode" 131)
  (princ)
  )


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


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

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


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.

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


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)

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é

ro88 đã viết:email của anh là gì vậy .ah mà anh nói nó bị lỗi gì vậy ?