Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


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

#821 HoangVuTuan

HoangVuTuan

    biết zoom

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

Đã gửi 03 March 2010 - 06:00 PM

Cảm ơn bác Hoành. Cho phép Tue_NV học được điều này giúp cho bạn HoangVuTuan
Bạn HoangVuTuan sử dụng thử code sau :


(defun C:cong()
(setq ss (ssget '((0 . "TEXT")(-4 . ""OR>")))

    sochenh (getint "\nHay vao so chenh: ")
  )
  (while (setq ent (ssname ss 0))
    (setq
      tt (entget ent)
      gt (cdr (assoc 1 tt)))
(if (wcmatch gt "@#*")
     (setq gt (strcat (substr gt 1 1) (itoa (+ sochenh (atoi (substr gt 2)))) ))
 (setq gt (strcat (itoa (+ sochenh (atoi (substr gt 1 (1- (strlen gt)) ) ) ) )
(substr gt (strlen gt) 1) ))
    )
    (entmod (subst (cons 1 gt) (assoc 1 tt) tt))
    (setq ss (ssdel ent ss))
  )
  (princ)
)

Chức năng Download Lisp file bị lỗi bác Hoành ạ. Nhờ bác sửa giúp.
Bạn HoangVuTuan nhấn nút Reply bài viết này -> Chép hết code về chạy nhé.

Bác Tue_NV ơi , bác xem lại dùm em nó báo lỗi :
; error: bad argument type: lselsetp nil
Khi nhập vào số chênh ! Cám ơn bác nhiều
  • 0

#822 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 03 March 2010 - 06:10 PM

Bác Tue_NV ơi , bác xem lại dùm em nó báo lỗi :
; error: bad argument type: lselsetp nil
Khi nhập vào số chênh ! Cám ơn bác nhiều

Như Tue_NV đã nói, bạn cần reply bài viết của Tue_NV để lấy code mới không bị lỗi.

Hoặc bạn có thể lấy đoạn code cải tiến này:

(defun C:cong ()
(setq ss (ssget '((0 . "TEXT") (1 . "@#*,*#@")))
sochenh (getint "\nHay vao so chenh: ")
)
(while (setq ent (ssname ss 0))
(setq
tt (entget ent)
gt (cdr (assoc 1 tt))
)
(if (wcmatch gt "@#*")
(setq gt (strcat (substr gt 1 1)
(itoa (+ sochenh (atoi (substr gt 2))))
)
)
(setq
gt (strcat
(itoa (+ sochenh (atoi (substr gt 1 (1- (strlen gt))))))
(substr gt (strlen gt) 1)
)
)
)
(entmod (subst (cons 1 gt) (assoc 1 tt) tt))
(setq ss (ssdel ent ss))
)
(princ)
)


@Tue_NV: có thể gộp lệnh or trong trường hợp filter bằng dấu phẩy. Autolisp sẽ kiểm tra tất cả các phần cách nhau bằng dấu phẩy.
  • 4

#823 HoangVuTuan

HoangVuTuan

    biết zoom

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

Đã gửi 03 March 2010 - 06:18 PM

Như Tue_NV đã nói, bạn cần reply bài viết của Tue_NV để lấy code mới không bị lỗi.

Hoặc bạn có thể lấy đoạn code cải tiến này:

(defun C:cong ()
(setq ss (ssget '((0 . "TEXT") (1 . "@#*,*#@")))
sochenh (getint "\nHay vao so chenh: ")
)
(while (setq ent (ssname ss 0))
(setq
tt (entget ent)
gt (cdr (assoc 1 tt))
)
(if (wcmatch gt "@#*")
(setq gt (strcat (substr gt 1 1)
(itoa (+ sochenh (atoi (substr gt 2))))
)
)
(setq
gt (strcat
(itoa (+ sochenh (atoi (substr gt 1 (1- (strlen gt))))))
(substr gt (strlen gt) 1)
)
)
)
(entmod (subst (cons 1 gt) (assoc 1 tt) tt))
(setq ss (ssdel ent ss))
)
(princ)
)


@Tue_NV: có thể gộp lệnh or trong trường hợp filter bằng dấu phẩy. Autolisp sẽ kiểm tra tất cả các phần cách nhau bằng dấu phẩy.

Sau khi xem lại em thấy lisp của các bác có 2 vấn đề : 1 là hay quá 2 là quá hay :cheers: Cảm ơn 2 bác
  • 0

#824 haanh6285

haanh6285

    biết zoom

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

Đã gửi 04 March 2010 - 02:57 PM

Chào anh Nguyễn Hoanh!
Em đã tải và dùng Lisp sắp dim(SD) của anh nhưng khi chọn xong đường Dim gốc thì CAD báo lỗi như sau:

Command: sd
Sap xep dim © CADViet.com
Chon duong dim goc: Unknown command "SD". Press F1 for help.
,Anh cho em hỏi dòng lệnh này đã được sử lại rồi phải không a:

(* (* D (sin (- A B ))) (phia p1 (polar p1 goc 1.0) p2))

Mong anh chỉ giúp.
PS/Cảm ơn anh vì sự giúp đỡ nhiệt tình với mọi người!!!
  • 0
Hà Tuấn Anh
Tel:0942226285

#825 thanhliemvqh

thanhliemvqh

    biết pan

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

Đã gửi 04 March 2010 - 03:03 PM

Ai có thể viết gíúp đoạn lisp này dược không? Mình có một đoạn mương dài 100m mình muốn rãi hố ga cho đoạn mương này với khoảng cách 21m một hố ga, và tại mỗi vị trí hố ga đấy có cốt Đỉnh và Đáy mương với lại có thể đặt tên hố ga tại vị trí mỗi hố ga đó. :cheers:
  • 0

#826 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 04 March 2010 - 03:33 PM

Chào anh Nguyễn Hoanh!
Em đã tải và dùng Lisp sắp dim(SD) của anh nhưng khi chọn xong đường Dim gốc thì CAD báo lỗi như sau:

Command: sd
Sap xep dim © CADViet.com
Chon duong dim goc: Unknown command "SD". Press F1 for help.
,Anh cho em hỏi dòng lệnh này đã được sử lại rồi phải không a:

(* (* D (sin (- A B ))) (phia p1 (polar p1 goc 1.0) p2))

Mong anh chỉ giúp.
PS/Cảm ơn anh vì sự giúp đỡ nhiệt tình với mọi người!!!

Trích lời bác Hòanh : Không ngờ, ACAD 2008 đã có sẵn lệnh này với cái tên là DIMSPACE.
Tham khảo : http://www.cadviet.c...?showtopic=1661

@haanh6285 : Bạn có thể tải Lisp của bác Hoành từ bài viết số 5 trong chủ đề này :
http://www.cadviet.c...o...c=15968&hl=

@thanhliemvqh : Bạn vui lòng nói rõ hơn : ghi cốt Đỉnh và Đáy mương, tên hố ga như thế nào??
Vui lòng upload file .dwg minh hoạ và nói rõ. nhé. Cụ thể, chi tiết .
  • 1

#827 thanhliemvqh

thanhliemvqh

    biết pan

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

Đã gửi 04 March 2010 - 05:12 PM

hãy giúp mình viết lisp cho cái này nhé các ban. cảm ơn
http://www.cadviet.c...cho_ho_ga_1.dwg
http://www.cadviet.c...u_the_nay_1.dwg

mình cần rãi hố ga và điền cốt cho các vị trí hố ga với khoảng cách các hố ga đó
khi đã biết hố ga và cốt của hố ga này và cốt ga cuối
  • 0

#828 hoavien248

hoavien248

    biết vẽ line

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

Đã gửi 04 March 2010 - 08:31 PM

Các bác viết dùm e cái lisp này nhé!
http://www.cadviet.c...vietdumlisp.dwg
Chúc các bác năm mới Phát Tài,Phát Lộc,An Khang Thịnh Vượng!!!
Mong tin các bác!

Các bác viết dùm em với!
  • 0

#829 xuanvi80

xuanvi80

    biết pan

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

Đã gửi 04 March 2010 - 11:34 PM

Mình có nhiều đối tượng được vẽ ra, sau một lệnh LISP (ví dụ Đường tròn, hình chữ nhật, đường line, pline,... Tất cả các đối tượng này được vẽ trong một lệnh của AutoLisp).

Vậy các bạn có thể chỉ cho mình cách chọn lại tất cả các đối tượng trên bằng lệnh của LISP không? Hoặc cách add các đối tượng trên vào một tập các đối tượng được không? Để mình copy, hoặc move, hoặc array,...tập đối tượng đó.

Xem file đính kèm.
http://www.cadviet.c...2/cadviet_5.dwg

Cám ơn tất cả các bạn!
  • 0

#830 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 05 March 2010 - 08:48 AM

Cảm ơn anh Tue_NV đã viết giùm em lisp vẽ phân giác! Lisp chạy rất tốt (tuy không extend được).
Hôm nay em muốn nhờ mọi người và anh viết giùm em một lisp tính diện tích và lập bảng.
Em đã tham khảo nhiều lisp tính diện tích trên Diễn đàn và tìm được lisp r của anh Thaistreetz là gần giống với mong muốn của mình.
Nay em muốn nhờ viết một lisp như sau:
Em có bản vẽ gồm các khu đất đã được chia ô và đánh số thứ tự như trong file đính kèm sau:
http://www.cadviet.c...ew_block_12.dwg
Em muốn nhờ viết lisp tính diện tích một vùng (tam giác) bằng cách pick vào một điểm trong vùng và viết kết quả vào bảng như trong file đính kèm trên.
Em xin chân thành cảm ơn!
  • 0
http://khuyen.space

#831 thiep

thiep

    biết dimbaseline

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

Đã gửi 05 March 2010 - 04:37 PM

Cảm ơn anh Tue_NV đã viết giùm em lisp vẽ phân giác! Lisp chạy rất tốt (tuy không extend được).
Hôm nay em muốn nhờ mọi người và anh viết giùm em một lisp tính diện tích và lập bảng.
Em đã tham khảo nhiều lisp tính diện tích trên Diễn đàn và tìm được lisp r của anh Thaistreetz là gần giống với mong muốn của mình.
Nay em muốn nhờ viết một lisp như sau:
Em có bản vẽ gồm các khu đất đã được chia ô và đánh số thứ tự như trong file đính kèm sau:
http://www.cadviet.c...ew_block_12.dwg
Em muốn nhờ viết lisp tính diện tích một vùng (tam giác) bằng cách pick vào một điểm trong vùng và viết kết quả vào bảng như trong file đính kèm trên.
Em xin chân thành cảm ơn!

Chào svba1608, đề toán em đưa ra rất hay, tiếc là anh bận quá, chỉ xin đưa ra các hướng giải, các bác nào rảnh xin giúp cho svba 1 tay:
- Chọn các Lwpolyline (gọi tắt là LWP) với điều kiện Lwpolyline đóng hay Lwpolyline có startpoint trùng endpoint và thuộc lớp vh như trong bản vẽ.
- Từng LWP lọc lấy các point nút đỉnh cho vào 1 listpointFen để lọc lấy các text A, B, C, D và 1 text số (ví dụ text số tìm được là 1.
- Từng các text A, B, C, D sẽ tìm được insertpoint. Tạo boundary từ từng insertpoint này và có nhãn là 1A hay 1B, hay 1C, hay 1D. Tìm diện tích từ các boundary này
……….
- Tạo 1 table, đưa dữ liệu vào table.
Chúc các bác thành công!
  • 1

#832 thanhliemvqh

thanhliemvqh

    biết pan

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

Đã gửi 05 March 2010 - 05:10 PM

Goi Bac Hoanh: cai lisp in nhiều bản vẽ cùng lúc hay thật. Nhưng còn một vấn đề nữa là: khi chọn một khổ giấy bất kỳ nhưng in có tỉ lệ thì phải chọn như thế nào???????? :cheers:
In tự động nhiều bản vẽ một lúc bằng MPlot
  • 0

#833 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 March 2010 - 05:11 PM

Chào svba1608, đề toán em đưa ra rất hay, tiếc là anh bận quá, chỉ xin đưa ra các hướng giải, các bác nào rảnh xin giúp cho svba 1 tay:
- Chọn các Lwpolyline (gọi tắt là LWP) với điều kiện Lwpolyline đóng hay Lwpolyline có startpoint trùng endpoint và thuộc lớp vh như trong bản vẽ.
- Từng LWP lọc lấy các point nút đỉnh cho vào 1 listpointFen để lọc lấy các text A, B, C, D và 1 text số (ví dụ text số tìm được là 1.
- Từng các text A, B, C, D sẽ tìm được insertpoint. Tạo boundary từ từng insertpoint này và có nhãn là 1A hay 1B, hay 1C, hay 1D. Tìm diện tích từ các boundary này
……….
- Tạo 1 table, đưa dữ liệu vào table.
Chúc các bác thành công!

Chào bác Thiep

Bác có thể vui lòng nói rõ hơn ở bước 1 không?
Làm sao để lọc được các text A, B, C, D và 1 text số ???

Bác vui lòng giải thích rõ hơn?
Thanks

Edit : Tue_NV hiểu ý bác Thiep rồi. Nếu các LWP mà không chứa các text A, B, C, D và 1 text số thì loại ra khỏi tập chọn LWP?
  • 0

#834 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 05 March 2010 - 07:22 PM

Cảm ơn anh Tue_NV đã viết giùm em lisp vẽ phân giác! Lisp chạy rất tốt (tuy không extend được).
Hôm nay em muốn nhờ mọi người và anh viết giùm em một lisp tính diện tích và lập bảng.
Em đã tham khảo nhiều lisp tính diện tích trên Diễn đàn và tìm được lisp r của anh Thaistreetz là gần giống với mong muốn của mình.
Nay em muốn nhờ viết một lisp như sau:
Em có bản vẽ gồm các khu đất đã được chia ô và đánh số thứ tự như trong file đính kèm sau:
http://www.cadviet.c...ew_block_12.dwg
Em muốn nhờ viết lisp tính diện tích một vùng (tam giác) bằng cách pick vào một điểm trong vùng và viết kết quả vào bảng như trong file đính kèm trên.
Em xin chân thành cảm ơn!


Svba dùng lisp LBD (Lập Bản Đồ), chương trình sẽ yêu cầu Svba pick chọn 3 điểm. 2 điểm đầu (p1, p2) để xác định miền chữ nhật chứa bản đồ, điểm thứ 3 (p3) là tọa độ để chèn bảng. Các vấn đề còn lại lisp sẽ tự hiểu, giám thị không cần giải thích gì thêm :cheers: .
Hình đã gửi


(setq
lbd_textheight 20.0
lbd_cellheight 50.0
lbd_cellwidth 200.0
lbd_textlayer "sttkhu"
lbd_kdlayer "vh"
)
(defun c:lbd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun wtxt (txt p / sty d h)
(entmake
(list (cons 0 "TEXT")
(cons 1 txt)
(cons 10 p)
(cons 40 lbd_textheight)
)
)
)
(defun dxf (code ent)
(cdr (assoc code (entget ent)))
)
(defun findmother (p / mm)
(foreach e lstm
(if
(null
(ssget "_F" (list p (dxf 10 e)) (list (cons 8 lbd_kdlayer)))
)
(setq
mother (dxf 1 e)
)
)
)
mother
)
(defun tinhdt (ent / p)
(setq p (dxf 10 ent)
elast (entlast)
)
(command ".boundary" p "")
(setq enew (entlast))
(list
(findmother p)
(dxf 1 ent)
(if (eq enew elast)
-1
(progn
(command ".area" "ob" enew)
(command ".erase" enew "")
(getvar "area")
)
)
)
)
(setvar "clayer" "0")
(setq
p1 (getpoint "\nGoc 1 cua mien chua ban do: ")
p2 (getcorner p1 "\nGoc 2 cua mien chua ban do: ")
ss (ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "[a-e]")
)
)
lst (ss2ent ss)
lstm (ss2ent
(ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "~*[~0-9]*")
)
)
)
diemchen (getpoint "\nDiem chen ket qua: ")
)
(command ".layer" "off" lbd_textlayer "")
(command ".zoom" p1 p2)
(setq
lst (mapcar 'tinhdt lst)
)
(command ".layer" "on" lbd_textlayer "")
(command ".zoom" "p")

(setq x0 (car diemchen)
y0 (cadr diemchen)
yht y0
lst (vl-sort lst
'(lambda (a b )
(if (= (car a) (car b ))
(< (cadr a) (cadr b ))
(< (atoi (car a)) (atoi (car b )))
)
)
)
lastindex (atoi (car (nth (1- (length lst)) lst)))
index 1
lst (mapcar '(lambda (x) (cons (strcat (car x) (cadr x)) (caddr x)))
lst
)
)


(repeat lastindex
(wtxt (itoa index) (list x0 yht))
(setq xht x0
part 97
)

(repeat 5
(setq xht (+ xht lbd_cellwidth)
gt (if (setq tmp (assoc (strcat (itoa index) (chr part)) lst))
(if (< (cdr tmp) 0.0)
"__err__"
(rtos (cdr tmp) 2 2)
)
"_______"
)
part (1+ part)
)
(wtxt gt (list xht yht))
)
(setq yht (- yht lbd_cellheight)
index (1+ index)
)
)
(princ)
)


Lưu ý:
- Trong lúc lisp chạy Svba đừng nhấn Esc, hãy kiên nhẫn chờ lisp chạy hết, tránh lỗi.
- Trong bảng kết quả, chữ __err___ là cell có chữ nhưng lisp không tính được diện tích, Svba phải tính lại bằng tay. chữ ____ nghĩa là miếng đất đó không có mảnh theo cell (ví dụ thiếu mảnh e thì tại cell e sẽ là ____).
- Sau khi lisp chạy xong, Svba dùng lệnh Line để kẻ lại bảng theo text đã có.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 06 March 2010 - 01:54 PM
Đã sửa lỗi lisp do layer hiện hành không phải là layer 0

  • 1

#835 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 05 March 2010 - 10:21 PM

Svba dùng lisp LBD (Lập Bản Đồ), chương trình sẽ yêu cầu Svba pick chọn 3 điểm. 2 điểm đầu (p1, p2) để xác định miền chữ nhật chứa bản đồ, điểm thứ 3 (p3) là tọa độ để chèn bảng. Các vấn đề còn lại lisp sẽ tự hiểu, giám thị không cần giải thích gì thêm



Cảm ơn anh Hoành đã giúp đỡ, tuy nhiên giám thị vẫn cần giải thích thêm, vì em không chạy được ra kết quả của lisp trên, sau khi chọn xong 3 điểm là lisp dừng luôn. Thông báo từ command như sau:


Command: lbd
Goc 1 cua mien chua ban do:
Goc 2 cua mien chua ban do:
Diem chen ket qua: .layer
Current layer: "sttkhu"
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: off
Enter name list of layer(s) to turn off or < s elect objects > : sttkhu Really want
layer "sttkhu" (the CURRENT layer) off? Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: .zoom
Invalid option keyword.
; error: Function cancelled
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: M

Enter name for new layer (becomes the current layer) :
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw /LOck/Unlock
/stAte]:

Hình đã gửi

Và cứ như vậy cho đến khi nhấn phím Esc. Nhờ anh Hoành kiểm tra lại giùm. Em cảm ơn!
  • 0
http://khuyen.space

#836 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 06 March 2010 - 10:22 AM

Cảm ơn anh Tue_NV đã viết giùm em lisp vẽ phân giác! Lisp chạy rất tốt (tuy không extend được).
Hôm nay em muốn nhờ mọi người và anh viết giùm em một lisp tính diện tích và lập bảng.
Em đã tham khảo nhiều lisp tính diện tích trên Diễn đàn và tìm được lisp r của anh Thaistreetz là gần giống với mong muốn của mình.
Nay em muốn nhờ viết một lisp như sau:
Em có bản vẽ gồm các khu đất đã được chia ô và đánh số thứ tự như trong file đính kèm sau:
http://www.cadviet.c...ew_block_12.dwg
Em muốn nhờ viết lisp tính diện tích một vùng (tam giác) bằng cách pick vào một điểm trong vùng và viết kết quả vào bảng như trong file đính kèm trên.
Em xin chân thành cảm ơn!

Xin lỗi SVBA1608,
Bạn có thể upload lại file bản vẽ ở dạng cad2004 được không. Do mình chỉ có cad2004 nên không mở được file của bạn để hiểu được bạn cần gì?
Theo mình biết trên diễn đàn đã có lisp về lập bảng tọa độ góc ranh của các thửa đất, nếu dựa vào lisp này thì việc thực hiện các yêu cầu của bạn có thể làm được vì nó đơn giản hơn việc lầy tọa độ góc ranh. Bạn có thể dựa vào lisp này để cải tạo nó theo yêu cầu của bạn được không? Nếu có khó khăn hãy post lên mình nghĩ rằng mọi người sẽ giúp được mà.
Chúc bạn thành công.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#837 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 06 March 2010 - 10:39 AM

Xin lỗi SVBA1608,
Bạn có thể upload lại file bản vẽ ở dạng cad2004 được không. Do mình chỉ có cad2004 nên không mở được file của bạn để hiểu được bạn cần gì?
Theo mình biết trên diễn đàn đã có lisp về lập bảng tọa độ góc ranh của các thửa đất, nếu dựa vào lisp này thì việc thực hiện các yêu cầu của bạn có thể làm được vì nó đơn giản hơn việc lầy tọa độ góc ranh. Bạn có thể dựa vào lisp này để cải tạo nó theo yêu cầu của bạn được không? Nếu có khó khăn hãy post lên mình nghĩ rằng mọi người sẽ giúp được mà.
Chúc bạn thành công.


Cảm ơn bác Bình nhiều!
Đây là file dwg 2004 của bản vẽ em muốn nhờ Diễn đàn viết lisp:
http://www.cadviet.c...les/2/bando.dwg
  • 0
http://khuyen.space

#838 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 06 March 2010 - 12:14 PM

Cảm ơn bác Bình nhiều!
Đây là file dwg 2004 của bản vẽ em muốn nhờ Diễn đàn viết lisp:
http://www.cadviet.c...les/2/bando.dwg

Sorry,

Lisp dưới đây sẽ khắc phục nhược điểm trên (lỗi xảy ra do layer hiện hành là sttkhu):


(setq
lbd_textheight 20.0
lbd_cellheight 50.0
lbd_cellwidth 200.0
lbd_textlayer "sttkhu"
lbd_kdlayer "vh"
)
(defun c:lbd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun wtxt (txt p / sty d h)
(entmake
(list (cons 0 "TEXT")
(cons 1 txt)
(cons 10 p)
(cons 40 lbd_textheight)
)
)
)
(defun dxf (code ent)
(cdr (assoc code (entget ent)))
)
(defun findmother (p / mm)
(foreach e lstm
(if
(null
(ssget "_F" (list p (dxf 10 e)) (list (cons 8 lbd_kdlayer)))
)
(setq
mother (dxf 1 e)
)
)
)
mother
)
(defun tinhdt (ent / p)
(setq p (dxf 10 ent)
elast (entlast)
)
(command ".boundary" p "")
(setq enew (entlast))
(list
(findmother p)
(dxf 1 ent)
(if (eq enew elast)
-1
(progn
(command ".area" "ob" enew)
(command ".erase" enew "")
(getvar "area")
)
)
)
)
(setvar "clayer" "0")
(setq
p1 (getpoint "\nGoc 1 cua mien chua ban do: ")
p2 (getcorner p1 "\nGoc 2 cua mien chua ban do: ")
ss (ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "[a-e]")
)
)
lst (ss2ent ss)
lstm (ss2ent
(ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "~*[~0-9]*")
)
)
)
diemchen (getpoint "\nDiem chen ket qua: ")
)
(command ".layer" "off" lbd_textlayer "")
(command ".zoom" p1 p2)
(setq
lst (mapcar 'tinhdt lst)
)
(command ".layer" "on" lbd_textlayer "")
(command ".zoom" "p")

(setq x0 (car diemchen)
y0 (cadr diemchen)
yht y0
lst (vl-sort lst
'(lambda (a b )
(if (= (car a) (car b ))
(< (cadr a) (cadr b ))
(< (atoi (car a)) (atoi (car b )))
)
)
)
lastindex (atoi (car (nth (1- (length lst)) lst)))
index 1
lst (mapcar '(lambda (x) (cons (strcat (car x) (cadr x)) (caddr x)))
lst
)
)


(repeat lastindex
(wtxt (itoa index) (list x0 yht))
(setq xht x0
part 97
)

(repeat 5
(setq xht (+ xht lbd_cellwidth)
gt (if (setq tmp (assoc (strcat (itoa index) (chr part)) lst))
(if (< (cdr tmp) 0.0)
"__err__"
(rtos (cdr tmp) 2 2)
)
"_______"
)
part (1+ part)
)
(wtxt gt (list xht yht))
)
(setq yht (- yht lbd_cellheight)
index (1+ index)
)
)
(princ)
)

  • 1

#839 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 06 March 2010 - 03:02 PM

Sorry,

Lisp dưới đây sẽ khắc phục nhược điểm trên (lỗi xảy ra do layer hiện hành là sttkhu):


(setq
lbd_textheight 20.0
lbd_cellheight 50.0
lbd_cellwidth 200.0
lbd_textlayer "sttkhu"
lbd_kdlayer "vh"
)
(defun c:lbd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun wtxt (txt p / sty d h)
(entmake
(list (cons 0 "TEXT")
(cons 1 txt)
(cons 10 p)
(cons 40 lbd_textheight)
)
)
)
(defun dxf (code ent)
(cdr (assoc code (entget ent)))
)
(defun findmother (p / mm)
(foreach e lstm
(if
(null
(ssget "_F" (list p (dxf 10 e)) (list (cons 8 lbd_kdlayer)))
)
(setq
mother (dxf 1 e)
)
)
)
mother
)
(defun tinhdt (ent / p)
(setq p (dxf 10 ent)
elast (entlast)
)
(command ".boundary" p "")
(setq enew (entlast))
(list
(findmother p)
(dxf 1 ent)
(if (eq enew elast)
-1
(progn
(command ".area" "ob" enew)
(command ".erase" enew "")
(getvar "area")
)
)
)
)
(setvar "clayer" "0")
(setq
p1 (getpoint "\nGoc 1 cua mien chua ban do: ")
p2 (getcorner p1 "\nGoc 2 cua mien chua ban do: ")
ss (ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "[a-e]")
)
)
lst (ss2ent ss)
lstm (ss2ent
(ssget "_W"
p1
p2
(list (cons 0 "TEXT")
(cons 8 lbd_textlayer)
(cons 1 "~*[~0-9]*")
)
)
)
diemchen (getpoint "\nDiem chen ket qua: ")
)
(command ".layer" "off" lbd_textlayer "")
(command ".zoom" p1 p2)
(setq
lst (mapcar 'tinhdt lst)
)
(command ".layer" "on" lbd_textlayer "")
(command ".zoom" "p")

(setq x0 (car diemchen)
y0 (cadr diemchen)
yht y0
lst (vl-sort lst
'(lambda (a b )
(if (= (car a) (car b ))
(< (cadr a) (cadr b ))
(< (atoi (car a)) (atoi (car b )))
)
)
)
lastindex (atoi (car (nth (1- (length lst)) lst)))
index 1
lst (mapcar '(lambda (x) (cons (strcat (car x) (cadr x)) (caddr x)))
lst
)
)
(repeat lastindex
(wtxt (itoa index) (list x0 yht))
(setq xht x0
part 97
)

(repeat 5
(setq xht (+ xht lbd_cellwidth)
gt (if (setq tmp (assoc (strcat (itoa index) (chr part)) lst))
(if (< (cdr tmp) 0.0)
"__err__"
(rtos (cdr tmp) 2 2)
)
"_______"
)
part (1+ part)
)
(wtxt gt (list xht yht))
)
(setq yht (- yht lbd_cellheight)
index (1+ index)
)
)
(princ)
)

Chào bác Hoành,
Sau khi bác sửa lại thì lisp đã chạy một mạch cho tới khi kết thúc, ngoại trừ một vài chỗ không lấy boundary được. Tuy nhiên chưa thấy viết ra được cái bảng kết quả như bạn SVBA 1608 mô tả. Nhờ bác xem lại cái chỗ viết kết quả một chút, có thể có lầm lẫn gì chăng???
Chúc bác khỏe và vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#840 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 06 March 2010 - 03:14 PM

Chào bác Hoành,
Sau khi bác sửa lại thì lisp đã chạy một mạch cho tới khi kết thúc, ngoại trừ một vài chỗ không lấy boundary được. Tuy nhiên chưa thấy viết ra được cái bảng kết quả như bạn SVBA 1608 mô tả. Nhờ bác xem lại cái chỗ viết kết quả một chút, có thể có lầm lẫn gì chăng???
Chúc bác khỏe và vui.

Lisp chỉ kết xuất text thôi, kẻ bảng vẫn phải thủ công.
  • 0