Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

Viết Lisp theo yêu cầu

Các bài được khuyến nghị

Tue_NV    3.841
thành thật xin lỗi bạn TUE_NV, mình kô có ý j đâu, ý mình muốn nói cái đó kô quan trong lắm nên bạn cứ làm thế nào tiện cho bạn nhất ý mà ( lần sau phải tuyệt đối tránh từ "dễ" kô các bạn hiểu nhầm ) thật là ngại wa, thành thật xin lỗi và cảm ơn bạn nhiều. Sorry Sorry :mellow:

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é.

 

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.

Bạn có thể upload file bản vẽ .dwg và nói rõ hơn ý của bạn được không?

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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é.

 

 

mình đã dùng thử rồi, lisp dùng rất tốt bạn ah, tuy có 1 số điểm tự sửa nhưng mà cũng kô mất thời gian lắm đâu. cảm ơn bạn lần nữa :mellow:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
mình đã dùng thử rồi, lisp dùng rất tốt bạn ah, tuy có 1 số điểm tự sửa nhưng mà cũng kô mất thời gian lắm đâu. cảm ơn bạn lần nữa :mellow:

Hai vòng tròn màu đỏ mà Tue_NV khoanh tròn mà hỏi bạn, chính là điiểm yếu mà Lisp không thể làm tốt công việc của mình được. Bởi vì có những lúc con người hiểu thế nhưng Lisp không hiểu thế. Ở những đoạn mở rộng sông thường bị lỗi, hay những khúc cua ngoặc hay bị lỗi. bạn thấy rồi đấy. Vì Lisp phải duyệt qua từng điểm chia trên Pline.

Ở những đoạn cua quá ngoặc bạn nên Break Pline tạo thêm 1 dòng sông gồm 2 Pline rồi thực hiện lệnh Lisp.

Mong bạn hiểu ý.

Chúc thành công

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Hai vòng tròn màu đỏ mà Tue_NV khoanh tròn mà hỏi bạn, chính là điiểm yếu mà Lisp không thể làm tốt công việc của mình được. Bởi vì có những lúc con người hiểu thế nhưng Lisp không hiểu thế. Ở những đoạn mở rộng sông thường bị lỗi, hay những khúc cua ngoặc hay bị lỗi. bạn thấy rồi đấy. Vì Lisp phải duyệt qua từng điểm chia trên Pline.

Ở những đoạn cua quá ngoặc bạn nên Break Pline tạo thêm 1 dòng sông gồm 2 Pline rồi thực hiện lệnh Lisp.

Mong bạn hiểu ý.

Chúc thành công

 

mình đã hiểu ý bạn TUE_NV, đúng là nên đổi những đoạn là arc thành PL như thế thì sẽ kô có lỗi ( cũng may mà của mình kô có nhiều đoạn arc lắm ), nhờ lisp ấy mà sáng nay mình đã làm xong công việc của của mấy ngày truớc :mellow: thanks bạn TUE thêm 1 lần :mellow:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
mình đã hiểu ý bạn TUE_NV, đúng là nên đổi những đoạn là arc thành PL như thế thì sẽ kô có lỗi ( cũng may mà của mình kô có nhiều đoạn arc lắm ), nhờ lisp ấy mà sáng nay mình đã làm xong công việc của của mấy ngày truớc :mellow: thanks bạn TUE thêm 1 lần :mellow:

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thiep    263
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.com/file/hklj0znm5kz/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.com/upfiles/timduong.lsp

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.com/upfiles/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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
oanhvang    0

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

)

)

)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
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.com/forum/index.php?showtopic=279

Bài viết đầu tiên nhé

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
oanhvang    0
Bạn tải Lisp này về và sử dụng lệnh Vis :

http://www.cadviet.com/forum/index.php?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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
xinh75    0

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.com/upfiles/shape.rar

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
quocanhxd05    6
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 !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123
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ì.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
oanhvang    0
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é

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thuyvan0210    0
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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thuyvan0210    0
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nghiautc    18
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.com/upfiles/NGHIA_1.lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
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.com/upfiles/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é.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nghiautc    18
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thuyvan0210    0
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é!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
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)))
)

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phuchauctc    0

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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×