Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#2241 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 02:07 PM

@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:
or:

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ứ?

Hình đã gửi
  • 0

#2242 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 26 June 2009 - 02:36 PM

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


  • 3

#2243 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 26 June 2009 - 03:11 PM

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

  • 2

#2244 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 03:25 PM

@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!
  • 0

#2245 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 26 June 2009 - 03:39 PM

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!
  • 2

#2246 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 26 June 2009 - 03:54 PM

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.)
  • 0

#2247 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 26 June 2009 - 04:33 PM

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.c...files/mau_3.dwg
  • 0

#2248 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 26 June 2009 - 06:42 PM

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.c...files/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;
)
;;;--------------------------


  • 1

#2249 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 27 June 2009 - 11:34 AM

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.
  • 0

#2250 conghoan1003

conghoan1003

    biết vẽ point

  • Members
  • PipPip
  • 99 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 June 2009 - 12:14 PM

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ẽ!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2251 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 28 June 2009 - 03:50 PM

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 :cheers:

Chào bạn Tue_NV! Nhờ bạn sửa giúp mình đoạn lisp này với.
Khi gỏ GHC: hỏi
Chọn điểm thứ 1
Chọn điểm thứ 2
Tên cọc
OK. Cảm ơn bạn
(Bỏ qua câu lệnh hỏi đường kính đường tròn (chỉ cần định giá trị đường kính vòng tròn trước là được))
Lisp đây bạn:
(defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
)
(defun Reinit()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 1)
)
;--------------------------------
;;Doi goc ra radian
(defun doi (a)
(* PI (/ a 180))
)
;--------------------------------
;;Doi goc ra radiando
(defun doi2 (d)
(* 180 (/ d pi))
)
;---------------------------------
;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI
;;ONAP ENDP INT(MID) NEAR
(defun onap ()
(setvar "OSMODE" (+ 1 32 512))
)
;;;;ONAP ENDP INT(MID) CEN
(defun onap1 ()
(setvar "OSMODE" (+ 1 4 32))
)
;;;
;;;;ONAP ENDP INT(MID) CEN
(defun onap2 ()
(setvar "OSMODE" (+ 1 2 4 16 32 128 512))
)
;;;;;;
(defun ofnap ()
(command "-OSNAP" "OFF" "" )
)
;---------------------------------

;===========================
(defun C:GCH ()
(command
"-OSNAP" "OFF" ""
"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""
"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
)
; (setq
; Pt1 (getpoint "\nChon diem dau tien :")
; x (car Pt1)
; y (cadr Pt1)
(setq AnserCK "Co")
; )
;------------------------------
(While (= AnserCK "Co")
(initget "Co Khong")
(setq AnserCK (getkword "\nCo tiep tuc khong :"))
(if (= AnserCK "Co")
(progn (onap)
(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1)
)
(setq
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis (getdist "\nDuong kinh vong tron:")
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap)
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
)
)
)
)
(Reinit)
)
  • 0

#2252 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 June 2009 - 08:14 PM

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ẽ!

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :
http://www.cadviet.c...amp;#entry65704

Chào bạn Tue_NV! Nhờ bạn sửa giúp mình đoạn lisp này với.
Khi gỏ GHC: hỏi
Chọn điểm thứ 1
Chọn điểm thứ 2
Tên cọc
OK. Cảm ơn bạn
(Bỏ qua câu lệnh hỏi đường kính đường tròn (chỉ cần định giá trị đường kính vòng tròn trước là được))

Chào HoangSon
Ch­­ưa hiểu ý của bạn muốn nói gì?
Bạn viết gì thì phải cho người khác hiểu thì mới giúp bạn được
Hãy nói rõ ràng ra và cần thiết kèm theo file .dwg minh hoạ nếu có thể
Chúc vui :s_big:
  • 1

#2253 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 29 June 2009 - 08:40 AM

Trích dẫn(conghoan1003 @ Jun 28 2009, 12:14) *
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.
Mình kiếm được trên diễn dàn ( nếu kô lầm thì cái lisp này của Bác Duy782006) cái lisp này, không biết có đúng theo yêu cầu của bạn kô nhưng nó có thề cho minh thêm chuỗi ký tự vào đầu và cuối những đối tượng text đuợc chọn. Tên lệnh là :themtext

;Dung de them chuoi ky tu vao Truoc_Sau chuoi ky tu duoc chon
(defun c:THEMTEXT (/ c e ss txt cmde ttdangs ttdangt)
(command "undo" "be")
(setq cmde (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ttdangt (getstring 5"\nChuoi muon them phia truoc:"))
(setq ttdangs (getstring 5"\nChuoi muon them phia sau:"))
(if (null ttdangt)(setq ttdangt ""))
(if (null ttdangs)(setq ttdangs ""))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
; Ensure entity is text
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt (strcat ttdangt (cdr (assoc 1 e)) ttdangs))
(setq e (subst (cons 1 txt) (assoc 1 e) e))
(entmod e)
)
)
(setq c (1+ c)) ; Increment counter.
(setq e (ssname ss c)) ; Obtain next entity.
)
(setvar "CMDECHO" cmde)
(command "undo" "end")
(Prin I)
)
(defun c:BOTTEXT (/ c e ss txt cmde tbdangs tbdangt)
(command "undo" "be")
(setq cmde (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq tbdangt (getreal "\nSo ky tu muon bot phia truoc:"))
(setq tbdangs (getreal "\nSo ky tu muon bot phia sau:"))
(if (null tbdangt)(setq tbdangt 0))
(if (null tbdangs)(setq tbdangs 0))
(setq sotru (+ tbdangt tbdangs))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
; Ensure entity is text
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq sochu (strlen (cdr (assoc 1 e))))
(if (> sochu sotru)
(progn
(setq txt (substr (cdr (assoc 1 e)) (fix (+ 1 tbdangt)) (fix (- sochu tbdangt tbdangs))))
(setq e (subst (cons 1 txt) (assoc 1 e) e))
(entmod e)
)
)
)
)
(setq c (1+ c)) ; Increment counter.
(setq e (ssname ss c)) ; Obtain next entity.
)
(setvar "CMDECHO" cmde)
(command "undo" "end")
(Prin I)
)

:s_big:
  • 0

#2254 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 29 June 2009 - 09:29 AM

Trích dẫn(conghoan1003 @ Jun 28 2009, 12:14) *
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.


Tue_NV thật sự không vui khi mình viết bài ra mà bạn chẳng hề chịu đọc :s_big:
Bài viết trả lời của mình ngay trên bài viết của bạn đấy thôi

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ẽ!

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :
http://www.cadviet.c...amp;#entry65704


  • 1

#2255 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 29 June 2009 - 11:20 AM

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :
http://www.cadviet.c...amp;#entry65704
Chào HoangSon
Ch­­ưa hiểu ý của bạn muốn nói gì?
Bạn viết gì thì phải cho người khác hiểu thì mới giúp bạn được
Hãy nói rõ ràng ra và cần thiết kèm theo file .dwg minh hoạ nếu có thể
Chúc vui :cheers:

Chào Tue_NV!
Với đoạn lisp mình gửi trên, mình nhờ bạn sửa lại giúp mình như sau:
Gỏ GCH (Ghi chú cọc)
Mình đã gán giá trị đường kính vòng tròn là 7 nhưng khi chạy lisp cứ hỏi nhập giá trị đường kính, ý mình là khi nhập điểm thứ 1, thứ 2 và tên cọc thì có được text nằm giữa vòng tròn (mình không rành lisp lắm, đoạn lisp trên lỗi chỗ nào? nhờ bạn text và sửa giúp mình). Cảm ơn bạn.
  • 0

#2256 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 29 June 2009 - 01:00 PM

Chào Tue_NV!
Với đoạn lisp mình gửi trên, mình nhờ bạn sửa lại giúp mình như sau:
Gỏ GCH (Ghi chú cọc)
Mình đã gán giá trị đường kính vòng tròn là 7 nhưng khi chạy lisp cứ hỏi nhập giá trị đường kính, ý mình là khi nhập điểm thứ 1, thứ 2 và tên cọc thì có được text nằm giữa vòng tròn (mình không rành lisp lắm, đoạn lisp trên lỗi chỗ nào? nhờ bạn text và sửa giúp mình). Cảm ơn bạn.

Đã sửa lại. HoangSon thử nhé :

(defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
)
;
(defun Reinit()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 1)
)
;--------------------------------
;;Doi goc ra radian
(defun doi (a)
(* PI (/ a 180))
)
;--------------------------------
;;Doi goc ra radiando
(defun doi2 (d)
(* 180 (/ d pi))
)
;---------------------------------
;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI
;;ONAP ENDP INT(MID) NEAR
(defun onap ()
(setvar "OSMODE" (+ 1 32 512))
)
;;;;ONAP ENDP INT(MID) CEN
(defun onap1 ()
(setvar "OSMODE" (+ 1 4 32))
)
;;;
;;;;ONAP ENDP INT(MID) CEN
(defun onap2 ()
(setvar "OSMODE" (+ 1 2 4 16 32 128 512))
)
;;;;;;
(defun ofnap ()
(command "-OSNAP" "OFF" "" )
)
;---------------------------------

;===========================
(defun C:GCH()
(setvar "cmdecho" 0)
(command
"-OSNAP" "OFF" ""
"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""
"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
)

(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1)
)
(setq
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap)
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)


(setq AnserCK "C")

(While (or (= AnserCK "C") (= AnserCK "c"))
(initget "C K")
(setq AnserCK (getkword "\nCo tiep tuc khong ?:"))
(if (or (= AnserCK "C") (= AnserCK "c"))
(progn (onap)
(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1)
)
(setq
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap)
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
)
)
)

(Reinit)
(princ)
)

  • 1

#2257 conghoan1003

conghoan1003

    biết vẽ point

  • Members
  • PipPip
  • 99 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 29 June 2009 - 01:55 PM

Tue_NV thật sự không vui khi mình viết bài ra mà bạn chẳng hề chịu đọc :s_big:
Bài viết trả lời của mình ngay trên bài viết của bạn đấy thôi

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :
http://www.cadviet.c...amp;#entry65704

Xin lỗi Tue_LV nha,
Không phai mình không chịu đọc mà tại hôm post bài mạng báo lỗi mình tưởng là chưa post được nên mới mần lại cái nữa ở chổ này thành ra viết bài hai chỗ luôn!
Cảm ơn Tue nha. lisp chạy tốt lắm!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2258 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 29 June 2009 - 04:56 PM

Đã sửa lại. HoangSon thử nhé :


(defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
)
;
(defun Reinit()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 1)
)
;--------------------------------
;;Doi goc ra radian
(defun doi (a)
(* PI (/ a 180))
)
;--------------------------------
;;Doi goc ra radiando
(defun doi2 (d)
(* 180 (/ d pi))
)
;---------------------------------
;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI
;;ONAP ENDP INT(MID) NEAR
(defun onap ()
(setvar "OSMODE" (+ 1 32 512))
)
;;;;ONAP ENDP INT(MID) CEN
(defun onap1 ()
(setvar "OSMODE" (+ 1 4 32))
)
;;;
;;;;ONAP ENDP INT(MID) CEN
(defun onap2 ()
(setvar "OSMODE" (+ 1 2 4 16 32 128 512))
)
;;;;;;
(defun ofnap ()
(command "-OSNAP" "OFF" "" )
)
;---------------------------------

;===========================
(defun C:GCH()
(setvar "cmdecho" 0)
(command
"-OSNAP" "OFF" ""
"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""
"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
)

(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1)
)
(setq
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap)
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
(setq AnserCK "C")

(While (or (= AnserCK "C") (= AnserCK "c"))
(initget "C K")
(setq AnserCK (getkword "\nCo tiep tuc khong ?:"))
(if (or (= AnserCK "C") (= AnserCK "c"))
(progn (onap)
(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1)
)
(setq
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap)
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
)
)
)

(Reinit)
(princ)
)

Chạy tốt rồi, cảm ơn bạn nhiều.....
  • 0

#2259 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 01 July 2009 - 08:08 AM

Vừa rồi mình có tìm được lisp vẽ tim sông và tim đường trên diễn đàn của mình , lisp chạy rất nhanh và chính xác.
Nhưng gặp trường hợp tại nhánh sông nhỏ ra sông lớn ( chổ ngã ba ) thì lisp thể hiện chưa đúng lắm.
Vậy rất mong được các bạn giúp khắc phục cho lởi trên

  • 0

#2260 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 01 July 2009 - 08:43 AM

Vừa rồi mình có tìm được lisp vẽ tim sông và tim đường trên diễn đàn của mình , lisp chạy rất nhanh và chính xác.
Nhưng gặp trường hợp tại nhánh sông nhỏ ra sông lớn ( chổ ngã ba ) thì lisp thể hiện chưa đúng lắm.
Vậy rất mong được các bạn giúp khắc phục cho lởi trên

Hiện giờ chưa có giải pháp khắc phục, Bạn phải cắt bỏ bờ của nhánh sông nhỏ và tạm thời nối lại bờ sông lớn.
Lúc này thiep không rảnh để chỉnh sửa lisp TIMDUONG cho bạn.
  • 0