nhunha_pro279 8 Báo cáo bài đăng Đã đăng Tháng 1 15, 2017 Theo ý bạn đây : (defun C:TL3( / ss L te p1 p2 textmau P)(while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) (setq p2 (getpoint p1 "\n Chon diem thu hai :")))(setq L (distance p1 p2))(initget "T")(setq p (getpoint "\nPick diem chen hoac go T de chon Text :")) (if (/= p "T") (progn (if (not textmau) (setq textmau (car(entsel "\nChon Text mau:")))) (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau)) (cons 10 p) (cons 11 p) (assoc 7 (entget textmau)) )) ) (progn (setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))(entmod te) )))) Nếu như có thể thêm vào tỉ lệ cho bản vẽ thì tốt anh Tue_NV ơ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
Banghd1983 0 Báo cáo bài đăng Đã đăng Tháng 7 8, 2017 Theo ý bạn đây : Theo ý bạn đây : Mới trả lời xong cho bạn ở chủ đề bên kia rồi. Lần sau nhớ search trước khi post bài nhé Em mới sử dụng Cad, loát lisp của bác về và App rồi nhưng khi gõ lệnh lại không được bác ah 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
tientracdia 16 Báo cáo bài đăng Đã đăng Tháng 7 9, 2017 - hi bạn thông cảm, sáng giờ bị sếp dí chưa kip sữa cho bạn ^^, giờ mới rãnh xem, bạn xem nhoc sữa vậy vừa ý chưa hì :P ;=============================================================================================================== (defun K:style (MyStyle MyFont) (entmake (list (cons 0 "STYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbTextStyleTableRecord") (cons 2 MyStyle) (cons 3 MyFont) (cons 70 0)))) ;;;;; ;============================ ;;-------------------------------------- (defun K:layer (ten clr) (if (null (tblsearch "LAYER" ten)) (entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 ten) (cons 62 clr)) ) ) ) ;;;;;;;;;;------------------------------------------- ;;;;;;;;;;;============================================================ (defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (if xdata (setq Lst (append lst (list (cons -3 (list xdata)))))) (entmakex Lst)) ;end;================================= ;;; (defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata) (entmakex (list '(0 . "LINE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 10 PT1) (cons 11 PT2) (cons -3 (if xdata (list xdata) nil))))) ;;;;;;-------------------------------------------------------------------------------------------- ;ham tao text 2 (defun taotext (point height string justify layer textstyle mau / lst) (setq lst (list '(0 . "TEXT") (cons 10 point) (cons 40 height) (cons 1 string) (cons 8 (if layer layer (getvar "clayer"))) (cons 7 (if textstyle textstyle (getvar 'textstyle))) (cons 62 (if mau mau 256)) ) justify (strcase justify)) (cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point))))) ((= 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))))) ) (entmakex Lst) );end mktext ;-------------------------------------- (alert "LSP xuat bang thong ke goc canh , lenh: KKP") ;;---------------------------------------------------------------------------------------------- (defun c:kkp(/ ss ename lst lstcanh lstgoc dem p1 p2 p3 d ang1 ang2 goc kdo dau i k m f j pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 goc270 pt tt ll gg ptt pll pgg old canh kgoc) (vl-load-com) (setq old (getvar 'osmode)) (setvar 'osmode 0) (if (null (tblsearch "style" "ARIAL-bang")) (K:style "ARIAL-bang" "arial.ttf")) (K:layer "bang-goccanh" 4) (prompt "chon PLine:") (setq ss (ssget "+.:E:S" '((0 . "*POLYLINE")))) (if ss (progn ;-------------------------------------------------------------------- (setq ename (ssname ss 0)) (setq lst (acet-geom-vertex-list ename)) (setq lstcanh nil lstgoc nil) ;================================================ (setq p1 (car lst) dem 1) ;=============================================================== (while (< dem (length lst)) (setq p2 (nth dem lst)) (setq d (distance p1 p2)) (setq lstcanh (append lstcanh (list d))) (setq p1 p2 dem (1+ dem)) (princ) ) (setq bdau 1) (foreach x lst (taotext (polar x (/ pi 2) 0.5) 0.8 (itoa bdau) "M" "bang-goccanh" "ARIAL-bang" 1) (setq bdau (1+ bdau)) ) ;================================================================================== (setq p1 (car lst) dem 1) ;=============================================================================== (while (< dem (1- (length lst))) (setq p2 (nth dem lst)) (setq p3 (nth (1+ dem) lst)) (setq ang1 (angle p2 p1) ang2 (angle p2 p3)) (setq goc (abs (- ang1 ang2))) (if (> goc PI) (setq goc (- (* 2 pi) goc)) ) ;================================================================================ (setq kdo (* (/ goc pi) 180.0)) (setq lstgoc (append lstgoc (list kdo))) ;==================================================================================== (setq p1 p2 dem (1+ dem)) ) ;======================================================================================== (setq pt (getpoint "\nChon diem dat bang:")) (if (/= pt nil) (progn (setq pt1 (mapcar '+ pt (list 45.0 0.0 0.0)) pt2 (mapcar '+ pt (list 0.0 -4.0 0.0)) pt3 (mapcar '+ pt (list 45.0 -4.0 0.0)) pt4 (mapcar '+ pt (list 5.0 0.0 0.0)) pt5 (mapcar '+ pt (list 25.0 0.0 0.0))) ;-------------------------------------------------- (taotext (mapcar '+ pt (list 2.5 -2.0 0.0)) 1.8 "TT" "M" "bang-goccanh" "ARIAL-bang" nil) (taotext (mapcar '+ pt (list 15.0 -2.0 0.0)) 1.8 "L" "M" "bang-goccanh" "ARIAL-bang" nil) (taotext (mapcar '+ pt (list 35.0 -2.0 0.0)) 1.8 "GOC" "M" "bang-goccanh" "ARIAL-bang" nil) (makeline pt2 pt3 nil nil nil nil) ;----------------------------------------------------- (setq i 1) (while (<= i (length lst)) (progn ;-------------------------- (setq tt (list 2.5 (- (* -5.0 i) 2.0) 0.0)) (setq ptt (mapcar '+ pt tt)) ;-------------------------------- ;------------------------------ (taotext ptt 1.8 (itoa i) "M" nil nil 4) (setq i (1+ i)) ) ) ; end while ;=============================================== (setq k 0 m 1) (repeat (- (length lst) 1) (setq ll (list 15.0 (- (* -5.0 m) 4.5) 0.0)) (setq pll (mapcar '+ pt ll)) (setq canh (nth k lstcanh)) (taotext pll 1.8 (rtos canh 2 3) "M" "bang-goccanh" "ARIAL-bang" nil) (setq m (1+ m)) (setq k (1+ k)) ) ;============================================== (setq f 0 j 1) (repeat (- (length lst) 2) (setq gg (list 35.0 (- (* -5.0 j) 7.0) 0.0)) (setq pgg (mapcar '+ pt gg)) (setq kgoc (nth f lstgoc)) (taotext pgg 1.8 (chuyendo kgoc) "M" "bang-goccanh" "ARIAL-bang" nil) (setq f (1+ f)) (setq j (1+ j)) ) ;---------------------------------------- (setq goc270 (- 0 (/ PI 2))) (setq pt6 (polar pt goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt7 (polar pt1 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt8 (polar pt5 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt9 (polar pt4 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))) (makeline pt4 pt9 nil nil nil nil) (makeline pt5 pt8 nil nil nil nil) (makepline (list pt pt1 pt7 pt6) 1 nil nil nil nil) ;============================================= ) ;end progn if ) ; end if pt ); end progn ss (alert "ban chua chon Pline nao") ) ;end if ss ;======================================================================================== (alert "Xong ^^") (setvar 'osmode old) (princ) ); end Kkp ;=================================================================================== ;========================chuyen sang do phut giay (defun chuyendo(so / done kphgiay kphut kgiay xong) (setq done (fix so)) (setq kphgiay (* (- so done) 60)) ;14,76 (setq kphut (fix kphgiay)) ; 14 (setq kgiay (rtos (* (- kphgiay kphut) 60) 2 0)) ;46" (setq xong (strcat (itoa done) "%%d" (itoa kphut) "'" kgiay "''")) ) BẠN CÓ THỂ BỔ SUNG VẺ GÓC CẠNH TRÊN SƠ ĐỒ LƯỚI THÌ TUYỆT LUÔN 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
lephuocly 7 Báo cáo bài đăng Đã đăng Tháng 2 28, 2021 Vào lúc 26/12/2011 tại 14:48, Tue_NV đã nói: Tue_NV là nick của Võ Quang Tuệ. Võ Quang Tuệ lập ra nick Tue_NV .. hề hề Yêu cầu của bạn đây : tl3.lsp [✎] (defun C:TL3( / ss L te p1 p2 hei P) (while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) (setq p2 (getpoint p1 "\n Chon diem thu hai :")) ) (setq L (distance p1 p2)) (initget "T") (setq p (getpoint "\nPick diem chen hoac go T de chon Text :")) (if (/= p "T") (progn (if (not hei) (setq hei (getreal "\nNhap chieu cao Text:"))) (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (cons 40 hei) (cons 10 p) (cons 11 p))) ) (progn (setq te (entget(car("\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)) (entmod te) ) ) ) ) Bạn chú ý : Text trong trường hợp mà bạn pick chọn lấy theo Style hiện hành Tue_NV đã lập ra 2 trường hợp : Bạn thích pick vào Text thì gõ T thích chọn điểm chèn cho Text thì pick chọn điểm chèn cho Text Đúng ý rồi nhé Cảm ơn anh ! Tôi có việc cần sự giúp đỡ của anh(càng nhanh càng tốt) như sau: Tương tự như lisp trên của anh nhưng thỏa mãn thêm điều kiện sau: Khi pick điểm A tới B thì kết quả là số dương, ngược lại pick B tới A thì cho kết quả âm. 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
alisp 72 Báo cáo bài đăng Đã đăng Tháng 2 28, 2021 28 phút trước, lephuocly đã nói: Cảm ơn anh ! Tôi có việc cần sự giúp đỡ của anh(càng nhanh càng tốt) như sau: Tương tự như lisp trên của anh nhưng thỏa mãn thêm điều kiện sau: Khi pick điểm A tới B thì kết quả là số dương, ngược lại pick B tới A thì cho kết quả âm. Bác đề nghị vui thiệt, biết lấy cái nào làm chuẩn để lấy dấu + hay - , cái bên trái, cái bên trên? Bác Tue_NV dạo này ít thấy vào CV nữa, không "càng nhanh càng tốt" được đâ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
nguyenbd1 13 Báo cáo bài đăng Đã đăng Tháng 4 28, 2022 Vào lúc 26/12/2011 tại 14:22, vantuan18nd đã nói: Mình có nhờ Anh Vo Quang Tue ( hay Võ Quang Tuệ gì gì đấy :mellow: ) làm cho Lisp đo khoảng cách rất hay như sau -chọn điểm thứ nhất -chọn điểm thứ hai -Kết quả thay cho một số có sẵn tl3.lsp [✎] (defun C:TL3( / ss L te p1 p2) (while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) (setq p2 (getpoint p1 "\n Chon diem thu hai :")) ) (setq L (distance p1 p2)) (setq te (entget(car("\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)) (entmod te) ) ) -> Enter để kết thúc lệnh - Bây giờ mình muốn kết quả tìm được phải ghi ra nơi mình chọn, không phải là thay cho một 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
nguyenbd1 13 Báo cáo bài đăng Đã đăng Tháng 4 28, 2022 Cũng là vấn đề cũ nhưng là đi theo hướng khác. E muốn lấy phép chia của 2 đoạn thẳng. Câu trúc như sau. Chọn điểm 1 và 2 tinh được khoảng cách 1 và 2 là a sau đó chọn điểm 3 chọn điểm 4 tình được khoảng cách 3 và 4 là b sau đó lấy a chia b và lấy kết quả đó ghi ra màn hình autocad. Rất mong anh e giúp đỡ 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
huunhantvxdts 195 Báo cáo bài đăng Đã đăng Tháng 4 28, 2022 1 giờ} trướ}c, nguyenbd1 đã nói: Cũng là vấn đề cũ nhưng là đi theo hướng khác. E muốn lấy phép chia của 2 đoạn thẳng. Câu trúc như sau. Chọn điểm 1 và 2 tinh được khoảng cách 1 và 2 là a sau đó chọn điểm 3 chọn điểm 4 tình được khoảng cách 3 và 4 là b sau đó lấy a chia b và lấy kết quả đó ghi ra màn hình autocad. Rất mong anh e giúp đỡ (defun c:CKC (/ cur_lay oldos p1 p2 p3 p4 p kc1 kc2 heso) (setq cur_lay (getvar "clayer" )) (setq oldos (getvar "OSMODE")) (setvar "osmode" 0) (setvar "cmdecho" 0) (vl-load-com) (setq p1 (getpoint "\nPick diem thu 1")) (setq p2 (getpoint p1 "\nPick diem thu 2")) (setq p3 (getpoint "\nPick diem thu 3")) (setq p4 (getpoint p3 "\nPick diem thu 4")) (setq kc1 (distance p1 p2)) (setq kc2 (distance p3 p4)) (setq heso (/ kc1 kc2)) (setq p (getpoint "\nPick diem dat text")) (MakeText p (rtos heso 2 2) 2 0 "MC" nil 1 nil) (setvar "clayer" cur_lay) (setvar "osmode" oldos) (setvar "CMDECHO" 1) (princ) ) (defun MakeText (point string Height Ang justify Layer color Style / Lst); Ang: Radial (setq Lst (list '(0 . "TEXT") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 Height) (cons 1 string) (cons 50 Ang) (cons 7 (if Style Style (getvar "Textstyle"))) ) 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) ) Gửi bạn 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
