Đến nội dung


Hình ảnh
- - - - -

Nhờ Sửa Lips


  • Please log in to reply
11 replies to this topic

#1 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 October 2016 - 12:23 AM

Chào các bác em mới tìm được lips khi kích vào tâm thửa thì lips cho ra tọa độ, và kích thước, bảng kê tọa độ. nhưng lips vẫn chưa tạo được điểm nút tại các đỉnh thửa. Em xin nhờ các bác xem có bác nào thạo về lips xin sửa giúp e như sau

               1. Tạo được điểm nút tại đỉnh thửa

               2. Đổi màu kích thước cạnh từ màu xanh sang màu tím

               3. Ghi diện tích thửa tại tâm thửa có dấu gạch ngang trên diện tích.

Em xin chân cảm ơn. đây là lisp và mẫu cần sửa mong các bác hết sức giúp đỡ

- Em mới viết bài đính kèm tệp tin không được. Làm phiền Các bác dowload lips theo link này xuống giúp em nhé

http://www.cadviet.c..._vc.lsp&w=38085


  • 0

#2 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 October 2016 - 06:55 AM

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...opic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 
 
;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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)
;;;Vertex Co-ordinate
 
;;;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))
 
;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
n (length pvL)
p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)
 
;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
""
)
 
(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
    (setq j (1+ j))
)
 
;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")
 
;;;FINISH
(setvar "osmode" oldos)
(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 51 (DTR 18))
(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 51 (DTR 18))
(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;
)
;;;--------------------------

  • 0

#3 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 05 October 2016 - 08:07 AM

Điểm nút đỉnh thửa thể hiện bằng đối tượng gì (point, block)?

Tạm thời sửa màu text và tạo point tại đỉnh các việc khác thì chờ người khác nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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)
;;;Vertex Co-ordinate

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

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command "point" pv)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------


  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#4 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 October 2016 - 10:18 AM

 

Điểm nút đỉnh thửa thể hiện bằng đối tượng gì (point, block)?

Tạm thời sửa màu text và tạo point tại đỉnh các việc khác thì chờ người khác nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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)
;;;Vertex Co-ordinate

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

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command "point" pv)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

Cảm ơn bac duy782006 đã giúp đỡ. E muốn cho vòng tròn nhỏ đi = 0.05cm thì phải sủa ở đâu vậy bác. Tiện bác cho e hỏi e muốn ghi tọa độ và kích thước vẫn như trên nhưng e muốn píck vào poline khép kín chứ không pick vào tâm thửa có được không vậy bác . 


  • -1

#5 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 05 October 2016 - 10:50 AM

-Đối tượng tạo tại đỉnh là point. Bạn nói vòng tròn thì mình đoán mò là cái point của bạn chọn có style là vòng tròn. 

-Chỉnh bằng cách: Format => point style nó lên cái bảng bạn chọn bao nhieu thì chọn. Lưu ý trong đó có 2 lựa chọn tính theo tỉ lệ màn hình và tính theo đơn vị bản vẽ. Bạn chọn đơn vị bản vẻ. nhớ regen.

-Muốn cái gì thì nói 1 lần người viết và chỉnh lisp ghét nhất cái vụ à quên và thêm 1 mớ lắm


  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#6 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 October 2016 - 01:27 PM

-Đối tượng tạo tại đỉnh là point. Bạn nói vòng tròn thì mình đoán mò là cái point của bạn chọn có style là vòng tròn. 

-Chỉnh bằng cách: Format => point style nó lên cái bảng bạn chọn bao nhieu thì chọn. Lưu ý trong đó có 2 lựa chọn tính theo tỉ lệ màn hình và tính theo đơn vị bản vẽ. Bạn chọn đơn vị bản vẻ. nhớ regen.

-Muốn cái gì thì nói 1 lần người viết và chỉnh lisp ghét nhất cái vụ à quên và thêm 1 mớ lắmXin lỗi 

Xin lỗi bác nhé. Do mình mới vào viết bài lần đầu nên không thạo lắm, làm phiền bác nhiều quá. Lúc đầu mình cũng không hiểu point là gì. thấy bác nói vậy mình mới biết. nếu điểm nút là Point thì khi mình trút số liệu từ máy toàn đạc và dải điểm vẽ thì sẽ trùng với point của mình. mình chỉ cần có 1 điểm nút là 1 vòng tròn C có bán kính = 1cm cố định không cần tỷ lệ vòng tròn mong bác thông cảm và giúp đỡ


  • 0

#7 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 05 October 2016 - 01:52 PM

Sửa lại cho phép bạn chọn bán kính vòng tròn nút.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------


  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#8 Kieu Tan

Kieu Tan

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -23 (kém)

Đã gửi 05 October 2016 - 08:42 PM

 

Sửa lại cho phép bạn chọn bán kính vòng tròn nút.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

Hình như bị ngược tọa độ giữa X và Y thì phải ?


  • 0

#9 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 October 2016 - 09:25 PM

 

Sửa lại cho phép bạn chọn bán kính vòng tròn nút.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

 

 

Sửa lại cho phép bạn chọn bán kính vòng tròn nút.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

Bác duy782006 sửa như vậy là đúng như vậy rất đúng ý của em rồi. rất cảm ơn bác. em còn ước nguyện cuối cùng cho mục đích khác( bác giúp e giúp cho chót bác nhé) bác sửa giúp e vẫn như trên nhưng kick vào poline khép kín cho ra kích thước tọa độ điểm nút đúng như ở trên. Thank Bác


  • 0

#10 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 06 October 2016 - 04:50 AM

Đã thêm lựa chọn pick điểm hay chọn đối tượng. Không biết lỗi chổ nào mà bảng kê và pline bị dính chùm. Mình đang cày 30/10 nên tạm gác lại đã khi nào rỗi hoặc bác nào rỗi thì xem giúp cho bạn nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/166158-nho-sua-lips/
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))






;;;PICK & BASE POINT


  (initget 1 "P S ")
  (setq ob (getkword "\nChon khu dat bang cach [Pick diem trong mien/ Select pline]: "))
  (cond
    ((= ob "P")
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
     )
    ((= ob "S")
(setq et (car (duy:c_dtuong<mtvdt "LWPOLYLINE" "can thong ke")))
(command ".copy" et "" "_non" (list 0 0) "_non" (list 0 0) "")
     )
    )


(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

;duy82006 them phan chon pline
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chon mot doi tuong theo kieu
;;;Cu phap su dung (duy:c_dtuong<mtvdt kieu mdich)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:c_dtuong<mtvdt (kieu mdich / kieu mdich dchon)
(princ (strcat "\nChon " kieu mdich " !"))
(setq dchon (entsel))
(while
(or
(null (car dchon))
(and (/= kieu (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ (strcat "\nChon doi tuong khong thanh cong. Chon doi tuong " kieu mdich " !"))
(setq dchon (entsel))
)
dchon)



  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#11 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 06 October 2016 - 06:37 AM

 

Đã thêm lựa chọn pick điểm hay chọn đối tượng. Không biết lỗi chổ nào mà bảng kê và pline bị dính chùm. Mình đang cày 30/10 nên tạm gác lại đã khi nào rỗi hoặc bác nào rỗi thì xem giúp cho bạn nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/166158-nho-sua-lips/
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))






;;;PICK & BASE POINT


  (initget 1 "P S ")
  (setq ob (getkword "\nChon khu dat bang cach [Pick diem trong mien/ Select pline]: "))
  (cond
    ((= ob "P")
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
     )
    ((= ob "S")
(setq et (car (duy:c_dtuong<mtvdt "LWPOLYLINE" "can thong ke")))
(command ".copy" et "" "_non" (list 0 0) "_non" (list 0 0) "")
     )
    )


(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

;duy82006 them phan chon pline
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chon mot doi tuong theo kieu
;;;Cu phap su dung (duy:c_dtuong<mtvdt kieu mdich)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:c_dtuong<mtvdt (kieu mdich / kieu mdich dchon)
(princ (strcat "\nChon " kieu mdich " !"))
(setq dchon (entsel))
(while
(or
(null (car dchon))
(and (/= kieu (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ (strcat "\nChon doi tuong khong thanh cong. Chon doi tuong " kieu mdich " !"))
(setq dchon (entsel))
)
dchon)


Rất cảm ơn bác 1 lần nữa lại đúng ý của em.Chúc bác luôn mạnh khỏe thành công, hạnh phúc và tràn đầy năng lượng trong cuộc sống.


  • 0

#12 kyan

kyan

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 10 October 2016 - 11:05 PM

Rất cảm ơn bác 1 lần nữa lại đúng ý của em.Chúc bác luôn mạnh khỏe thành công, hạnh phúc và tràn đầy năng lượng trong cuộc sống.

 

 

Đã thêm lựa chọn pick điểm hay chọn đối tượng. Không biết lỗi chổ nào mà bảng kê và pline bị dính chùm. Mình đang cày 30/10 nên tạm gác lại đã khi nào rỗi hoặc bác nào rỗi thì xem giúp cho bạn nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/166158-nho-sua-lips/
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2265&st=60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;WELCOME TO NEW YEAR 2009
;;;WISH ALL CADVIET MEMBERS AND FAMILY
;;;HAVE HAPPY, HEALTH AND PROSPEROUS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (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 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 10 h))
	p4 (polar p4 (* 0.5 pi) (* 1.5 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 4
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 ra0 pt pvL n j pv num txtL ss bn ntp)
;;;Vertex Co-ordinate

;;;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 RADIUS 
(if (not ra0) (setq ra0 0.1))
(setq hr (getreal (strcat "\nChon ban kinh nut dinh ranh <" (rtos ra0) ">:")))
(if (not hr) (setq hr ra0) (setq ra0 hr))






;;;PICK & BASE POINT


  (initget 1 "P S ")
  (setq ob (getkword "\nChon khu dat bang cach [Pick diem trong mien/ Select pline]: "))
  (cond
    ((= ob "P")
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
     )
    ((= ob "S")
(setq et (car (duy:c_dtuong<mtvdt "LWPOLYLINE" "can thong ke")))
(command ".copy" et "" "_non" (list 0 0) "_non" (list 0 0) "")
     )
    )


(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 (reverse (getvert et))
	n (length pvL)
	p02 (polar p01 (* 1.5 pi) (* n h 3))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
    (list(+ (car p0) (* 4 h)) (cadr p0))
	(list(+ (car p0) (* 16 h)) (cadr p0))
    (list(+ (car p0) (* 28 h)) (cadr p0))
    (list(+ (car p0) (* 38 h)) (cadr p0))
	""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
    (txt2 txtL)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
(command ".circle" pv hr)
    (setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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 6)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 51 (DTR 18))
(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;
)
;;;--------------------------

;duy82006 them phan chon pline
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chon mot doi tuong theo kieu
;;;Cu phap su dung (duy:c_dtuong<mtvdt kieu mdich)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:c_dtuong<mtvdt (kieu mdich / kieu mdich dchon)
(princ (strcat "\nChon " kieu mdich " !"))
(setq dchon (entsel))
(while
(or
(null (car dchon))
(and (/= kieu (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ (strcat "\nChon doi tuong khong thanh cong. Chon doi tuong " kieu mdich " !"))
(setq dchon (entsel))
)
dchon)


Chào bác duy782006 do công việc đòi hỏi, e lại làm viền bác một lát bác có thể sửa lại giúp e sao cho khi kick vào đường polyline thì các điểm tại các đỉnh được đánh số thứ tự theo chiều kim đồng hồ được không bác. thank bác mong được bác giúp đỡ


  • 0