Viết Lisp theo yêu cầu

[Tue_NV 3916]

Tue_NV viết trong trường hợp tổng quát :

Khi chạy Lisp hỏi :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)

So ki tu can bo bot : (2)

 

trong trường hợp của HoangSon thì :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3

So ki tu can bo bot : 1

Tue có thể bổ xung them tính năng thêm kí tự và thai đổi kí tự dưạ trên lisp bạn mới tạo không đôi lúc cũng rất cần thiết đó. :s_big:

Đã có viết Lisp này rồi. Nó ở đây :

Bài viết số 39

[xuandao0708 9]

Cái hình trong file mau_2.dwg là hình 3d và có elevation khác 0, hình đó khi lấy boundary sẽ báo lỗi nên ct chạy ko đc.

Còn hình trong file mẫu trước các đg ranh là line thì chạy ok.

Vậy trong thực tế thì bạn dùng line hay pline2d hay pline3d?

 

Xin lỗi Bác q288 tại file em đưa lên làm mẫu là file bên chủ đầu tư đưa cho em, em chưa đưa Z về 0. Em làm bên trắc địa thì ranh thửa đất thường là đường line hay cùng lắm là pline thôi. Thank Bác q228 nhiều, hi vọng lần sau nhận được lời nhắn của Bác là chạy lisp thửa đi bạn ơi. :s_big:

[q288 166]

Xin lỗi Bác q288 tại file em đưa lên làm mẫu là file bên chủ đầu tư đưa cho em, em chưa đưa Z về 0. Em làm bên trắc địa thì ranh thửa đất thường là đường line hay cùng lắm là pline thôi. Thank Bác q228 nhiều, hi vọng lần sau nhận được lời nhắn của Bác là chạy lisp thửa đi bạn ơi. :s_big:

 

Nếu vậy bạn dùng cái này. Cái này dùng cho line và pline 2d kín.

Sau khi lập bảng xong, CT hỏi có save ko? nếu ko save thì enter, save thì nhấn Y.

;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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:VC ();/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
 (setvar "cmdecho" 0)

;;;Vertex Co-ordinate
 (newlayer "kichthuoc" 7 "continuous" "default")
 (newlayer "stt" 7 "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 "\nBan kinh vong tron <" (rtos cr0) ">:")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :")
       p (getpoint "\nPick 1 diem giua mien kin:"))
 (command "boundary" p "")
 (setq et (entlast)
       pvL1 (reverse (getvert et)))  
 (redraw et 3)
 (setq
   p00	  (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
   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)))
   oldos (getvar "osmode")
 )
 (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 LIEÄT KEÂ 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" (entlast) "")
   (setq j (1+ j))
 )

;;;GHI CANH THUA
 (setvar "CLAYER" "kichthuoc")
 (ghicanh et)
 (command "erase" et "")

;;;FINISH
 (initget "Y")
 (setq save (getkword "\nLuu file? :"))
 (if save
   (progn
     (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
 (vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "w"))
     (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))
   )
 )
 (setvar "osmode" oldos)
 (setvar "cmdecho" 1)
 (princ)
)
;;;-------------------------------------------------------------------------------



;;;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 (e / i pvL k p1 p2 dist rad x_mp y_mp mp)
 (setq
   i	0
   pvL	(reverse (getvert e))
   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;
)
;;;--------------------------

[xuandao0708 9]

Thank Bác q288 nhiều, em text liền. Thank lần nữa.

[xuandao0708 9]

Bác q288 ơi, mấy phần khác thì quá tuyệt rồi, nhưng phần save thì em chưa thấy nó cho thồng báo save lại, nhờ Bác coi lại dùm em 1 ít. Thank Bác nhiều.

[q288 166]

Bác q288 ơi, mấy phần khác thì quá tuyệt rồi, nhưng phần save thì em chưa thấy nó cho thồng báo save lại, nhờ Bác coi lại dùm em 1 ít. Thank Bác nhiều.

 

Chắc tại mình để ở cuối ct nên bạn không để ý.

Sau khi nhấp chọn điểm theo câu "Diem chuan bang toa do (phia tren ben trai):"

Bạn sẽ thấy thêm câu "Luu file? :"

nếu muốn lưu thì Y, ko thì enter.

[vnp84055 0]

Có bạn nào có lisp đo đường gấp khúc bằng đường thẳng không gởi lên giúp mình đi, mình tìm mà không thấy.

Mình muốn dùng lệnh DIST nhưng không phải đo khoảng cách theo 2 điểm đó mà mình muốn nó tính theo tổng khoảng cách theo trục x và y, giống như đo tổng chiều dài 2 cạnh của tam giác vuông, chỉ cần chọn 2 điểm đầu và cuối của cạnh huyền thôi.

Ai có hay viết được giúp mình đi. Thanks.

[Tue_NV 3916]

Có bạn nào có lisp đo đường gấp khúc bằng đường thẳng không gởi lên giúp mình đi, mình tìm mà không thấy.

Mình muốn dùng lệnh DIST nhưng không phải đo khoảng cách theo 2 điểm đó mà mình muốn nó tính theo tổng khoảng cách theo trục x và y, giống như đo tổng chiều dài 2 cạnh của tam giác vuông, chỉ cần chọn 2 điểm đầu và cuối của cạnh huyền thôi.

Ai có hay viết được giúp mình đi. Thanks.

Lisp này Tue_NV đã viết rồi

Đường gấp khúc đó vẽ bằng lệnh Pline phải không bạn?

Nếu đường gấp khúc vẽ bằng Line thì bạn dùng lệnh PE để chuyển nó về Polyline

và sử dụng Code sau sẽ tính được chiều dài của nó theo ý của bạn

Bạn đọc bài viết này :

Bai viet so 2

Khi chay Lisp yêu cầu chon Pline

- Chon diem dau của duong pline

- Chon diem cuoi của duong pline

-> Lisp sẽ tính chiều dài đoạn gấp khúc từ điểm đầu đến điểm cuối cho bạn

Sử dụng Lisp này có thể đo một đoạn của Line, Pline, Arc, Circle, Spline, elipse

Chúc vui :s_big:

[vnp84055 0]

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.

[Tue_NV 3916]

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.

Bạn hãy upload file lên đây và nói rõ ràng nhé.

Chưa hiểu ý bạn lắm

Đường gấp khúc bạn vẽ bằng dối tượng nào?

Dữ liệu đầu vào -> Xử lý -> Dữ liệu đầu ra

Kích thước đi như thế nào? Kiểu kích thước......

Bạn trình bày rõ ràng nhé.

[gia_bach 1558]

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.

Chào vnp84055

Thử LISP này xem có đúng ý bạn chưa?

(defun c:xy(/ pt1 pt2 deltaX deltaY)
 (setq pt1 (getpoint "\nDiem dau:")
       pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))	
 )
 (princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
 (princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
 (princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
 (princ)
)

[vnp84055 0]

Thật ra thì cũng không có gì cần phải upload file lên. Để mình nói cho dể hiểu:

Ví dụ cần đo khoảng cách giũa 2 điểm: từ (0;0) đến điểm (50;100), thay vào dùng lệnh DIST thì khoảng cách của nó là 111,8; nhưng ở đây mình muốn kết quả của lệnh này = chiều dài theo trục x + chiều dài theo trục y = 50 + 100 = 150, nghĩa là đo theo hai đoạn line đi vuông góc với nhau.

 

Với lại mình muốn theo 1 lisp nữa là mình vẽ 1 đường pline 3 điểm nhưng chỉ cần chọn 2 điểm đầu và cuối thôi.

 

Hình minh họa: gõ lệnh, chọn điểm 1, chọn điểm 3 >> kết quả được như hình. (lệnh đo như trên sẽ tính theo đoạn 1-2 cộng đoạn 2-3)

 

 

[vnp84055 0]

Chào vnp84055

Thử LISP này xem có đúng ý bạn chưa?

(defun c:xy(/ pt1 pt2 deltaX deltaY)
 (setq pt1 (getpoint "\nDiem dau:")
       pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))	
 )
 (princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
 (princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
 (princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
 (princ)
)

 

@gia_bach: thanks. Đúng theo ý mình rùi.

Bạn giúp mình viết thêm lệnh là khi mình chọn điểm đầu, điểm cuối như vậy nó sẽ vẽ ra đường pline theo trục x và y + hiển thị kích thước đoạn pline đó luôn được không? (layer theo hiện hành). Giốnh như hình mình upload phía trên đó, chỉ cần chọn điểm 1 & 3, nó sẽ vẽ cho mình đoạn pline như hình.

Giúp mình đi.

[xuandao0708 9]

Chắc tại mình để ở cuối ct nên bạn không để ý.

Sau khi nhấp chọn điểm theo câu "Diem chuan bang toa do (phia tren ben trai):"

Bạn sẽ thấy thêm câu "Luu file? :"

nếu muốn lưu thì Y, ko thì enter.

Nhờ Bác coi lại dùm em chút, em đã chạy thử trên cad khi có những lisp của em chạy song song với lisp VC và khi cad chạy không có lisp của em mà chỉ có lisp CV thôi thì không thấy Báo phần < lưu file > như Bác đã nói, vô lisp thì em có thấy phần < lưu file >. Vậy nhờ Bác q288 coi lại dùm em 1 chút xíu nữa nha.

Câu lệnh cad khi chạy lệnh lisp VC 2 lần thì báo lội như sau:

----Command: vc

Chon chieu cao text <1.0000>:

So chu so thap phan <2>:

Ban kinh vong tron <0.3000>:

Pick diem dau tien (so thu tu = 1) :

Pick 1 diem giua mien kin:

Diem chuan bang toa do (phia tren ben trai):; error: too many arguments

------------------Thank Bác q288 nhiều, không biết Bác có ở TP.HCM ko, nếu có thì em xin mời Bác 1 chầu Cafe được ko? :s_big:

[gia_bach 1558]

@gia_bach: thanks. Đúng theo ý mình rùi.

Bạn giúp mình viết thêm lệnh là khi mình chọn điểm đầu, điểm cuối như vậy nó sẽ vẽ ra đường pline theo trục x và y + hiển thị kích thước đoạn pline đó luôn được không? (layer theo hiện hành). Giốnh như hình mình upload phía trên đó, chỉ cần chọn điểm 1 & 3, nó sẽ vẽ cho mình đoạn pline như hình.

Giúp mình đi.

Chào vnp84055

LISP XY không khác lệnh dist cua CAD ?

Gửi bạn LISP vẽ PLINE

(defun c:PLxy(/ pt1 pt2 deltaX deltaY lst-pt2d)
 (defun makeLWPolyline(lst-pt)
   (entmakex
     (apply
(function append)
(cons
  (list
    '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    '(62 . 3) ; color
    (cons 90 (length lst-pt))
    '(70 . 0)
    )
  (mapcar
    (function list)
    (mapcar (function (lambda (a) (cons 10 a))) lst-pt)
    ) ;_  mapcar
  ) ;_  cons
) ;_  apply
     )
   )

 (setq pt1 (getpoint "\nDiem dau:")
       pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))
lst-pt2d (list pt1 (list (car pt2) (cadr pt1) '0) pt2)
)
 (makeLWPolyline lst-pt2d)
 (princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
 (princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
 (princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
 (princ)
)

[vnp84055 0]

@gia_bach: bạn xem lại lisp thử, mình sử dụng nhưng nó không vẽ được đường pline, chỉ hiện kích thước đoạn pline đó thôi.

- Thứ 2: lệnh xy là đúng với ý mình, nó khác với lệnh dist mà (trong đoạn flash ở đưới bạn sẽ thấy lệnh DIST = 149.32, còn lệnh xy = 204.58, đó đúng bằng chiều dài pline = 204.58)

Flash: http://vnp84055.googlepages.com/thu.swf

or: http://www.cadviet.com/upfiles/Lisp_plxy_khong_dung_dc.swf

 

Bạn sửa lại lệnh plxy giúp mình đi, với lại mình thấy khi đánh lệnh xy thì nó bị một dòng command trắng phía dưới (nó hiện tới 2 dòng command trắng luôn) (phải kéo dòng command rộng lên mới thấy được), mình muốn nó hiện dòng "Tổng khoảng cách theo trục xy ngay dòng trên luôn, bạn giúp mình luôn được chứ?

 

[q288 166]

Nhờ Bác coi lại dùm em chút, em đã chạy thử trên cad khi có những lisp của em chạy song song với lisp VC và khi cad chạy không có lisp của em mà chỉ có lisp CV thôi thì không thấy Báo phần < lưu file > như Bác đã nói, vô lisp thì em có thấy phần < lưu file >. Vậy nhờ Bác q288 coi lại dùm em 1 chút xíu nữa nha.

Câu lệnh cad khi chạy lệnh lisp VC 2 lần thì báo lội như sau:

----Command: vc

Chon chieu cao text <1.0000>:

So chu so thap phan <2>:

Ban kinh vong tron <0.3000>:

Pick diem dau tien (so thu tu = 1) :

Pick 1 diem giua mien kin:

Diem chuan bang toa do (phia tren ben trai):; error: too many arguments

------------------Thank Bác q288 nhiều, không biết Bác có ở TP.HCM ko, nếu có thì em xin mời Bác 1 chầu Cafe được ko? :s_big:

 

Mình hiểu tại sao bị lỗi rồi, vì thú thật cái lisp ban đầu là của bác ssg, mình chỉ sửa lại sơ sơ theo yêu cầu của bạn.

Nhưng vì thay đổi nhiều mà các hàm của bác ssg lại đụng với ct theo yêu cầu mới nên nhân đây cũng xin phép bác ssg cho

mình đổi các hàm của bác nhé.

 

Bạn chép lại ct sau.

 

;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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:VC (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
 (setvar "cmdecho" 0)

;;;Vertex Co-ordinate
 (newlayer "kichthuoc" 7 "continuous" "default")
 (newlayer "stt" 7 "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 "\nBan kinh vong tron <" (rtos cr0) ">:")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :")
       p (getpoint "\nPick 1 diem giua mien kin:"))
 (command "boundary" p "")
 (setq et (entlast)
       pvL1 (reverse (getvert et)))  
 (redraw et 3)

 (setq p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):"))
 (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)))
   oldos (getvar "osmode")
 )
 (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 LIEÄT KEÂ 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" (entlast) "")
   (setq j (1+ j))
 )

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

;;;FINISH
 (savef)
 (setvar "osmode" oldos)
 (setvar "cmdecho" 1)
 (princ)
)
;;;-------------------------------------------------------------------------------
(defun savef()
 (initget "Y")
 (setq save (getkword "\nLuu file? < Y / Enter for No >:"))
 (if save
   (progn
     (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
 (vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "w"))
     (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;
)
;;;--------------------------

[gia_bach 1558]

@gia_bach: bạn xem lại lisp thử, mình sử dụng nhưng nó không vẽ được đường pline, chỉ hiện kích thước đoạn pline đó thôi.

................................

Bạn sửa lại lệnh plxy giúp mình đi, với lại mình thấy khi đánh lệnh xy thì nó bị một dòng command trắng phía dưới (nó hiện tới 2 dòng command trắng luôn) (phải kéo dòng command rộng lên mới thấy được), mình muốn nó hiện dòng "Tổng khoảng cách theo trục xy ngay dòng trên luôn, bạn giúp mình luôn được chứ?

.............

Chào vnp84055

1. mình sử dụng nhưng nó không vẽ được đường pline, chỉ hiện kích thước đoạn pline đó thôi.

-> Plxy chạy tốt trên CAD04, không rõ trên các version khác thì sao?

 

2. khi đánh lệnh xy thì nó bị một dòng command trắng phía dưới....

ý bạn là bỏ dòng command trắng này ?

-> điều này là không thể. không biết các cao thủ có cách nào khác không?

 

Cập nhật lại LISP : PLxy

(defun c:PLxy(/ vl ov pt1 pt2 deltaX deltaY lst-pt2d)
 (defun makeLWPolyline(lst-pt)
   (entmakex
     (apply
(function append)
(cons
  (list
    '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    '(62 . 3) ; color
    (cons 90 (length lst-pt))
    '(70 . 0)
    )
  (mapcar
    (function list)
    (mapcar (function (lambda (a) (cons 10 a))) lst-pt)
    ) ;_  mapcar
  ) ;_  cons
) ;_  apply
     )
   )

 (setq pt1 (getpoint "\nDiem dau:")
       pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))
lst-pt2d (list pt1 (list (car pt2) (cadr pt1) '0) pt2)
)
 (setq vl '("CMDECHO" "OSMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
 (mapcar 'setvar vl '(0 0)) ; Set new values
 (makeLWPolyline lst-pt2d)
 (princ  (strcat "\n Delta X = " (rtos deltaX) "; Delta Y = " (rtos deltaY) "; Total (X,Y) = " (rtos (+ (abs deltaX) (abs deltaY)))) )
 (mapcar 'setvar vl ov)
 (princ)
)

[vnp84055 0]

@gia_bach: thanks. Lisp lúc nãy của bạn không chạy được. Giờ được rùi, cảm ơn nhiều. Còn cái dòng trắng kia mình muốn bỏ trong nhiều lisp lắm mà không được, cứ phải kéo dòng command thêm 1 dòng nữa mới thấy được. Hổng biết có ai sửa được không!

[ssg 1104]

Mình hiểu tại sao bị lỗi rồi, vì thú thật cái lisp ban đầu là của bác ssg, mình chỉ sửa lại sơ sơ theo yêu cầu của bạn.

Nhưng vì thay đổi nhiều mà các hàm của bác ssg lại đụng với ct theo yêu cầu mới nên nhân đây cũng xin phép bác ssg cho

mình đổi các hàm của bác nhé...

Người nhà cả, không cần khách sáo đâu bạn! Hơn nữa, đã là "free lisp" thì mặc nhiên nó tuân theo công ước về GPL (General Public License):

 

With GPL, every user should have:

• the freedom to use the software for any purpose,

• the freedom to change the software to suit your needs,

• the freedom to share the software with your friends and neighbors, and

• the freedom to share the changes you make.

 

Nói thật tình, ssg còn phải cám ơn bạn vì đã chịu khó xem và sửa giúp. Công việc của ssg hiện đang rất căng, chẳng dám đọc lại code của chính mình nữa, đừng nói đến chuyện sửa!

Cả tháng nay mới vào lại diễn đàn, ssg rất vui vì càng ngày càng xuất hiện nhiều bạn "cao thủ" về lisp, rất nhiệt tình với anh em. Xin chân thành cám ơn tất cả các bạn!

Tạm biệt!

[xuandao0708 9]

Thank các Bác rất nhiều, nhờ các Bác mà những nguời mới biết về lisp như em được học hỏi rất nhiều. Riêng về lisp VC sau khi được Bác q288 cải tiến thì chạy rất ok, em không còn chút lăn tăn nào nữa. Một lấn nữa em xin cả mơn các Bác. ( Lệnh này em thấy rất hữu ích cho công việc trắc địa của bọn em.)

[xuandao0708 9]

Nhờ Bác Q288 một chút nữa vì khi chạy lệnh VC nếu 2 thửa cách xa nhau thì không có chuyện gì xảy ra, nhưng nếu 2 thửa có chung một điểm trở lên thì có lỗi xảy ra. Em gởi file lên nhờ Bác ngâm cứu hộ, em đề xuất là sau khi tô hatch trong vòng tròn thì nó sẽ tự xoá đường tròn đó đi, chỉ giử lại hatch để cho nó đúng trong mọi trường hợp. Thank Bác q288 nhiều.

File khi chạy lệnh VC bị lỗi:

http://www.cadviet.com/upfiles/mau_3.dwg

[q288 166]

Nhờ Bác Q288 một chút nữa vì khi chạy lệnh VC nếu 2 thửa cách xa nhau thì không có chuyện gì xảy ra, nhưng nếu 2 thửa có chung một điểm trở lên thì có lỗi xảy ra. Em gởi file lên nhờ Bác ngâm cứu hộ, em đề xuất là sau khi tô hatch trong vòng tròn thì nó sẽ tự xoá đường tròn đó đi, chỉ giử lại hatch để cho nó đúng trong mọi trường hợp. Thank Bác q288 nhiều.

File khi chạy lệnh VC bị lỗi:

http://www.cadviet.com/upfiles/mau_3.dwg

 

Mình sửa lại theo yêu cầu mới của bạn, có điều khi có cạnh kề nhau thì chữ sẽ trùng lên nhau

và kích thước sẽ ghi 2 lần. Vì làm nhiều lần nên mình đưa vào vòng lặp để khỏi lập đi lặp lại cái đoạn hỏi

cỡ chữ, bán kính... kể cả hỏi save cũng đưa lên đầu ct. nếu có save thì cũng nối tiếp vào file txt (chứ ko

xóa file cũ tạo file mới).

 

;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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:VC (/ 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" 7 "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 "\nBan kinh vong tron <" (rtos cr0) ">:")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (initget "Y")
 (setq save (getkword "\nLuu 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 chuan bang toa do (phia tren ben trai):"))
   (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 LIEÄT KEÂ 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;
)
;;;--------------------------

[xuandao0708 9]

Thank Bác q288 nhiều lắm, sao khi chạy thử lisp Cv thì em đã thấy nó chạy rất ok. Xin cá mơn Bác q288 nhiều.

[conghoan1003 0]

Nhờ bác Tue_NV nâng cấp cái lisp tgtext này lên tí nha, lisp này mình mới thêm được ký tự cách vị trí đầu chứ chưa thêm được cách vị trí cuối. bạn thêm vào giúp nha. Thank!

Chúc mọi người cuối tuần vui vẽ!