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

#1401 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 09 July 2010 - 11:30 AM

(defun c:RB (/ SS NAME NNAME)
(setq SS (ssget "I"))
(if (not SS)
(progn
(prompt "- Select block for rename")
(setq SS (ssget '((0 . "insert"))))
);progn
);if
(setq NAME (cdr (assoc 2 (entget (ssname SS 0)))))
(setq NNAME(getstring (strcat "\nCurrent block name: " NAME "\nEnter new name:")))
(command "-rename" "B" NAME NNAME)
(princ)
);end
Nếu cần ngay thì bạn dùng tạm code này. mình không có thời gian làm hộp thoại cho bạn.

Để tránh t/hợp chọn nhiều Block nhưng chỉ đổi đuợc tên 1 Block (đôi khi không đúng tên Block muốn đổi), bạn thay dòng :
(setq SS (ssget '((0 . "insert"))))
bằng : (while (not(setq ss (ssget "+.:S:N" (list (cons 0 "INSERT"))))))


Tôi cần 1 LISP đổi tên block với yêu cầu sau:
- chạy LISP
- chọn block cần đổi tên
- nhập tên mới

(Trong AutoCAD đã có lệnh REN nhưng không cho mình chọn block muốn đổi tên, mà phải tìm tên của nó trước rồi mới vô đó tìm trong 1 đống tên :cheers:, đối với file có nhiều block tên dạng như A$12345678 thì :blink:bó tay ).

Tôi cũng có viết 1 VBA tương tự (nhưng nó load vô phức tạp hơn lisp) nên muốn nhờ cao thủ chuyển sang LISP dùm. Với lại CAD sau này ko tích hợp sẵn VBA như trước nữa mà phải tự cài thêm nên muốn chuyển cho máy khác cũng hơi phê. Thêm phần FORM cho nó nữa thì càng tốt :cheers:. (Mới tập tành viết VBA nên có nhiều lỗi nhưng đc cái thực hiện đúng ý đồ của mình, mong chỉ giáo :D)
...............

Gửi bạn Lisp đổi tên Block.Hình đã gửi

file : download
bao gồm :
- File BlockRename.LSPBlockRename.dcl để "ngâm cứu"
- file BlockRename.vlx (chỉ cần load và run).
  • 5

#1402 ut_cung

ut_cung

    biết vẽ line

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

Đã gửi 09 July 2010 - 02:52 PM

@ Nguyen Hoanh!
Bác Hoành ơi, u đang dùng cái mplot của Bác, u thấy rất hay nhưng có 1 chút bất tiện là nó không sử dụng được khi in bên layout. Nhờ Bác sửa lại giúp u với.
Cảm ơn Bác nhiều! Chúc bác sức khoẻ!
  • 0

#1403 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 09 July 2010 - 03:26 PM

Mình muốn xin 1 cái líp như sau:
-Nhập lệnh
-Đánh tên text cần đổi: VD: đất ( chú ý là khi đánh vào không cần biết là thường hay hoa)
-Tìm trên bản vẽ tất cả text nào tên đất đều đưa về 1 layer: đất
(chú ý text có thể là 1 số : vd : 1,25 chẳng hạn.
Mong các cao thủ giúp đỡ, cám ơn.
  • 0

#1404 tiazu

tiazu

    biết zoom

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

Đã gửi 12 July 2010 - 03:14 PM

Bạn thay dòng này :
(setq NNAME(getstring (strcat "\nCurrent block name: " NAME "\nEnter new name:")))
bằng dòng này :
(setq NNAME(getstring t (strcat "\nCurrent block name: " NAME "\nEnter new name:")))
Đã đặt tên Block có khoảng trăng rồi đấy nhé



Để tránh t/hợp chọn nhiều Block nhưng chỉ đổi đuợc tên 1 Block (đôi khi không đúng tên Block muốn đổi), bạn thay dòng :
(setq SS (ssget '((0 . "insert"))))
bằng : (while (not(setq ss (ssget "+.:S:N" (list (cons 0 "INSERT"))))))
Gửi bạn Lisp đổi tên Block.Hình đã gửi

file : download
bao gồm :
- File BlockRename.LSPBlockRename.dcl để "ngâm cứu"
- file BlockRename.vlx (chỉ cần load và run).



Cám ơn 3 người rất nhiều :D

  • 0

#1405 leducthovn

leducthovn

    biết zoom

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

Đã gửi 12 July 2010 - 05:21 PM

Các bạn cho xin lsp in nhiều trang trong layout của cad 2005 trở lên,khung tên không phải là block nhé.cảm ơn nhiều.
email:leducthovn@yahoo.com
Giúp mình email nhé.Thanks!
Các bạn giúp mình sớm được không a
  • 0

#1406 dotrungkien_qh46

dotrungkien_qh46

    Chưa sử dụng CAD

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

Đã gửi 12 July 2010 - 10:12 PM

Chào các bạn.Mình đang cần lisp đóng băng nhanh các layer (freeze or thaw in all viewports và freeze or thaw in current viewports).Mong các bạn giúp mình nhé.Xin chân thành cảm ơn mọi người.
  • 0

#1407 hugo3d

hugo3d

    Chưa sử dụng CAD

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

Đã gửi 13 July 2010 - 11:05 AM

Hi all,

Mình cần đoạn lisp chuyển Text từ Font Vni sang Unicode, xin các bác giúp với!
Cho mình hỏi thêm, Lisp chuyển từ Vni sang TCVN đã có trên này, có 1 vài từ chưa convert được (VD: "màu hạt dẻ" , mình chọn mà nó cứ im ru...) như vậy là thiếu mã font phải không?
Không biết mã các loại font có thể tìm thêm ở đâu vậy? (Vni, TVCN, Unicode,...)
Sorry mình có post 1 nội dung tương tự trong topic "chuyển bảng mã từ TCVN3 sang UNICODE", đừng cho là mình spam, vì mình nghĩ pót lại trong topic này đúng hơn.

Thanks all,
Hugo3d
  • 0

#1408 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 13 July 2010 - 02:29 PM

Mình muốn xin 1 cái líp như sau:
-Nhập lệnh
-Đánh tên text cần đổi: VD: đất ( chú ý là khi đánh vào không cần biết là thường hay hoa)
-Tìm trên bản vẽ tất cả text nào tên đất đều đưa về 1 layer: đất
(chú ý text có thể là 1 số : vd : 1,25 chẳng hạn.
Mong các cao thủ giúp đỡ, cám ơn.

Sao không thấy cao thủ nào ra tay nghĩa hiệp giúp dùm mình
  • 0

#1409 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 13 July 2010 - 10:07 PM

Nhờ mấy bác cái này rất gấp, nhất là bác Tue_NV, mình có cái file như sau:
http://www.cadviet.c...goi_cadviet.dwg
Mấy bác xem dùm trong file này là hatch gì mà khi xài lisp H2P nó tạo ra 1 cái polyline kì cục không theo hatch, tại sao không đổi nó thành region được vậy. Cái này thật sự đang cần giải đáp gấp mong các cao thủ ra tay sớm dùm , cám ơn
  • 0

#1410 thuphong

thuphong

    biết vẽ circle

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

Đã gửi 14 July 2010 - 11:50 AM

Gửi bạn Lisp đổi tên Block.Hình đã gửi
.............

Trước hết xin cảm ơn Gia Bách đã chia sẻ, giúp đỡ cho mình và mọi người một Lisp rất thiết thực. :D Nhân đây nhờ Bạn xem lại giúp giùm mình Lisp trên, không hiểu sao khi mình load lên để chạy, sau khi rename block, ok, nó lại không thấy thay đổi tên. Lần nữa xin cảm ơn Bạn
  • 0

#1411 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 July 2010 - 02:22 PM

Trước hết xin cảm ơn Gia Bách đã chia sẻ, giúp đỡ cho mình và mọi người một Lisp rất thiết thực. :D Nhân đây nhờ Bạn xem lại giúp giùm mình Lisp trên, không hiểu sao khi mình load lên để chạy, sau khi rename block, ok, nó lại không thấy thay đổi tên. Lần nữa xin cảm ơn Bạn

Trước khi nhấn Button OK thì thuphong hãy nhấn Button Rename To trước cái đã
  • 2

#1412 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 14 July 2010 - 09:08 PM

Nhờ mấy bác cái này rất gấp, nhất là bác Tue_NV, mình có cái file như sau:http://www.cadviet.com/upfiles/3/goi_cadviet.dwg
Mấy bác xem dùm trong file này là hatch gì mà khi xài lisp H2P nó tạo ra 1 cái polyline kì cục không theo hatch, tại sao không đổi nó thành region được vậy. Cái này thật sự đang cần giải đáp gấp mong các cao thủ ra tay sớm dùm , cám ơn

BÁC HOÀNH ỚI, HELP ME
  • 0

#1413 thanh1401

thanh1401

    biết pan

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

Đã gửi 15 July 2010 - 10:08 AM

BÁC HOÀNH ỚI, HELP ME

Xin các bro cho mình code lisp cửa đi 1 cánh và 2 cánh với.
  • 0

#1414 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 15 July 2010 - 03:02 PM

Nhờ mấy bác cái này rất gấp, nhất là bác Tue_NV, mình có cái file như sau:http://www.cadviet.com/upfiles/3/goi_cadviet.dwg
Mấy bác xem dùm trong file này là hatch gì mà khi xài lisp H2P nó tạo ra 1 cái polyline kì cục không theo hatch, tại sao không đổi nó thành region được vậy. Cái này thật sự đang cần giải đáp gấp mong các cao thủ ra tay sớm dùm , cám ơn

Sao không thấy ai hết vậy ta, mấy bác dạo này bận lắm chăng.
  • 0

#1415 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 16 July 2010 - 03:45 PM

Nhờ mấy bác cái này rất gấp, nhất là bác Tue_NV, mình có cái file như sau:
http://www.cadviet.c...goi_cadviet.dwg
Mấy bác xem dùm trong file này là hatch gì mà khi xài lisp H2P nó tạo ra 1 cái polyline kì cục không theo hatch, tại sao không đổi nó thành region được vậy. Cái này thật sự đang cần giải đáp gấp mong các cao thủ ra tay sớm dùm , cám ơn

Sao vẫn không thấy ai hết vậy nhỉ
  • 0

#1416 t3pubt

t3pubt

    biết pan

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

Đã gửi 16 July 2010 - 04:33 PM

NHỜ CÁC BẠN SỬA DÙM MÌNH LISP XOAY TEXT .
lisp này xoay text bằng pick diem 1 va 2 nó sẽ xoay theo

(defun C:xoaydt
(setq OLDOS (GETVAR "osmode"512))
(SETVAR "osmode" 512)
(setq OLDERR *ERROR*)
(setq *ERROR* NEWERR)
(setq DT (ENTSEL "\nChon Text can xoay: "))
(cond (= (CDR (ASSOC 0 (ENTGET (CAR DT)))) "MTEXT") (
(cond (= (CDR (ASSOC 0 (ENTGET (CAR DT)))) "TEXT") (
it's OR skip next 6 bytes -> 3063
it's OR skip next 6 bytes -> 3063
(REDRAW (CAR DT) 3)
(setq PT1 (GETPOINT "\nDiem thu 1: "))
(setq PT2 (GETPOINT PT1 "\nDiem thu 2: "))
(setq DIST (DISTANCE PT1 PT2))
(setq DT (ENTGET (CAR DT)))
(setq GL (ANGLE PT1 PT2))
(setq GL (- GL PI))
(setq GL (- GL PI))
(setq GL (- GL (* 2 PI)))
(setq DT (SUBST (CONS Then OR Else GL) (ASSOC 50 DT) DT))
(ENTMOD DT)
(SETVAR "osmode" OLDOS)
(setq *ERROR* OLDERR)
(princ"\n hoan thanh")
)


  • 0

#1417 nani

nani

    biết vẽ circle

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

Đã gửi 16 July 2010 - 09:13 PM

cái này thục ra trong express cung co ban a, mình đã sửa thành tên lệnh ss, xoay text song song với mọt line http://www.cadviet.c...ng_voi_line.lsp
  • 0

#1418 funnyzui

funnyzui

    biết vẽ arc

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

Đã gửi 17 July 2010 - 12:25 AM

Chào mọi người, mình mới tìm thấy đoạn code này. Nhưng ko hiểu sao có lệnh dùng đc, có lệnh ko sử dụng đc. Sẵn nhờ mọi người giúp mình lược bớt code nếu đoạn code nào thừa vì cái này nằm trong 1 bộ lisp thống kê mà ông anh mình cho.

Mấy cái lệnh SRS, SVN, SVN1 thì dễ hiểu rồi. Lệnh CST thì cũng ok, nhưng cách sử dụng hơi kỳ kỳ. Nó ko chuyển về đc STYLE hiện hành là STYLE mình chọn ngay sau khi click mà phải thêm 1 lần chọn vào hàng chữ đó nữa. Còn lệnh NST là gì? làm gì? thì hông hiểu và hông sử dụng đc. Vậy nếu nó thừa mình bỏ đi cũng ko sao fải ko? Hơi tiếc vì cũng tò mò muốn biết chức năng của nó <_<

Mình thấy trên dđ có lệnh LH, LL nhằm chuyển về layer hiện hành và chuyển layer đối tượng về layer hiện hành rất hay. Vì vậy, xin mạn phép mọi người viết giùm lisp có chức năng tương tự cho TEXT STYLE và DIM STYLE. Xin cảm ơn mọi người!

Đây là code đã nói:
Chuyen TEXT STYLE hien hanh
(defun C:SRS()
(setvar "TEXTSTYLE" "RS")
(princ)
)
(defun C:SVN()
(setvar "TEXTSTYLE" "VN")
(princ)
)
(defun C:SVN1()
(setvar "TEXTSTYLE" "VN1")
(princ)
)
(defun C:CST()
(princ "\nChon 1 dong chu thuoc kieu chu muon chuyen thanh kieu chu hien hanh")
(while (= ss nil) (setq ss (ssget)))
(setq Newstyle (cdr (assoc 7 (entget (ssname ss 0)))))
(setvar "TEXTSTYLE" Newstyle)
(princ (strcat "Kieu chu duoc chon " Newstyle))
(setq ss nil)
(princ)
)
(defun C:NST()
(setvar "OSMODE" 0)
(setq Stylelist "")
(setq Stlist (tblnext "STYLE" T))
(setq Stylelist (list (strcat (cdr (assoc 2 Stlist)) "\t" (cdr (assoc 3 Stlist)) "\t" (itoa (fix (cdr (assoc 40 Stlist)))))))
(setq i 0)
(setq n "0")
(while (/= Stlist nil)
(setq Stlist (tblnext "STYLE"))
(if (/= Stlist nil)
(progn
(setq Stylelist (append Stylelist (list (strcat (cdr (assoc 2 Stlist)) "\t" (cdr (assoc 3 Stlist)) "\t" (itoa (fix (cdr (assoc 40 Stlist))))))))
(setq i (+ i 1))
(if (= (cdr (assoc 2 Stlist)) (getvar "TEXTSTYLE")) (setq n (itoa i)))
)
)
)
(setq Dial (load_dialog "TEST.DCL"))
(if (not (new_dialog "CHU" Dial)) (exit))
(start_list "styles")
(mapcar 'add_list Stylelist)
(end_list)
(set_tile "styles" n)
(action_tile "styles" "(setq Ne $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq OK (start_dialog))
(unload_dialog Dial)
(if (or (= OK 0) (= Ne nil)) (exit))
(setq Newlist (nth (atoi Ne) Stylelist))
(setq i 0)
(setq Tam "")
(while (and (<= i (strlen Newlist)) (/= Tam "\t"))
(setq i (+ i 1))
(setq Tam (substr Newlist i 1))
)
(setq Newstyle (substr Newlist 1 (- i 1)))
(command "TEXTSTYLE" Newstyle)
(setvar "OSMODE" 1)
(princ (strcat "Kieu chu hien hanh " Newstyle))
(princ)
)

  • 0

#1419 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 17 July 2010 - 12:55 PM

[quote name='Tue_NV' date='Jul 6 2010, 8:22' post='100057']
Sony hãy thử với đoạn code này.
Đây là Lisp nội suy cao độ Z của 1 điểm P khi biết P1(x1,y1,z1) và P2(x2,y2,z2) với z1 và z2 nhập từ bàn phím và điều kiện P phải nằm trên P1P2 (P có thể nằm trong hoặc nằm ngoài đoạn P1P2

(defun c:noisuy()
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :"))
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq dis (distance p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(command "snap" "R" p1 p2)
(setvar "orthomode" 1)
(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
(setq a (distance p p1))
(if (or (equal (+ (distance p1 p) (distance p p2)) dis 0.000001)
(equal (+ (distance p p1) dis) (distance p p2) 0.000001)
(equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
)
;(alert "\n P nam tren P1 P2")
(PROGN
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) ))) (in) )
(progn (setq Z (+ Z1 (* tana a))) (in))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) ))) (in) )
(progn (setq Z (+ Z2 (* tana a))) (in) )
)
)

);PROGN
(alert "\n P khong nam tren P1 P2")
);if
);while
(command "snap" "R" '(0 0 0) 0)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in()
(princ "\n gia tri noi suy tai diem P :") (princ Z)
)


Bác Tue_NV ơi, có thể bổ sung thêm việc ghi các kết quả ra text treen banr ve được không. Các kết quả ở lisp này bác toàn ghi ở command. Cám ơn bác nhiều
  • 0

#1420 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 July 2010 - 02:52 PM

Chào mọi người, mình mới tìm thấy đoạn code này. Nhưng ko hiểu sao có lệnh dùng đc, có lệnh ko sử dụng đc. Sẵn nhờ mọi người giúp mình lược bớt code nếu đoạn code nào thừa vì cái này nằm trong 1 bộ lisp thống kê mà ông anh mình cho.

Mấy cái lệnh SRS, SVN, SVN1 thì dễ hiểu rồi. Lệnh CST thì cũng ok, nhưng cách sử dụng hơi kỳ kỳ. Nó ko chuyển về đc STYLE hiện hành là STYLE mình chọn ngay sau khi click mà phải thêm 1 lần chọn vào hàng chữ đó nữa. Còn lệnh NST là gì? làm gì? thì hông hiểu và hông sử dụng đc. Vậy nếu nó thừa mình bỏ đi cũng ko sao fải ko? Hơi tiếc vì cũng tò mò muốn biết chức năng của nó <_<

Mình thấy trên dđ có lệnh LH, LL nhằm chuyển về layer hiện hành và chuyển layer đối tượng về layer hiện hành rất hay. Vì vậy, xin mạn phép mọi người viết giùm lisp có chức năng tương tự cho TEXT STYLE và DIM STYLE. Xin cảm ơn mọi người!
....

Chào 'funnyzui'
1./ Lisp CST lấy text style của đối tượng đầu tiên trong tập chọn ss (thiết lập bởi hàm ssget)
Ta không nên sử dụng cách này.
'funnyzui' hãy sử dụng theo cách này : Pick chọn 1 đối tượng -> lấy Text Style của đối tượng này -> thiết lập làm Text style hiện hành

2./ Lisp NST gọi 1 file hộp thoại mang tên là TEST.DCL -> Load dialog :CHU trong file TEST.DCL.
Trong dialog CHU này có định nghĩa 1 hộp danh sách gọi là List_box. Trong List_box này chứa tên Text Style, font chữ của Text Style và chiều cao của Text Style đó (Toàn bản vẽ). Khi bạn pick chọn 1 phần tử trong Listbox và OK thì phần tử mang tên Text style đó làm style hiện hành.
File Lísp của bạn không chạy được do thiếu file TEST.DCL nên không chạy được

@Sony : Code chỉnh lại cho Sony đây :

(defun c:noisuy()
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :"))
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq cao (getdist "\n Nhap chieu cao chu :"))
(setq dis (distance p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(command "snap" "R" p1 p2)
(setvar "orthomode" 1)
(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
(setq a (distance p p1))
(if (or (equal (+ (distance p1 p) (distance p p2)) dis 0.000001)
(equal (+ (distance p p1) dis) (distance p p2) 0.000001)
(equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
)
;(alert "\n P nam tren P1 P2")
(PROGN
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z1 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z2 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)

);PROGN
(alert "\n P khong nam tren P1 P2")
);if
);while
(command "snap" "R" '(0 0 0) 0)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(entmake (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

Chúc các bạn 1 ngày cuối tuần vui vẻ
  • 2