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

#3041 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 January 2011 - 06:12 PM

Dạ đúng ạ! Nó giống như leader ghi chú tọa độ 1 điểm (X, Y) ra màn hình đó ah!
Nhờ bạn giúp dùm!

Bạn à, dù rằng yêu cầu có vẻ không khoai lắm, nhưng mình vẫn nghĩ bận nên làm 1 file CAD hoặc hình ảnh thể hiện rõ các bước thực hiện, cách thức nhập liệu, nhập những gì, kết quả ra sao...như vậy sẽ thuận lợi hơn cho người viết, cũng như bản thân bạn hiểu được vấn đề hơn, nếu không mình e bạn phải post yêu cầu nhìu lần đó ^^
P/S : đường pline gạch chân và X,Y lúc nào cũng ghi theo phương ngang à bạn ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3042 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 15 January 2011 - 06:23 PM

Nhờ anh em sửa dùm em cái LISP tra cứu tọa độ điểm này dùm em với:
1/ Em kéo qua bên trái thì chữ nhảy qua bên phải, pline kẻ ngang phân cách X và Y lại nhảy qua bên trái.
2/ Pline kẻ ngang phân cách X và Y ngắn, trong khi X và Y thì dài quá, giờ làm sao X và y dài bao nhiêu thì Pline kẻ dài bấy nhiu.
3/ Sau khi lisp thực hiện xong trả lại bắt điem như ban đầu mình đang mặc định trong CAD (hiện nay là thực hiện xong nó tắt bắt đểm hết)
4/Và sao lisp thực hiện được mà trên dòng command vẫn hiện chữ "Unknown command "TCD"
Xin chân thành cảm ơn anh em.
Em gửi link nhờ anh em giúp dùm.
http://www.cadviet.c...toa_do_diem.lsp

Chào Truongthanh
1/ Pline thì bạn vẽ như thế nào nó đi như thế đó. Bạn vẽ từ p1-> p2->p3 thì nó vẽ đoạn P1p2 và p2p3
Còn Text vì nó sẽ viết ở điểm đặt Text và viết từ trái qua phải
Như vậy bạn thấy như điều số 1 bạn viết ở trên là như vậy
Cách khắc phục:
Bạn viết Text bình thường. Mỗi Text sinh ra lại lấy entity cho nó bằng hàm entlast. Bạn kiếm trên diễn đàn hàm TextBox để lấy chiều dài của Text bằng hàm TextBox mà di chuyển về vị trí cho phù hợp (đối với trường hợp vẽ p2p3 từ trái qua phải)
2. Sau khi lấy được chiều dài của Text bằng hàm TextBox. Bạn vẽ Pline từ P2 đến P3 với chiều dài đúng bằng chiều dài của Text là được. Bạn nên quan tâm đến việc xử lý góc nữa nhé. Hay góc của Text luôn = 0??
3.
(defun c:tcd()
(setq oldos (getvar "osmode")); lay che do bat diem hien hành
(setvar "osmode" 0); tắt chế độ bắt điểm
.......
.....
(setvar "osmode" oldos);trả lại chế độ bắt điểm
(princ)
)
4. Dòng này thừa 1 dấu ""
".circle" p1 1 ""

Tue_NV bận quá nên chỉ đưa ra gợi ý. Bạn tự hoàn thành nhé
Chúc thành công
  • 1

#3043 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 January 2011 - 07:48 PM

Dạ đúng ạ! Nó giống như leader ghi chú tọa độ 1 điểm (X, Y) ra màn hình đó ah!
Nhờ bạn giúp dùm!

Nếu các text lúc nào cũng nằm ngang thì bạn dùng thử cái này nhé.Hy vọng bạn bỏ chút thời gian nghiên cứu lisp để tự xây dựng những đoạn code nhỏ nhỏ cho mình :)
P/S : Trong code bạn post, mình không thấy có phần nào can thiệp vào OSnap mode cả, có thể là do đoạn khác bạn à.Mà nếu lúc chọn điểm mà tắt Ónap đi thì nghe cũng khó :)

(defun c:tcd (/ p1 p2 p3 X Y text1 text2 otext1 otext2 maxdtext)
(setvar "cmdecho" 0)
(setq kk " " )
(while (= kk " ")
(if (not #h) (setq #h (getreal "\nChon chieu cao chu: ")))
(setq p1 (getpoint "\nChon diem can tra cuu tao do: ")
X (car p1)
Y (cadr p1)
p2 (getpoint p1 "\nChon diem dat text: ")
)
(command ".circle" p1 1)
(command ".layer" "m" "gt-toa do nut" "c" "92" "gt-toa do nut" ""
".text" "j" "ml" (polar p2 (/ pi 2) #h) #h 0 (strcat "X = " (rtos X 2 2))
)
(setq text1 (entlast)
otext1 (entget text1))
(command ".text" "j" "ml" (polar p2 (- (/ pi 2)) #h) #h 0 (strcat "Y = " (rtos Y 2 2)))
(setq text2 (entlast)
otext2 (entget text2))
(setq maxdtext (max (car(cadr (textbox otext1))) (car(cadr (textbox otext2)))))
(if (< (car P2) X)
(progn
(command ".pline" p1 p2 (setq p3 (polar p2 pi maxdtext)) "")
(command ".move" text1 text2 "" p2 p3)
)
(command ".pline" p1 p2 (polar p2 0 maxdtext) "")
);end if
);end while
(princ)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3044 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 15 January 2011 - 11:21 PM

Nếu các text lúc nào cũng nằm ngang thì bạn dùng thử cái này nhé.Hy vọng bạn bỏ chút thời gian nghiên cứu lisp để tự xây dựng những đoạn code nhỏ nhỏ cho mình :)
P/S : Trong code bạn post, mình không thấy có phần nào can thiệp vào OSnap mode cả, có thể là do đoạn khác bạn à.Mà nếu lúc chọn điểm mà tắt Ónap đi thì nghe cũng khó :)


(defun c:tcd (/ p1 p2 p3 X Y text1 text2 otext1 otext2 maxdtext)
(setvar "cmdecho" 0)
(setq kk " " )
(while (= kk " ")
(if (not #h) (setq #h (getreal "\nChon chieu cao chu: ")))
(setq p1 (getpoint "\nChon diem can tra cuu tao do: ")
X (car p1)
Y (cadr p1)
p2 (getpoint p1 "\nChon diem dat text: ")
)
(command ".circle" p1 1)
(command ".layer" "m" "gt-toa do nut" "c" "92" "gt-toa do nut" ""
".text" "j" "ml" (polar p2 (/ pi 2) #h) h 0 (strcat "X = " (rtos X 2 2))
)
(setq text1 (entlast)
otext1 (entget text1))
(command ".text" "j" "ml" (polar p2 (- (/ pi 2)) #h) #h 0 (strcat "Y = " (rtos Y 2 2)))
(setq text2 (entlast)
otext2 (entget text2))
(setq maxdtext (max (car(cadr (textbox otext1))) (car(cadr (textbox otext2)))))
(if (< (car P2) X)
(progn
(command ".pline" p1 p2 (setq p3 (polar p2 pi maxdtext)) "")
(command ".move" text1 text2 "" p2 p3)
)
(command ".pline" p1 p2 (polar p2 0 maxdtext) "")
);end if
);end while
(princ)
)

Dạ! Cái text và pline lúc nào cũng nằm ngang ah! Nó giống như file CAD dưới đây ah!
http://www.cadviet.c...files/3/tcd.dwg
Còn cái lisp của bạn nó mất pline và tọa độ X, chỉ còn mỗi Y!
thanks bạn nhiều!
  • 0

#3045 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 January 2011 - 11:34 PM

Srr bạn,mình thiếu 1 dấu # ở dòng này

".text" "j" "ml" (polar p2 (/ pi 2) #h) h 0 (strcat "X = " (rtos X 2 2))

phải sửa lại là

".text" "j" "ml" (polar p2 (/ pi 2) #h) #h 0 (strcat "X = " (rtos X 2 2))

,mình edit lại code trong bài trước rồi, bạn down lại nhé :)
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3046 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 16 January 2011 - 07:52 AM

Anh Bình ởi! Nhờ anh sửa cái này dùm em lại 1 chút! Cái chỗ "NHAP CAO DO THIET KE DIEM:" nhờ anh sửa lại là "CHON CAO DO THIET KE DIEM" dùm em lun anh!Em đã có sẵn text trên màn hình rồi!Thanks anh nhiều!Làm phiền anh tí nữa nhé! Chứ cài này em xài OK rùi!

A Bình sửa lại CODE dum em với!
  • 0

#3047 ngocnam.cad

ngocnam.cad

    biết vẽ ellipse

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

Đã gửi 16 January 2011 - 09:28 PM

Các bác ơi, em đã từng đọc ở diễn đàn mình và một số diễn đàn khác có nói về lisp đưa các trắc ngang vào viewport khung a3 nhưng down về mà làm mãi không dcj. MOng các bác giúp em với ạ. Hay bác nào có lisp đưa trắc ngang vào khung in bản vẽ a3 ti lệ 500 thì cho em xin. cám ơn các bác..hihi
  • 0

#3048 ythien

ythien

    Chưa sử dụng CAD

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

Đã gửi 17 January 2011 - 10:03 PM

mấy anh ơi giúp em với
em muốn chép chương trình cesmap để xuất dữ liệu từ cad sang exel gồm số thửa, loại đất, diện tích
anh em nào có chương trình này thì gửi cho em với
vì cesmap có menu phần xuất dữ liệu sang exel như file em đã gửi
em cám ơn nhiều!!
hoặc có giải pháp nào khác thì chỉ em với nhe
như minh hoạ
thank!!!!!
file kèm : http://www.cadviet.c.../3/hung_yen.dwg
  • 0

#3049 hungvq

hungvq

    Chưa sử dụng CAD

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

Đã gửi 18 January 2011 - 08:34 AM

Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì không còn phần định chiều cao text trong lệnh text nữa, mà nó đi kèm theo Style, nên phải sửa lại trong các hàm tạo text bằng command ^^ Có lẽ nên chuyển sang entmake thì hay hơn :) Nhưng tạm thời cứ chữa cháy để bạn ấy dùng đã



;; free lisp from cadviet.com
(defun c:tdt()
(setvar "cmdecho" 0)
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(if (not tl) (setq tl 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/")))
(if tl1 (setq tl tl1))

(setq k 0
tdt 0)
(setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P6 0 "Bang thong ke dien tich"
"text" "m" P7 0 "STT"
"text" "m" P8 0 "Dien tich (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(setq k (+ 1 k))
(command "TEXT" "m" pt1 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "CECOLOR" 4 "-boundary" pt1 "" )
;(setvar "CECOLOR" lacol)
(setq et (entlast))
(ssadd et ss)
(command "area" "o" "last")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (* (getvar "AREA") tl tl) 1000000))
(setq tdt (+ dtcon tdt))

(command "erase" ss "")

(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P7 0 (rtos k 2 0)
"text" "m" P8 0 (rtos dtcon 2 2))

(setq pt1 (getpoint "\n Chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"text" "m" P12 0 "Tong"
"text" "m" P13 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
)

Chào bạn Ketxu! Rất cám ơn bạn đã post cho mình cái lip này. Nhưng mình vẫn chưa sử dụng được.
Mình bị vấp ngay ở đầu, có lẽ mình chưa hiểu việc chọn tỷ lệ bản vẽ. Mình đã chọn tỷ lệ 1/1; 1/200; 1/500; 1/1000; 1/2000... nhưng không thể tiếp tục được. Máy báo lỗi:
ty le ban ve < 1/1 >: 1/1
Chon diem xuat bang thong ke dien tich (mep trai):; error: bad argument type:
numberp: nil

Có phải tỷ lệ này chính là tỷ lệ bản vẽ cần tính diện tích không nhỉ? Mong bạn chỉ giáo tiếp nhé!
  • 0

#3050 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 January 2011 - 10:07 AM

Xin lỗi bạn ketxu có sai sót tí, mình đã bỏ mất phần khai báo biến h của bạn.Mình sửa lại trong code bài cũ rồi, bạn lấy lại nhé.
Nhớ là tạm thời khi dùng trong Text Style bạn để h = 0 đi, để các lệnh Text đúng khi có khai báo h text trong câu lệnh (lý do thì nêu ở bài đó rồi).Nếu điều này quá phiền toái thì mình sẽ sửa giúp bạn sau
Còn tỉ lệ thì bạn chỉ đánh số mẫu thôi.Ví dụ 1/100 thì bạn đánh 100 ở mục yêu cầu tỉ lệ nhé
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3051 hungvq

hungvq

    Chưa sử dụng CAD

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

Đã gửi 18 January 2011 - 01:51 PM

Xin lỗi bạn ketxu có sai sót tí, mình đã bỏ mất phần khai báo biến h của bạn.Mình sửa lại trong code bài cũ rồi, bạn lấy lại nhé.
Nhớ là tạm thời khi dùng trong Text Style bạn để h = 0 đi, để các lệnh Text đúng khi có khai báo h text trong câu lệnh (lý do thì nêu ở bài đó rồi).Nếu điều này quá phiền toái thì mình sẽ sửa giúp bạn sau
Còn tỉ lệ thì bạn chỉ đánh số mẫu thôi.Ví dụ 1/100 thì bạn đánh 100 ở mục yêu cầu tỉ lệ nhé

Cảm ơn bạn Ketxu nhé! Mình đã sử dụng được rùi.
Phần tỷ lệ đó phải đúng với tỷ lệ của bản vẽ mình cần tính diện tích.
Vấn đề đặt ra (hỏi ngoài chủ đề này) là làm sao để biết bản vẽ đó tỷ lệ bao nhiêu để thiết lập tỷ lệ bản vẽ cho lip này nhỉ?
Còn với Text Style thì mình ko thấy phiền chút nào cả, nhưng nếu bạn có thời gian để sửa nó thì còn gì bằng. :)
  • 0

#3052 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 January 2011 - 09:23 PM

Cảm ơn bạn Ketxu nhé! Mình đã sử dụng được rùi.
Phần tỷ lệ đó phải đúng với tỷ lệ của bản vẽ mình cần tính diện tích.
Vấn đề đặt ra (hỏi ngoài chủ đề này) là làm sao để biết bản vẽ đó tỷ lệ bao nhiêu để thiết lập tỷ lệ bản vẽ cho lip này nhỉ?
Còn với Text Style thì mình ko thấy phiền chút nào cả, nhưng nếu bạn có thời gian để sửa nó thì còn gì bằng. :)

1.Chắc chắn một điều khi đo 1 cái gì đó trên bản vẽ KThuật ta phải biết tỉ lệ để tìm ra kích thước thực rồi.Để tìm ra tỉ lệ thì lại còn phụ thuộc vào ý tưởng lúc vẽ ban đầu.Nếu bản vẽ đó là của bạn, bạn vẽ tỉ lệ bao nhiêu thì hẳn bạn đã biết.Nếu bản ve đó của người khác, bạn đành phải nhìn số liệu Dim của người ta để biết thôi.Tất nhiên điều này chỉ đúng khi đó là dim với giá trị chân thực, k phải dim đã độ,chế ed linh tinh xoèng :)
2.Vấn đề h text trong text style đã được sửa, bạn không cần nhập nữa, nó sẽ lấy theo h hiện hành, bất kể giá trị đó có bằng 0 hay khác 0
Lisp ban đầu của bác Tue_N dùng command text, ketxu đã đưa thêm hàm viết text của bác ssg vào, thêm 1 chút phần Justify Middle, hy vọng lần này bạn hài lòng


; free lisp from cadviet.com @Thaistreetz
;Tinh Dt co mien khoet rong ben trong va lap bang
(defun c:dt2(/ d h1 h2 wf tl1 k tdt P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 frome toe cur dt S)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(if (not tl) (setq tl 1))
(setq tl1 (getreal (strcat "\nTy le ban ve < 1/" (rtos tl 2 0) " >: 1/")))
(if tl1 (setq tl tl1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
)
(wtxt_m "Bang Thong Ke DT" P6 )
(wtxt_m "STT" P7)
(wtxt_m "Dien tich (m2)" P8)
(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(wtxt_m (rtos k 2 0) pt1)
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome ss (ssadd) S 0)
(while (not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl (/ tl 500 500)) tdt (+ s tdt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 "")
( wtxt_m (rtos k 2 0) P7)
(wtxt_m (rtos s 2 2) P8)
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 "")
(wtxt_m "Tong" P12)
(wtxt_m (rtos tdt 2 2) P13)
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

;;free function @ssg
(defun wtxt_m(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3053 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 January 2011 - 09:35 PM

..........
Lisp ban đầu của bác Tue_N dùng command text, ketxu đã đưa thêm hàm viết text của bác ssg vào, thêm 1 chút phần Justify Middle, hy vọng lần này bạn hài lòng
...................


; free lisp from cadviet.com @Tue_NV
;Tinh Dt co mien khoet rong ben trong va lap bang
(defun c:dt2(/ d h1 h2 wf tl1 k tdt P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 frome toe cur dt S)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(if (not tl) (setq tl 1))
(setq tl1 (getreal (strcat "\nTy le ban ve < 1/" (rtos tl 2 0) " >: 1/")))
(if tl1 (setq tl tl1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
)
(wtxt_m "Bang Thong Ke DT" P6 )
(wtxt_m "STT" P7)
(wtxt_m "Dien tich (m2)" P8)
(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(wtxt_m (rtos k 2 0) pt1)
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome ss (ssadd) S 0)
(while (not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl (/ tl 500 500)) tdt (+ s tdt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 "")
( wtxt_m (rtos k 2 0) P7)
(wtxt_m (rtos s 2 2) P8)
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 "")
(wtxt_m "Tong" P12)
(wtxt_m (rtos tdt 2 2) P13)
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

;;free function @ssg
(defun wtxt_m(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

Ketxu "soi" Lộn rồi bạn ơi. Tue_NV chỉ tư vấn cho bạn Thai sờ trét hoàn thành cái Lisp này.
Đây này :
http://www.cadviet.c...o...12432&st=20
Việc sử dụng các hàm command và hàm entmake đê tạo đối tượng. Ưu nhược điểm và mỗi hàm thì đã có các bài viết về nó. Các bạn tìm đọc nhé. Riêng mình thích sử dụng các hàm Entmake nhiều hơn vì các ưu điểm của nó và cũng sử dụng hàm command vì nó ngắn gọn hơn
  • 0

#3054 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 January 2011 - 11:45 PM

Hề hề..Vô cùng xin lỗi bác Sì Trít và bác Tuệ ^^ E nhớ nhầm vì topic này Lisp tính diện tích với lại topic frome toe bác Tuệ hỏi chọn lại số đối tượng sau lệnh Boundary nên bị loạn..Trong lúc tổng hợp có sơ suất, mong các bác bỏ qua ^^ Thửa nào bác Đường Thái Lan vào rồi ra, hok nói 1 câu,mần e chột dạ quá :")
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3055 shitty

shitty

    biết zoom

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

Đã gửi 19 January 2011 - 02:11 PM

Do lệnh hatch trong lisp ban đầu của bạn còn thiếu thông số chọn điểm trong vùng Hatch đó mà
Bạn sửa thành như thế này nhé :

(defun c:Ht ()
(command "-Bhatch" "P" "ANSI31" "300" "")
(while (< 0 (getvar "CMDACTIVE")) (command pause));end while
(vl-cmdf "change" "L" "" "P" "LA" "00-09hatch" "")
)

Góp ý với bạn : ngoài tiếng tks kèm theo lời yêu cầu,bạn có thể dùng nút thanks để động viên hoặc để báo cho người giúp bạn biết là bạn đã ngó qua cái phần người ta đáp ứng nhu cầu của bạn.:")


cảm ơn lời góp ý của bác...e sẽ để ý hơn...thanks bác!!! mà bác có thể xem giúp e cái lisp dim (d_dc_da_qd_dg.lsp) ở trên với được ko...e ko thể dùng được...đánh lệnh d hay da thì ko thấy có ji.?
  • 0

#3056 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 19 January 2011 - 02:14 PM

A Bình sửa lại CODE dum em với!

Chào bạn truongthanh,
Quả thực áy náy vì chưa hiểu bạn bảo mình sửa giùm cái líp nào nữa??? Do mình cũng nghịch hơi nhiều nên giờ chả biết cái chi vào cái mô nữa.... Giá bạn post cái líp đó lên luôn thì hay biết mấy....
Nhưng vấn đề bạn yêu cầu thực ra chả cần ai giúp mà bạn có thể tự làm được đó. Rất đơn giản, bạn cứ dùng notepad mở cái file lisp đó ra và tìm đến đúng cái dòng code nào có cái đoạn NHAP CAO DO THIET KE DIEM thì bạn xóa chữ NHAP đi và thay nó bằng chữ CHON là xong mà. Chỉ cần bạn lưu ý chớ xóa hay thêm bất kỳ cái gì khác là Ok.
Rất mong bạn thông cảm và cố gắng thử một phát xem sao....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3057 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 19 January 2011 - 03:04 PM

Chào bạn truongthanh,
Quả thực áy náy vì chưa hiểu bạn bảo mình sửa giùm cái líp nào nữa??? Do mình cũng nghịch hơi nhiều nên giờ chả biết cái chi vào cái mô nữa.... Giá bạn post cái líp đó lên luôn thì hay biết mấy....
Nhưng vấn đề bạn yêu cầu thực ra chả cần ai giúp mà bạn có thể tự làm được đó. Rất đơn giản, bạn cứ dùng notepad mở cái file lisp đó ra và tìm đến đúng cái dòng code nào có cái đoạn NHAP CAO DO THIET KE DIEM thì bạn xóa chữ NHAP đi và thay nó bằng chữ CHON là xong mà. Chỉ cần bạn lưu ý chớ xóa hay thêm bất kỳ cái gì khác là Ok.
Rất mong bạn thông cảm và cố gắng thử một phát xem sao....

Hix hix! Đoạn CODE đó nằm ở trang trước trang này đó anh, có lẽ nó bị trôi đi nên anh không thấy, em gửi lại link sau:
http://www.cadviet.c...o...st&p=127495
hiện giờ lisp yêu cầu mình "NHẬP", giờ em muốn "CHỌN" trên màn hình! Chứ mở file LISP sửa chữ đó thì em làm được nhưng lisp ko khác gì hết!hehe! :) !Nhờ anh giúp dùm em với!
  • 0

#3058 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 19 January 2011 - 03:42 PM

Hix hix! Đoạn CODE đó nằm ở trang trước trang này đó anh, có lẽ nó bị trôi đi nên anh không thấy, em gửi lại link sau:
http://www.cadviet.c...o...st&p=127495
hiện giờ lisp yêu cầu mình "NHẬP", giờ em muốn "CHỌN" trên màn hình! Chứ mở file LISP sửa chữ đó thì em làm được nhưng lisp ko khác gì hết!hehe! :) !Nhờ anh giúp dùm em với!

Hề hề hê,
Chào bạn Truongthanh,
Có phải bạn muốn thế này không???

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
(setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
(setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(progn
(setq t3 (substr t2 (+ m 3) n))
(setq t2 (substr t2 1 (- m 2)))
)
)
)
)
(setq L1 (atof t2)
i1 ( / (atof t3) 1000)
)
(setq m1 (atof (cdr (assoc 1 (entget (car (entsel "\nCHON TEXT CAO DO THIET KE DIEM: ")))))))
(setq s2 (- s1 (* L1 i1)))
(setq p2 (getpoint "\nchon diem cuoi doan cong"))
(setq p3 (getpoint "\nchon diem dat text"))
(if (>= (car p3) (car p2))
(progn
(setq p4 (polar p3 (/ pi 4) 1))
(setq p5 (polar p3 0 6))
(setq p6 (polar p3 (/ (- 0 pi) 4) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
(progn
(setq p4 (polar p3 (* (/ pi 4) 3) 1))
(setq p5 (polar p3 pi 6))
(setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
)

(setvar "snapmode" 0)
(setvar "osmode" 16383)

(princ)
)



Hề hề hề,
Bạn thông cảm vì mình không hiểu hết ý của bạn. Mình sửa như vầy thì lisp sẽ chỉ chạy đúng nếu cái text cao độ bạn chọn là Text, còn không đảm bảo đúng khi text đó là Mtext bạn nhé...
Nếu có gì chưa đúng bạn lại post lên nhé.
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3059 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 19 January 2011 - 03:54 PM

Hề hề hê,
Chào bạn Truongthanh,
Có phải bạn muốn thế này không???


;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
(setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
(setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(progn
(setq t3 (substr t2 (+ m 3) n))
(setq t2 (substr t2 1 (- m 2)))
)
)
)
)
(setq L1 (atof t2)
i1 ( / (atof t3) 1000)
)
(setq m1 (atof (cdr (assoc 1 (entget (car (entsel "\nCHON TEXT CAO DO THIET KE DIEM: ")))))))
(setq s2 (- s1 (* L1 i1)))
(setq p2 (getpoint "\nchon diem cuoi doan cong"))
(setq p3 (getpoint "\nchon diem dat text"))
(if (>= (car p3) (car p2))
(progn
(setq p4 (polar p3 (/ pi 4) 1))
(setq p5 (polar p3 0 6))
(setq p6 (polar p3 (/ (- 0 pi) 4) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
(progn
(setq p4 (polar p3 (* (/ pi 4) 3) 1))
(setq p5 (polar p3 pi 6))
(setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
)

(setvar "snapmode" 0)
(setvar "osmode" 16383)

(princ)
)



Hề hề hề,
Bạn thông cảm vì mình không hiểu hết ý của bạn. Mình sửa như vầy thì lisp sẽ chỉ chạy đúng nếu cái text cao độ bạn chọn là Text, còn không đảm bảo đúng khi text đó là Mtext bạn nhé...
Nếu có gì chưa đúng bạn lại post lên nhé.
Chúc bạn vui.

Thanks anh nhiều! Đúng ý em rồi! Giờ chỉ nhờ anh chỉnh lại 1 chút xíu nữa thôi đó là khi đặt text đổi vị trí 2 cái text đó lên trên xuống dưới ngược lại cụ thể là:
Cao độ thiết kế điểm nằm trên
Cao độ đáy cống nằm dưới!
Làm phiền anh thêm chút nữa!
  • 0

#3060 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 19 January 2011 - 04:14 PM

Thanks anh nhiều! Đúng ý em rồi! Giờ chỉ nhờ anh chỉnh lại 1 chút xíu nữa thôi đó là khi đặt text đổi vị trí 2 cái text đó lên trên xuống dưới ngược lại cụ thể là:
Cao độ thiết kế điểm nằm trên
Cao độ đáy cống nằm dưới!
Làm phiền anh thêm chút nữa!

Hề hề hề,
Chuyện này có nhẽ bạn làm được mà.
Chỉ cần bạn chú ý chút xíu và đổi lại chỗ này:
(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
Thành:
(command ".text" p4 "" 0 (strcat (RTOS m1 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS S2 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )

Và bạn nhớ là phải đổi ở cả hai đoạn code như vầy có trong lisp. Nếu không sẽ có lúc nó lại "u như kỵ" đó.
Hề hề hề...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.