nhoclangbat
-
Số lượng nội dung
1.306 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
35
Bài đăng được đăng bởi nhoclangbat
-
-
- lsp hơi dài ^^, bạn thử đưa file minh họa bạn chạy với lsp này, mọi người chạy thử để nắm vấn đề rùi mới sữa thử theo y/c của bạn ^^
-
- Căng đó Hieu ^^
-
;;;;;;;;;;;============================================================ (defun K:pline (listpoint closed Layer clr / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if clr clr 256)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (entmakex Lst)) ;end;================================= ;=================================HAM ENTMAKE VE CICLE (defun K:tron (point R Layer Color) (entmakex (list '(0 . "CIRCLE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 R) ))) ;end;================================= ;ham tao text 3 (defun K:text(pt height string justify layer textstyle mau ang / lst) (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 (if ang ang 0)) (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 pt))))) ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt))))) ) (entmakex Lst) );end K:text ;hàm t?o textstyle (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)))) ;===============================================****************************++++++++++BAI 4+++++++++*********************=========== (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 C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj) (vl-load-com) (setq old (getvar "OSMODE") oldd (getvar "cmdecho")) (setvar "cmdecho" 0) (setq str2 (getint "\nNhap so text trong tam:")) (setq bk (getreal "\nNhap ban kinh:")) (setvar "OSMODE" 512) (initget 1) (setq pt1 (getpoint "\nChon diem dau: ")) (setvar "OSMODE" 0) (setq pt2 (getpoint pt1 "\ndiem thu 2: ")) (setq goc (angle pt1 pt2)) (setq str1 (getstring 1 "\nNhap text ngang: ")) (setq lenstr1 (strlen str1)) (setq pt3 (getpoint pt2 "\nHuong diem cuoi: ")) (if (< (car pt2) (car pt3)) (progn (setq vttext (polar pt2 (/ pi 4) 1.5)) (setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil)) (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp)) (setq pdau (vlax-safearray->list minp)) (setq pcuoi (vlax-safearray->list maxp)) (setq kcx (- (car pcuoi) (car pdau))) (setq pt3 (polar pt2 0 (+ 2.0 kcx))) (setq pt4 (polar pt3 0 bk)) ) (progn (setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5)) (setq obj (K:text vttext 2.5 str1 "R" nil nil nil nil)) (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp)) (setq pdau (vlax-safearray->list minp)) (setq pcuoi (vlax-safearray->list maxp)) (setq kcx (- (car pcuoi) (car pdau))) (setq pt3 (polar pt2 PI (+ 2 kcx))) (setq pt4 (polar pt3 pi bk)) ) );if (K:pline (list pt1 pt2 pt3) nil nil nil) (K:tron pt4 bk nil nil) (K:text pt4 3.0 (itoa str2) "M" nil nil nil nil) (setvar "OSMODE" old) (setvar "cmdecho" oldd) (princ) )- hi tối giờ nhoc bận, đã sữa cho bạn theo hiện hành ^^
-
- bạn test thử xem đúng ý chưa hì ^^
;;;;;;;;;;;============================================================ (defun K:pline (listpoint closed Layer clr / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if clr clr 256)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (entmakex Lst)) ;end;================================= ;=================================HAM ENTMAKE VE CICLE (defun K:tron (point R Layer Color) (entmakex (list '(0 . "CIRCLE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 R) ))) ;end;================================= ;;ham tao text 3 (defun K:text(pt height string justify layer textstyle mau ang / lst) (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 (if ang ang 0)) (cons 8 layer) (cons 7 textstyle) (cons 62 (if mau mau 256)) ) justify (strcase justify)) (cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt))))) ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt))))) ) (entmakex Lst) ) ;end K:text ;hàm t?o textstyle (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)))) ;===============================================****************************++++++++++BAI 4+++++++++*********************=========== (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 C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj) (vl-load-com) (setq old (getvar "OSMODE") oldd (getvar "cmdecho")) (setvar "cmdecho" 0) (if (null (tblsearch "style" "VHELVEI")) (K:style "VHELVEI" "VHELVEI.ttf")) (if (null (tblsearch "layer" "GHI-CHU")) (K:layer "GHI-CHU" 7)) (setq str2 (getint "\nNhap so text trong tam:")) (setq bk (getreal "\nNhap ban kinh:")) (setvar "OSMODE" 512) (initget 1) (setq pt1 (getpoint "\nChon diem dau: ")) (setvar "OSMODE" 0) (setq pt2 (getpoint pt1 "\ndiem thu 2: ")) (setq goc (angle pt1 pt2)) (setq str1 (getstring 1 "\nNhap text ngang: ")) (setq lenstr1 (strlen str1)) (setq pt3 (getpoint pt2 "\nHuong diem cuoi: ")) (if (< (car pt2) (car pt3)) (progn (setq vttext (polar pt2 (/ pi 4) 1.5)) (setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil)) (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp)) (setq pdau (vlax-safearray->list minp)) (setq pcuoi (vlax-safearray->list maxp)) (setq kcx (- (car pcuoi) (car pdau))) (setq pt3 (polar pt2 0 (+ 2.0 kcx))) (setq pt4 (polar pt3 0 bk)) ) (progn (setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5)) (setq obj (K:text vttext 2.5 str1 "R" "GHI-CHU" "VHELVEI" nil nil)) (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp)) (setq pdau (vlax-safearray->list minp)) (setq pcuoi (vlax-safearray->list maxp)) (setq kcx (- (car pcuoi) (car pdau))) (setq pt3 (polar pt2 PI (+ 2 kcx))) (setq pt4 (polar pt3 pi bk)) ) );if (K:pline (list pt1 pt2 pt3) nil "GHI-CHU" nil) (K:tron pt4 bk "GHI-CHU" nil) (K:text pt4 3.0 (itoa str2) "M" "GHI-CHU" "VHELVEI" nil nil) (setvar "OSMODE" old) (setvar "cmdecho" oldd) (princ) )-
1
-
-
"Pick trượt" hiểu đơn giản thế này: ý định người dùng pick vào điểm để chọn nhưng lỡ tay pick ra khoảng trống bên cạnh gần điểm đó nhóc. Khi trường hợp này xảy ra thì điểm sẽ bị hiểu là "nil"
- ^^ vậy là điểm cần pick đã đc xác định, thì nhoc sẽ đưa while vào khi nào bắt trúng điểm đó mới cho chuột nghĩ, còn mún nil lun thì ko cần while, nhoc sẽ set = if
-
1
-
-
- trượt theo kiủ nào Hieu nhỉ ^^, nhầm chuột phải hay enter thì mình có thể dùng initget khống chế, còn nhầm mục tiêu pick thì phải xét mục tiêu như thế nào mới pit đặt điều kiện bỏ vào while đc, như lệnh trên thì nó chỉ vẽ line bất kỳ nên không cần dùng while ^^
-
Kết quả test:
TEST
Chọn 4 text.
4 text bị move sang 4 vị trí khác.
Đo góc dịch chuyển: cả 4 góc đều bằng 45độ.
???
- ^^ nhoc quên do cái biến r với height nhoc chạy bên nhoc khác lsp viết , nhoc ngâm thêm 1 ít cảm giác code này chưa ổn ^^
-
- lsp test nhoc up ở trên đó anh nhoc set góc đầu tiên mở ra là 45 độ từ đỉnh của rectang rùi dò nếu ko vướn thì lấy tọa độ điểm đó, vướn thì góc sẽ đi tiếp 20 độ
-
- Nhoc vẫn chưa hiểu ^^, dxf50 của text cái nào cũng = 0 mà anh
- nhoc gửi file chạy thử mấy anh xem giúp nhoc ^^
-
- hi mấy anh trợ giúp nhoc với, bài toán text né line, nhoc mót nhặt từ nhiều nơi tới đc đây mà vẫn còn xíu gì đó nhoc vẫn chưa hiểu ^^, chạy vẫn chưa đc như ý.
- vd: vẽ 1 rectang sau đó viết text trên các đỉnh, justy là middle, mã 11 trùng với đỉnh. khi chạy quét từng text thì nó chạy đúng ý nhoc là 45 độ là góc đầu tiên, còn quét 1 lần để duyệt thì mỗi text lại chạy khác nhau đúng ra đều 45 độ hết, mặc dù xung quanh đang trống chưa có vật cản nào ^^
(defun move_text (position height / r ang found pt1 pt2 ssobj newpos) (setq r (* 1.2 height) ang (/ pi 4) found nil ) (while (and (not found) (<= ang (* 2 pi))) (setq newpos (polar position ang r) pt1 (list (- (car newpos) (/ height 2.0)) (- (cadr newpos) (/ height 2.0)) 0.0) pt2 (list (+ (car newpos) (/ height 2.0)) (+ (cadr newpos) (/ height 2.0)) 0.0) ) (setq ssobj (ssget "_C" pt1 pt2)) (if (= ssobj nil) (setq found T) ) (setq ang (+ ang (/ pi 9))) ) (if found newpos nil ) ) ;-------------------------------------------------------------------------------------------------- (defun c:test (/ sstext ssl ent enx newvt pos) (setq sstext (ssget '((0 . "TEXT")))) (if sstext (progn ;--------------------------------- (setq ssl (sslength sstext)) (repeat ssl (setq ent (ssname sstext 0) enx (entget ent) pos (cdr (assoc 11 enx)) ) (setq newvt (move_text pos 3.5)) (if newvt (entmod (subst (cons 11 newvt) (assoc 11 enx) enx)) (princ "Ko ne dc\n") ) (ssdel ent sstext) ) ) ;end progn ) ;end if sstext (princ) ) -
- ^^, khó phết anh Tue nhỉ, khuya rùi nhoc mới mò đc vậy ko biết có ổn ko, nhưng hơi dài kaka,mai lại bận cả ngày ko có thời gian ngâm tiếp ^^
(defun c:caodo(/ chon hh kk c_do c) (setq chon (car (entsel "\nchon cao do chuan:"))) (if (= chon nil) (progn (setq hh (getvar "lastprompt")) (setq kk (strlen "chon cao do chuan: ")) (setq c_do (distof (substr hh kk))) ) (setq c_do (distof (cdr (assoc 1 (entget chon))))) ) (princ (setq c (+ 0.5 c_do))) (princ) )
-
1
-
-
Sorry bạn. Chắc bạn nghỉ quá cao siêu quá mà do mình lại diễn đạt không thấu đáo. Mình thì viết lisp dựa vào mấy cái lisp có sẵn rồi chế lại thôi nên hiểu đơn giản nên nói vậy.
Trường hợp của mình là như vậy nè:
sau khi gõ lệnh: caodo
yêu cầu nhập cao độ chuẩn.
Lúc này có thể chọn trên màn hình luôn hoặc đánh số vào,
Vậy đó.
Không biết thế này được chưa nữa
mong bạn bỏ qua nếu không hiểu
- vậy ban thử cách nhoc nêu xem có đúng ý bạn ko ^^, yêu cầu nhập cao độ, ko nhập thì enter hay chuột phải bỏ qua lsp sẽ nhảy qua bước chọn text trên màn hình
^^
(if (setq c_do (getreal "\nnhap cao do chuan:")) c_do (setq c_do (distof (cdr (assoc 1 (entget (car (entsel "\nchon cao do chuan:"))))))) )
-
1
-
-
- hi nhoc thì nghĩ đơn giản vầy ^^
(if (setq dulieu (getxxx "nhap:")) dulieu (progn (setq dulieu (ssget or entsel)) ............... ) ) ;_^^
-
- hi nhoc đâu dám nhận là trợ giảng ^^, nhoc chỉ nhiều chiện hay xem bài các bạn vô sau vừa làm quen vừa ôn lại đc kiến thức có khi mót thêm đc nhiều cái thú vị :)
-
- hi lúc trước nhoc cũng ngơ ngơ 2 thằng này ^^, Hieu xem ví dụ này ngâm cứu thử :)
(Null '()) => T
(Null '(1 2 3)) => NIL
(Null nil) => T
(Null t) => NIL
(Null 234,4) => NIL
(Null "ngọng") => NIL- hiểu theo cách thổ dân của nhoc null là 1 hàm kiểm tra , còn nil đại diện cho biến trống ko có giá trị => nil là con của null ^^.
- Null là hàm để kiểm tra xem một biến có Null ko , tức biến đó có nil ko (trích bác gugồ :P )
-
1
-
-
- ah đc ^^, nhoc ít xài bên 3d nên ít để ý trục Z, mới xực nhớ có đọc qua dùng lệnh 3dpoly có thể add Z lun ^^, code sẽ đc viết lại như thế này ^^
(defun c:rrr(/ ) (setq a '(1 2 3 4)) (setq b '(2 7 8 9)) (setq lst_new (mapcar '(lambda (x) (cdr x)) (list a b))) (apply 'command (append (list ".3dPoly") lst_new (list ""))) )
- các điểm đó sẽ đúng theo lst vd: x=2 y=3 z=4,
-
1
-
-
- Vẽ pline qua các điểm đó chắc đc ^^ nhưng nhoc chưa pit cách add đc Z của từng điểm vào pline, nhoc cũng chưa hiểu cách chuyển từ text sang lst của Hieu như thế nào, quét tới đâu chuyển tới đó hay quét hết 1 lúc rùi chuyển lun, nhoc có code mấy dòng Hieu thử xem sao
(defun c:rrr(/ ) (setq a '(1 2 3 4)) (setq b '(2 7 8 9)) (setq lst_new (mapcar '(lambda (x) (cdr x)) (list a b))) (K:pline lst_new nil nil nil) ) ;;;;;;;;;;;============================================================ (defun K:pline (listpoint closed Layer clr / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if clr clr 256)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (entmakex Lst)) ;end;=================================- biến a, b giả sử tương ứng với các lst tọa độ trả về của Hieu
-
1
-
-
- hi lâu lâu mới thấy Vinh, daọ này chắc Vinh bận rộn ^^
- mấy câu ứng dụng thủ tục sao Vinh ko tận dùng các hàm con ở trên nhỉ ^^
-
- hi nhoc viết thí nghiệm thử dùng grread ấy mà ^^, nếu lsp bạn Hieu viết để chuyển góc phương vị thì nhoc nghĩ chỉ để quay 1 đoạn thẳng là line, mục đích gì đó thì nhoc chưa pit, còn mún xoay nhóm obj hay polyline thì nhoc chưa làm nổi kaka.
- anh Ha giúp nhoc các dùng grread nhập liệu từ bàn phím mà có giới hạn như bạn Hieu hỏi từ 0-180, vậy là mình sẽ có 2 cách trả về 1 là pick 2 là nhập liệu, nhoc chưa pit phải làm sao ^^
-
Ok rồi nhoc ơi!
Mình đang chỉnh cho text xuất ra có 2 chữ số thập phân, không biết lisp nên mò chỗ nào có số 1 đổi thành số 2 thử... hihi
Cảm ơn nhoc nhé.
- ek ^^ đổi vậy coi chừng nguy hiểm, trong đó nhiều số 1 lắm ^^, bạn kím ngay dòng này sữa số 1 thành 2 là đc nè
(K:text pt1 h (strcat (rtos dt 2 1) "m%%178") "M" "ab-dientich" chon nil nil) => đổi số 1 màu đỏ thành số 2 là ok
-
- hihi Hieu có ghé ngang qua xem thử, nhoc mới học hàm grread, cũng thử múa rìu xíu tận dụng lsp roo của Hieu chỉnh lại = grread, vấn đề giới hạn góc nhập thì nhoc chưa xử đc, nhưng giữ được sợi thun quay quay cho Hieu ^^, quay tới đầu sẽ hiển thị góc phương vị tại chỗ đó ^^ dưới dòng command, khi nào ok, pick chuột trái tại vị trí mún xác định thì đoạn thẳng cũ sẽ chuyển tới đó, mấy anh có hứng giúp nhoc cải tiến phần nhập dữ liệu cho nhoc học hỏi thêm ^^, mò sáng giờ vẫn chưa pit với grread thì xử sao ^^
(defun c:roo(/ doigoc start end *error* vars ovars nvars dt db dh dg tt ent lst px pg p nhap edd info) (defun doigoc(goc) (rem (- 450.0 goc) 360.0)) (defun start() (setq vars '("osmode" "cmdecho" "angdir" "angbase")) (setq ovars (mapcar 'getvar vars) nvars (mapcar 'setvar vars (list 0 0 1 (/ pi 2))))) (defun end() (and ovars (mapcar 'setvar vars ovars))) (defun *error* (ABC) (end)) (vl-load-com) (princ "Chon Doi Tuong Can Quay: ") (setq dt (ssget) db (getpoint "\nChon BasePoint:") ent (ssname dt 0) info (entget ent) lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (or (= (car x) 10) (= (car x) 11))) (entget ent)))) (command "undo" "be") (start) ;========================================================================================= (if (< (distance db (setq px (car lst))) (distance db (setq pg (cadr lst)))) (alert (strcat "\nPhuong Vi cu <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle px pg))) 2 2) ">")) (alert (strcat "\nPhuong Vi cu <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle pg px))) 2 2) ">")) ) ;========================================================================================= (if (< (distance db (setq px (car lst))) (distance db (setq pg (cadr lst)))) (progn ;================================================================================================== (while (/= (car (setq nhap (grread t 15 0))) 3) (redraw) (if (= (car nhap) 5) (progn (setq p (cadr nhap)) (grdraw db p 1 1) (prompt (strcat "\nPhuong Vi hien la <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle db p))) 2 2) ">")) ) ) ) p (setq ang (angle db p)) (setq edd (entmod (append info (list (cons 10 db) (cons 11 (polar db ang (distance px pg))))))) ;==================================================================================================== (redraw) ) ;====================================================================================================== (progn ;==================================================================================================== (while (/= (car (setq nhap (grread t 15 0))) 3) (redraw) (if (= (car nhap) 5) (progn (setq p (cadr nhap)) (grdraw db p 1 1) (prompt (strcat "\nPhuong Vi hien la <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle db p))) 2 2) ">")) ) ) ) p (setq ang (angle db p)) (setq edd (entmod (append info (list (cons 10 db) (cons 11 (polar db ang (distance px pg))))))) ;=================================================================================================== (redraw) ) ;------------------------------------------------------- ) ;end if (end) (command "undo" "e") )-
1
-
-
- hihi nhoc chỉnh nhầm tí, nhoc đã cập nhật lại lisp #90 bạn tải lại chạy thử xem ^^
-
1
-
-
- Anh Ket ơi ^^ xem giúp bài nhoc với !!!
-
- ^^ ah quên lsp mình nó tính khác, cái đó chỉ là đánh số vùng đã chọn, diện tích từng hình nó vô file txt chứ ko in ra text ^^, khi nào pick hết enter để chọn điểm ghi ra diện tích tổng các hình đã pick
- nhoc sữa lại xíu giống với lsp cũ của bạn
;======================================================================================== (defun ReplaceString (old_str new_str str / m n) (vl-load-com) (setq m 0 n (strlen new_str)) (while (setq m (vl-string-search old_str str m)) (setq str (vl-string-subst new_str old_str str m)) (setq m (+ n m)) ) str ) ;======================================================================================== (defun tachsym(str sym / datach kytu dem lstdatach) (setq dem 1) (while (<= dem (strlen str)) (setq datach "") (setq kytu (substr str dem 1)) (while (and (/= kytu sym) (<= dem (strlen str))) (setq datach (strcat datach kytu)) (setq dem (+ dem 1)) (setq kytu (substr str dem 1)) ); end while con (setq dem (+ dem 1)) (setq lstdatach (append lstdatach (list datach))) ) ;end while me datach ) ;============================================================= ;====================================================================================================================== (defun K:dsbg (table / lst phu) (tblnext table t) (while (setq phu (tblnext table nil)) (setq lst (cons (cdr (assoc 2 phu)) lst)) ) ) ;================================ (defun c:dt(/ tl ntl tl2 h k tdt pt pt1 pt5 ss frome toe cur dt S laos K:text getvalueK lacol ladin dt ss1 ten K:layer K:style ds_style e1 e1 chon) (vl-load-com) ;===================================================================== ;================================================== ;ham tao text 2 (defun K:text(pt height string justify layer textstyle mau ang / lst) (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 (if ang ang 0)) (cons 8 layer) (cons 7 textstyle) (cons 62 (if mau mau 256)) ) justify (strcase justify)) (cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt))))) ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt))))) ) (entmakex Lst) );end K:text ;-------------------------------------- ; ham luu gia tri (defun getvalueK ( a giatri dongnhac / astr) (or a (setq a giatri)) (cond ((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a)))) ((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 1) ") :")))(a)))) ((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr)))) )) ;;;; ;================================================================================= (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)) ) ) ) ;======================================================================================== ;hàm t?o textstyle (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)))) ;===================================================================================== (if (= fname nil) (setq fname (getfiled "Chon tap tin luu so lieu" "//" "txt" 1)) ) (setq fo (open fname "a")) (princ "Cac dien tich da chon:" fo) (princ "\n" fo) ;====================================================================================== (if (null (tblsearch "layer" "ab-dientich")) (K:layer "ab-dientich" 4)) (if (null (tblsearch "style" "VAVON")) (K:style "VAVON" "VAVON.ttf")) ;=================================================================================== (setvar "cmdecho" 0) (command "undo" "begin") (setq lacol (getvar "CEColor")) (setq ladin (getvar "dimzin")) (setq laos (getvar "osmode")) (setq lacl (getvar 'clayer)) ;================================================================ (setq ds_style (vl-princ-to-string (K:dsbg "style"))) (setq e1 (tachsym ds_style "(")) (setq e2 (Xstrcase (tachsym e1 ")"))) (initget 1 e2) (setq chon (getkword (strcat "Nh\U+1EADp ch\U+1EEF \U+0111\U+1EA7u t\U+00EAn Style m\U+00FAn set: < " (ReplaceString " " "/" e2) " >:"))) ;======================================================== (setq tl (getvalueK tl 1000.0 "Mau so Ti le ht ")) (setq ntl (/ 1000 tl)) (setq h (getvalueK h 1.8 "Nhap chieu cao text ")) (setq tl2 (* ntl ntl)) ;================================================================== (setq k 0 tdt 0) (setvar "dimzin" 0) (setvar "OSMODE" 0) ;====================================== ;=========================================================== (initget 1) (setq pt1 (getpoint "\n Chon mien tinh dien tich: ")) (while (/= pt1 nil) (setq k (+ 1 k)) ;----------------------------------------------------------------------------- (setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary (command "cecolor"1 "-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") tl2) S (+ S dt)) );while (command "area" "A" "O" "L" "" "") (setq dt (/ (getvar "AREA") tl2)) (setq S (+ S (* dt 2))) (K:text pt1 h (strcat (rtos dt 2 1) "m%%178") "M" "ab-dientich" chon nil nil) (princ dt fo) (princ " m2") (princ "\n" fo) (setvar "CEColor" lacol) ;========================================== ;=================================================================== (setq pt1 (getpoint (strcat "\nchon mien do tiep theo..."))) );while ;======================================================================= (setvar "DIMZIN" ladin) ;================================================ ;================================================================================= ;=============== (setvar 'clayer lacl) ;===================== (setvar "OSMODE" laos) (command "undo" "end") (close fo) (setvar "cmdecho" 1) (princ "\n") (princ "xong") (princ) )-
1
-
nhờ chỉnh sửa lisp phân biệt (tab) và (cách) trong text
trong Sử dụng AutoCAD
Đã đăng · Trả lời báo cáo
-lsp dành cho phiên bản cadr14 ^^, trong đó có 2 hàm con arrayele, timtctSH nhoc không thấy trong lsp, nếu hàm có sẵn nhoc dò thử gù gồ chưa ra, mún test nhưng báo lỗi ^^, file định dạng xlw chắc định dạng cũ hay sao, excel 2007 nhoc kím cũng ko có :)