Đế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

#1981 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 12 May 2009 - 03:02 PM

Bạn có thể dùng lệnh Pe để chuyển arc thành Pline . Và thêm điểm chia trên Pline (cung arc vừa chuyển) (để Lisp chạy đúng hơn)bằng lệnh Pe hoặc bằng Lisp ở đây :Theem Node vao duong Pline (Đọc Kĩ nhé)



cảm ơn bạn TUE_NV mình đã tìm thấy rồi, cảm ơn sự nhiệt tình của bạn nhiều lắm :mellow:
  • 0

#1982 thiep

thiep

    biết dimbaseline

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

Đã gửi 12 May 2009 - 05:22 PM

chào cả nhà Cadviet, hôm nay lại xin mạn phép nhờ vả các bạn : chả là thế này dạo này mình phải vẽ tim của các con sông trên cad, các con sông này rất là ngoằn ngèo và chiều rộng lòng sông mỗi chỗ một khác (việc ofset là vô dụng), việc tìm tim của nó là rất thủ công và mệt mỏi, mình hi vọng các bạn cho mình 1 lisp (hoặc cách nào đó) có thể tự động tìm tim của sông. biết rằng sông đã được nối thành 1 Pline duy nhất
mình gửi file mẫu đi kèm : (đã chuyển về Cad 2004)

http://www.mediafire...lj0znm5kz/1.dwg

cảm ơn các bạn :mellow:

Chào bạn Khoadung98 va Tue_NV,
Tối qua, mình cũng viết 1 Lisp theo yêu cầu của khoadung98, các bạn dùng thử nhé. Mình thấy có vẻ nó nhanh hơn lisp timsong của Tue_NV, nhưng phải nói 2 lisp này bổ sung nhau mới tốt được. Lisp timsong của Tue_nv có tạo một đường pline ở đầu tim sông, mà điểm đầu và cuối trùng nhau. lệnh là cli
http://www.cadviet.c...es/timduong.lsp
  • 1

#1983 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 13 May 2009 - 09:25 AM

Chào bạn Khoadung98 va Tue_NV,
Tối qua, mình cũng viết 1 Lisp theo yêu cầu của khoadung98, các bạn dùng thử nhé. Mình thấy có vẻ nó nhanh hơn lisp timsong của Tue_NV, nhưng phải nói 2 lisp này bổ sung nhau mới tốt được. Lisp timsong của Tue_nv có tạo một đường pline ở đầu tim sông, mà điểm đầu và cuối trùng nhau. lệnh là cli
http://www.cadviet.c...es/timduong.lsp



mình đã dùng đuợc lisp của bạn, cảm ơn bạn rất nhiều, cảm ơn sự nhiệt tình của các bạn trên CADVIET :mellow:
  • 0

#1984 oanhvang

oanhvang

    biết zoom

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

Đã gửi 13 May 2009 - 02:18 PM

các bạn ơi, cứu mình cái, mình có đc cái lisp ẩn đối tượng theo màu ( lệnh là CINVIS ) mình đã ẩn đi các đối tượng rồi nhưng mà giờ muốn hiện nó ra thì làm thế nào vây ( lisp này kô thấy hướng dẫn hiện ra thế nào huhu lisp ấy đây :



(defun c:CInVis (/ SSet Count Elem)
(defun Dxf (Id Obj)
(cdr (assoc Id (entget Obj)))
) ;end Dxf
(cond
((setq SSet
(ssget
"X"
(filterchondttheomau
(maucuadoituong
(car (entsel "\nHay pick vao doi tuong de chon mau: ")
)
)
)
)
)
(repeat (setq Count (sslength SSet))
(setq Count (1- COunt)
Elem (ssname SSet Count)
)
(if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
(if (Dxf 60 Elem)
(entmod
(subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem))
)
(entmod (append (entget Elem) (list '(60 . 1))))
)
(prompt
"\nEntity on a locked layer. Cannot hide this entity. "
)
) ;end if
) ;end repeat
)
) ;end cond
(princ)
) ;end c:InVis
(defun maucuadoituong (ent)
(setq tt (entget ent)
chon (assoc 62 tt)
)
(cond
(chon (cdr chon))
(t (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 tt))))))
)
)
(defun filterchondttheomau (mau)
(defun chonlayertheomau (mau / kq)
(setq curlay (tblnext "LAYER" t))
(while curlay
(if (= mau (cdr (assoc 62 curlay)))
(setq kq (append kq (list (cdr (assoc 2 curlay)))))
)
(setq curlay (tblnext "LAYER"))
)
kq
)
(setq filterlist
nil
taplayer (chonlayertheomau mau)
)
(foreach pp taplayer
(setq filterlist
(append filterlist
(list (cons -4 " (cons 62 256)
(cons 8 pp)
(cons -4 "AND>")
)
)
)
)
(setq filterlist
(append (list (cons -4 " filterlist
(list (cons -4 "OR>"))
)
)
)
  • 0

#1985 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 13 May 2009 - 02:43 PM

các bạn ơi, cứu mình cái, mình có đc cái lisp ẩn đối tượng theo màu ( lệnh là CINVIS ) mình đã ẩn đi các đối tượng rồi nhưng mà giờ muốn hiện nó ra thì làm thế nào vây ( lisp này kô thấy hướng dẫn hiện ra thế nào huhu lisp ấy đây :

Bạn tải Lisp này về và sử dụng lệnh Vis :
http://www.cadviet.c...p?showtopic=279
Bài viết đầu tiên nhé
  • 0

#1986 oanhvang

oanhvang

    biết zoom

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

Đã gửi 14 May 2009 - 01:47 PM

Bạn tải Lisp này về và sử dụng lệnh Vis :
http://www.cadviet.c...p?showtopic=279
Bài viết đầu tiên nhé



thanks kiu bạn TUE nhé, xim nhờ mọi người kết hợp 2 lisp này vào làm 1 để sử dụng cho tiện được kô vậy :mellow:
  • 0

#1987 xinh75

xinh75

    biết pan

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

Đã gửi 15 May 2009 - 10:37 AM

Mình muốn tạo 1 lisp dùng để đánh số và lập bảng thống kê thép, các bạn giúp mình nhé, mình cũng biết về lisp nhưng lâu không dùng đến . Trình tự như sau
1. Chọn nhãn (label ), số lượng cấu kiện .

VD thống kê cho đà D1 , sẽ có label la D1, số lượng đà d1 : nhập vào là 10


2. Đánh số TT cho thanh thép: vẽ vòng tròn ở giữa có số thứ tự vd: 1

3. Gán dữ liệu cho STT các thanh thép T1,T2,T3,T4

a) Hình dạng và kích thước
T1 thì có kích thước là a
T2 kích thước e,f,e
T3 kích thước b,c,d
T4 kích thước g,h

:mellow:Đường kính mm Vd d14

c) số lượng thanh trong 1 cấu kiện
vd thanh STT là 1 có 15 thanh .

Như vậy kiểu dữ liệu sẽ là nếu là đà d1 , số lượng đà d1 là 10 thanh số 1 loại t1 có a=3000mm đk d=14mm số lượng 15
d1 10 1 3000 14 15


4 Khi đã đánh số xong các loại thanh và nhập xong dữ liệu có thể chọn bảng và lập bảng thống kê

CK STT Đk Số lượng Số lượng Chiều dài 1 thanh Tổng chiều dài Trọng lượng
1 Cấu kiện Toàn bộ mm m kg

D1 1 14 15 150 3000 450 543.6


Mình upload file mẫu của http://www.cadviet.c...files/shape.rar
  • 0

#1988 quocanhxd05

quocanhxd05

    biết vẽ ellipse

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

Đã gửi 15 May 2009 - 04:23 PM

Bạn có thể post yêu cầu về autolisp ở topic này.

Chào các anh,
Tôi muốn nhờ các anh viết dùm một lệnh zoom extents cho tất cả các không gian vẽ (Model, Layout)
Ví dụ :
1/Nhập lệnh
2/chương trình sẽ thực hiện lệnh zoom
3/chọn extents
4/sau đó chuyển sang không gian kế tiếp rồi thực hiện bước 2 và 3 cho đến hết.
Thanks các bác nhìu nhìu !
  • 0
-------------------- Sống ở trên đời cần một chữ NHẪN --------------------

#1989 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 15 May 2009 - 05:19 PM

thanks kiu bạn TUE nhé, xim nhờ mọi người kết hợp 2 lisp này vào làm 1 để sử dụng cho tiện được kô vậy :mellow:

Chào bạn Oanhvang,
Bạn chỉ cần copy nội dung của cả hai cái lisp này vào trong một file *.lsp. Sau đó khi sử dụng bạn tải file đó lên là OK mà. Nhớ chép đầy đủ nội dung file, chớ bỏ sót cái gì.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1990 oanhvang

oanhvang

    biết zoom

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

Đã gửi 15 May 2009 - 05:32 PM

Chào bạn Oanhvang,
Bạn chỉ cần copy nội dung của cả hai cái lisp này vào trong một file *.lsp. Sau đó khi sử dụng bạn tải file đó lên là OK mà. Nhớ chép đầy đủ nội dung file, chớ bỏ sót cái gì.


mình cảm ơn bạn BINH nhé
  • 0

#1991 thuyvan0210

thuyvan0210

    biết zoom

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

Đã gửi 16 May 2009 - 09:27 PM

Tue_NV cũng hơi nóng. Bạn sử dụng đoạn Code kèm theo file bản vẽ mà Tue_NV đã post lại ở bài viết số 1974 "Topic "Viết Lisp theo yêu cầu" và cho mình biết ý kiến sau khi sử dụng thử nhé.
Chào bạn thuyvan0210.
Bạn có thể upload file bản vẽ .dwg và nói rõ hơn ý của bạn được không?

mấy hôm nay chỗ mình mất mạng up file mãi mà ko dc bạn thông cảm nhé. mình xin gửi file cad co luôn đoạn lisp mình hay dùng bên trong. bạn xem nghiên cứu giúp mình với nhá! cảm ơn bạn nhiều!
  • 0

#1992 thuyvan0210

thuyvan0210

    biết zoom

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

Đã gửi 16 May 2009 - 09:28 PM

mấy hôm nay chỗ mình mất mạng up file mãi mà ko dc bạn thông cảm nhé. mình xin gửi file cad co luôn đoạn lisp mình hay dùng bên trong. bạn xem nghiên cứu giúp mình với nhá! cảm ơn bạn nhiều!

LINK FILE VD1
  • 0

#1993 nghiautc

nghiautc

    biết lệnh copy

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

Đã gửi 16 May 2009 - 11:16 PM

LINK FILE VD1

anh Tue NV anh có thể giúp em chỉnh đoạn lisp sau để nó có thể chọn được cả mtext được không bây giờ đoạn lisp này chỉ chọn được với text (đây là đoạn mã chuyển từ TCVN3 về Unicode)
http://www.cadviet.c...les/NGHIA_1.lsp
  • 0

#1994 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 16 May 2009 - 11:41 PM

anh Tue NV anh có thể giúp em chỉnh đoạn lisp sau để nó có thể chọn được cả mtext được không bây giờ đoạn lisp này chỉ chọn được với text (đây là đoạn mã chuyển từ TCVN3 về Unicode)
http://www.cadviet.c...les/NGHIA_1.lsp

Nếu đrr chọn thêm được Mtext thì bạn thay dòng này :
(setq taptext (ssget '((0 . "TEXT"))))
bằng dòng : (setq taptext (ssget '((0 . "TEXT,MTEXT"))))

LINK FILE VD1

Chào bạn thuyvan0210.
Link file của bạn gửi mình không mở được. Bạn xem lại đường Link và gửi lại file nhé.
  • 1

#1995 nghiautc

nghiautc

    biết lệnh copy

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

Đã gửi 17 May 2009 - 01:31 AM

Nếu đrr chọn thêm được Mtext thì bạn thay dòng này :
(setq taptext (ssget '((0 . "TEXT"))))
bằng dòng : (setq taptext (ssget '((0 . "TEXT,MTEXT"))))

CẢM ƠN ANH ĐƯỢC RỒI
  • 0

#1996 thuyvan0210

thuyvan0210

    biết zoom

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

Đã gửi 17 May 2009 - 10:12 AM

Nếu đrr chọn thêm được Mtext thì bạn thay dòng này :
(setq taptext (ssget '((0 . "TEXT"))))
bằng dòng : (setq taptext (ssget '((0 . "TEXT,MTEXT"))))
Chào bạn thuyvan0210.
Link file của bạn gửi mình không mở được. Bạn xem lại đường Link và gửi lại file nhé.

hôm qua mình gửi mà ko kiểm tra lại!
VD1 link đây nhé! Rất cảm ơn bạn vì sự nhiệt tình!
bạn thử nghiên cứu xem có giúp đc mình ko nhé!
  • 0

#1997 thuyvan0210

thuyvan0210

    biết zoom

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

Đã gửi 17 May 2009 - 10:16 AM

hôm qua mình gửi mà ko kiểm tra lại!
VD1 link đây nhé! Rất cảm ơn bạn vì sự nhiệt tình!
bạn thử nghiên cứu xem có giúp đc mình ko nhé!

http://www.cadviet.c...files/VD1_4.zip
  • 0

#1998 thuyvan0210

thuyvan0210

    biết zoom

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

Đã gửi 17 May 2009 - 10:23 AM

http://www.cadviet.c...files/VD1_4.zip

Chào bạn Tue_NV. mình up đc rồi nhưng mà link trực tiếp toàn báo lỗi! bạn copy link rồi paste vào cửa sổ mới nhé: http://www.cadviet.c...files/VD1_4.zip
  • 0

#1999 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 May 2009 - 11:35 AM

mình muốn nhờ các bạn viết giúp mình một đoạn lisp nội dung là:
mình có 1pline, cần so sánh các điểm nút của pline đó với một móc so sánh và ghi các cao độ
mình xin diễn giải đoạn lisp thực hiện như sau:
- chọn mốc so sánh
- nhập giá trị mốc so sánh
- chọn vị trí ghi text cao độ
- chọn pline (có các nút lấy cao độ so sánh)
mình cũng đã thử làm nhưng ko làm được. Mong các bạn giúp đỡ! Xin cảm ơn

Chào bạn thuyvan0210. Đây là Code mà Tue_NV viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:SCD()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))
(setq cao (getreal "\n Chon chieu cao chu :"))
(setq tp (getint "\n So chu so thap phan :"))

(while po

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ cao 2)) 0))
(setq kc (+ (distance po po2) gtmss))
(Command "line" po po2 "")
(Command "style" "CADVIET" "TIMES.TTF" "0" "1" "0" "N" "N")
(Command "Text" "j" "BR" pot cao "90" (rtos kc 2 tp))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))

)
(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)

  • 2

#2000 phuchauctc

phuchauctc

    Chưa sử dụng CAD

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

Đã gửi 17 May 2009 - 01:07 PM

Chào các cao thủ.
Mình mới tham gia diễn đàn và thấy rất nhiều điều hay. Hôm trước mình có dùng một số lisp tạo bảng toạ độ để lấy toạ độ của các điểm trên Pline hoặc Region rồi xuất ngay trong CAD hoặc sang Excel hoặc text. Mình thấy cũng tốt nhiều cho mình rồi nhưng còn một số việc chưa được nên nhờ các cao thủ lập giúp mình một lisp thực hiện công việc sau:
Có 1 bản vẽ mặt bằng công trình theo dạng tuyến được vẽ với tỷ lệ 1/2000. Trên mặt bằng có các mốc giải phóng mặt bằng có tọa độ X và Y. Giả sử mốc GPMB1 có tọa độ chuẩn theo hệ tọa độ Quốc gia VN2000 là X1, Y1. Trong quá trình lập bản vẽ thiết kế lại chuyển cả bản vẽ mặt bằng đi một vị trí khác (move tự do không định trước khoảng cách) nên điểm GPMB1 bây giờ có tọa độ là X2, Y2. Để có bảng tọa độ đúng của các mốc GPMB, mình đã làm như sau:
- Chuyển tỷ lệ bản vẽ về đúng tỷ lệ thật.
- Chuyển (move) một điểm nào đó (ví dụ điểm đường chuyền) trên bản vẽ đã bị dịch đi về đúng tọa độ của nó theo tài liệu khảo sát địa hình.
- Dùng Lisp sau (xin lỗi ko nhớ của tác giả nào nữa):
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;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
;;;Free utility - www.cadviet.com - September 2008
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



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

;;;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))) (setq S ""))
(setq txtL (list num (rtos (cadr pv)) (rtos (car pv)) 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))
(command "erase" 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))
)
;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

Mình đã tạo được bảng tọa độ theo ý muốn. Tuy nhiên mình muốn các cao thủ sửa giúp (do mình hoàn toàn mù tịt về AutoLisp) Lisp trên nhằm thực hiện các việc:
- Nhập tỷ lệ bản vẽ hiện hành.
- Nhập tỷ lệ thực cần chuyển về.
- Chọn điểm chuẩn cần chuyển tọa độ.
- Nhập tọa độ hiện hành (đã bị dịch chuyển) của điểm đó.
- Nhập tọa độ chuẩn của điểm chuẩn đó.
Sau đó mới đến các việc của đoạn Lisp trên và việc đánh số thứ tự không là 1,2,3... mà có thể là GPMB1, GPMB2, GPMB3,... hoặc gì đó theo bước nhảy do người dùng đặt (mặc định là 1) và xuất trực tiếp ra bản vẽ hoặc sang Excel hoặc text.
Đây là lần đầu tiên viết bài trên diễn đàn nên có gì chưa được xin được chỉ giáo.
Mr Hoành hoặc Mr ssg ơi, nếu ai sửa giúp được xin nhờ gửi cho mình theo Email: phuchauctc@gmail.com với nhé.
Xin đa tạ và chúc sức khỏe!
  • 0