DIỄN ĐÀN TÂM NĂNG DƯỠNG SINH PHỤC HỒI SỨC KHỎE

DIỄN ĐÀN TÂM NĂNG DƯỠNG SINH PHỤC HỒI SỨC KHỎE

Chào mừng quý vị và các bạn đến với diễn đàn http://tamnangduongsinh.forumvi.com
 
Trang ChínhPortalCalendarGalleryTrợ giúpTìm kiếmThành viênNhómĐăng kýĐăng Nhập
Hỗ trợ trực tuyến- Admin
Admin : Nguyễn Gia Sơn
Chat với Skype Admin!
Đăng Nhập
Tên truy cập:
Mật khẩu:
Đăng nhập tự động mỗi khi truy cập: 
:: Quên mật khẩu
Tổng số lượt xem
Thống kê truy cập diễn đàn
Top posters
tamnangduongsinh (345)
 
Admin (315)
 
tamphat (130)
 
Latest topics
Tìm kiếm
 
 

Display results as :
 

 


Rechercher Advanced Search

KẾT QUẢ XỔ SỐ
Keywords

Share | 
 

 Lisp nội suy cao độ điiểm thứ 3 khi biết cao độ 2 điểm

Go down 
Tác giảThông điệp
tamnangduongsinh



Tổng số bài gửi : 345
Tổng số điểm : 836
Được cảm ơn : 73
Join date : 05/12/2014

Bài gửiTiêu đề: Lisp nội suy cao độ điiểm thứ 3 khi biết cao độ 2 điểm   Tue Jan 08, 2019 5:32 pm

;; free lisp from cadviet.com
;;; this lisp was downloaded from [You must be registered and logged in to see this link.]
;; free lisp from cadviet.com
;;; this lisp was downloaded from [You must be registered and logged in to see this link.]
;; free lisp from cadviet.com
;;; this lisp was downloaded from [You must be registered and logged in to see this link.]
;;;L?y t?a d? chu?n c?a Text
(defun TD:Text-Base (ent)
(setq Ma10 (cdr (assoc 10 (entget ent))))
(setq Ma11 (cdr (assoc 11 (entget ent))))
(setq X11 (car Ma11))
(setq Ma71 (cdr (assoc 71 (entget ent))))
(setq Ma72 (cdr (assoc 72 (entget ent))))
(if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
(and (= Ma71 0) (= Ma72 3) )
(and (= Ma71 0) (= Ma72 5) )
)
Ma10
Ma11
)
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from [You must be registered and logged in to see this link.]
;;;;T?o Layer
(defun _layer2 ( name colour )
(if (null (tblsearch "LAYER" name))
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 name)
(cons 62 colour)
)
)
)
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from [You must be registered and logged in to see this link.]
;;;;Make by Thaistreetz
(defun MakeText (point string Height Ang justify Layer / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(cons 50 Ang)
(cons 8 Layer)
)
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst)
)



(defun c:clt(/ chieucao stt item1 temp1 Tdo1 X1 Y1 Z1 Caodo1 item2 Tdo2 X2 Y2 Z2 Caodo2 pt1 pt2 pt3 X3 Y3 Z3 z4 d1 d2 d dh dhz Caodo3) ;chen lien tiep tu 2 diem
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chieu cao text <"
(rtos *chieucao* 2 2)
"> :"
)
)
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(setq stt 1)
(_layer2 "Them_lt" 6)
(setq Olmode (getvar "OSMODE"))

(progn
(setq item1 (entsel "\nChon text thu nhat : "))
(setq temp1 (entget (car item1)))
(setq Tdo1 (TD:Text-Base (car item1 )))
(setq Caodo1 (cdr (assoc 1 temp1))
x1 (car Tdo1)
y1 (cadr Tdo1)
)
(setq pt1 (list x1 y1))
(setq z1 (atof Caodo1))

(setq item2 (entsel "\nChon text thu hai : "))
(setq temp2 (entget (car item2)))
(setq Tdo2 (TD:Text-Base (car item2 )))
(setq Caodo2 (cdr (assoc 1 temp2))
x2 (car Tdo2)
y2 (cadr Tdo2)
)
(setq pt2 (list x2 y2))
(setq z2 (atof Caodo2))
)

(while
(progn
(setvar "OSMODE" 512 )
(setq pt3 (getpoint "\nVi tri chen diem : "))
(setq x3 (car pt3))
(setq y3 (cadr pt3))
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
(setq d (+ d1 d2))
(setq dh (- z2 z1))
(setq dhz (* dh (/ d1 d)))
(setq z3 (+ z1 dhz))
(setq z4 0)
(setq Caodo3 (rtos z3 2 3))
(setq pt3 (list x3 y3 z4))
(MakeText pt3 Caodo3 chieucao 0 "C" "Them_lt")
(setq stt (+ stt 1))
)
)
(setvar "OSMODE" Olmode )
(princ)
)
Về Đầu Trang Go down
Xem lý lịch thành viên
 
Lisp nội suy cao độ điiểm thứ 3 khi biết cao độ 2 điểm
Về Đầu Trang 
Trang 1 trong tổng số 1 trang

Permissions in this forum:Bạn không có quyền trả lời bài viết
DIỄN ĐÀN TÂM NĂNG DƯỠNG SINH PHỤC HỒI SỨC KHỎE :: Autocad :: Lisp autocad-
Chuyển đến