thanhduan2407

(defun C:00 (/ DAITHEP NDUNG OBJTHEPDAI PNTDAT) (vl-load-com) (defun *error* (msg) (if Olmode (setvar 'osmode Olmode) ) (if (not (member msg '("*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (setvar 'CMDECHO 0) (setq Olmode (getvar "OSMODE")) (setvar "OSMODE" 0) (setq ObjThepdai (car (LM:SelectIf "\nCh\U+1ECDn th\U+00E9p \U+0111ai " (lambda (x) (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x))))) (eq "POLYLINE" (cdr (assoc 0 (entget (car x))))) (eq "LINE" (cdr (assoc 0 (entget (car x))))) ) ) entsel nil ) ) ) (setq Daithep (length1 ObjThepdai)) (setq Kyhieuthep (LM:GetXWithDefault_New getstring "\nNh\U+1EADp k\U+00FD hi\U+1EC7u thanh th\U+00E9p " '*Kyhieuthep* "2" nil nil) ) (setq Duongkinh (LM:GetXWithDefault_New getdist "\nNh\U+1EADp \U+0111\U+01B0\U+1EDDng k\U+00EDnh " '*Duongkinh* 10.0 nil nil) ) (setq Kcrd (LM:GetXWithDefault_New getdist "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch r\U+00E3nh \U+0111ai " '*Kcrd* 150.0 nil nil) ) (setq Caochu (LM:GetXWithDefault_New getdist "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch r\U+00E3nh \U+0111ai " '*Caochu* 100.0 nil nil) ) (setq Ndung (strcat "[" Kyhieuthep "]-" (rtos (/ Daithep Kcrd) 2 0) "d" (rtos Duongkinh 2 0) "a" (rtos Kcrd 2 0) "-L=" (rtos Daithep 2 0) ) ) (setq PntDat (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ghi Text:\n")) (MakeText PntDat Ndung Caochu 0 "MC" nil nil nil) (setvar "OSMODE" Olmode) (princ) ) (defun Length1 (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) (defun MakeText (point string Height Ang justify Layer Style Color / Lst) ; Ang: Radial (setq Lst (list '(0 . "TEXT") (cons 10 point) (cons 40 Height) (cons 8 (if Layer Layer (getvar "CLAYER") ) ) (cons 1 string) (if Ang (cons 50 Ang) ) (cons 7 (if Style Style (getvar "Textstyle") ) ) (cons 62 (if Color Color 256 ) ) ) justify (strcase justify) ) (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))) ) ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 73 0) (cons 10 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 LM:SelectIf (msg pred func keyw / sel) (setq pred (eval pred)) (while (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw) ) (setq sel (func msg)) (cond ((= 7 (getvar 'ERRNO)) (princ "\nB\U+1EA1n ch\U+1ECDn sai r\U+1ED3i! H\U+00E3y ch\U+1ECDn l\U+1EA1i." ) ) ((eq 'STR (type sel)) nil ) ((vl-consp sel) (if (and pred (not (pred sel))) (princ "") ) ) ) ) ) sel ) ;; GetX with Default - Lee Mac ;; fun - [sym] Quoted user input function ;; pmt - [str] Prompt string ;; sym - [sym] Quoted function to hold default value (not 'sym) ;; def - [any] Initial default value ;; ini - [lst] [Optional] List of initget arguments ;; arg - [lst] [Optional] List of arguments for user input function ;; Returns: [any] User input or default value ;;;;;; (LM:GetXWithDefault_New getkword "\nEnter an Option [Alpha/Beta/Gamma] " '*opt* "Alpha" '("Alpha Beta Gamma") nil) ;;;;;; (LM:GetXWithDefault_New getstring "\nEnter a String " '*str* "Lee Mac" nil '(T)) (defun LM:GetXWithDefault_New (_function _prompt _symbol _default _initget _args / _toString) (vl-load-com) ;; © Lee Mac 2010 (setq _toString (lambda (x) (cond ((eq getangle _function) (angtos x)) ((eq 'REAL (type x)) (rtos x)) ((eq 'INT (type x)) (itoa x)) ((vl-princ-to-string x)) ) ) ) (if _initget (apply 'initget _initget) ) (set _symbol ( (lambda (input) (if (or (not input) (eq "" input)) (eval _symbol) input ) ) (apply '_function (append _args (list (strcat _prompt "<" (_toString (set _symbol (cond ((eval _symbol)) (_default) ) ) ) "> : " ) ) ) ) ) ) ) Giúp bạn chút. Còn sửa như thế nào thì nhờ mng sửa. Mình tranh thủ tý thôi

Bản vẽ bạn gửi không cần lisp gì cả. Xuất toạ độ Point ra là có cao độ Z. Phun lại là xong. Nếu như Point hoặc Circle không có cao độ (khác 0 hoặc khác giá trị chuẩn nhưng không đều) thì mới cần đến việc viết theo yêu cầu. Liên hệ mình Zalo: 0972.0168.25 để trao đổi thêm

Liên hệ mình: 0972.0168.25

Làm theo file mẫu, giờ lại yêu cầu khác đi. Tôi nghĩ bạn bỏ phí ra thì sẽ có người viết cho.

Bạn thử xem được không nhé! Yêu cầu cài Cad full (có tool express) (defun C:00 (/ LTSG LTSLINE PNTMAX PNTMIN SSLINE) (defun *error* (msg) (if Olmode (setvar 'osmode Olmode) ) (if (not (member msg '("*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (setq Olmode (getvar "OSMODE")) (setvar "OSMODE" 0) (setvar "CMDECHO" 0) (setq ssLine (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE")))) (if ssLine (progn (setq LtsLine (acet-ss-to-list ssLine)) (setq LtsG (LM:IntersectionsinList LtsLine)) (if (= (length LtsG) 4) (progn (setq PntMin (list (apply 'min (mapcar 'car LtsG)) (apply 'min (mapcar 'cadr LtsG)))) (setq PntMax (list (apply 'max (mapcar 'car LtsG)) (apply 'max (mapcar 'cadr LtsG)))) (command "rectang" PntMin PntMax) (vla-put-color (vlax-ename->vla-object (entlast)) 1) ) ) ) ) (setvar "OSMODE" Olmode) (princ) ) (defun LM:Intersections (obj1 obj2 mode / l r) (setq l (vlax-invoke obj1 'intersectwith obj2 mode)) (repeat (/ (length l) 3) (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l) ) ) (reverse r) ) (defun LM:IntersectionsinList (lst / a l) (while (setq a (car lst)) (foreach b (setq lst (cdr lst)) (setq l (cons (LM:Intersections (vlax-ename->vla-object a) (vlax-ename->vla-object b) acextendnone ) l ) ) ) ) (apply 'append (reverse l)) )

Dùng lisp làm gì? Vẽ lệnh Rectang nhanh hơn nhiều so với 4 phát chọn

Anh nghiên cứu cái này. (vla-put-contenttype mlo 2) => số 2 là Mtext, 1 là Block (cons 170 1) => (cons 170 2) (defun _makemleaderstyle (name txtstyle / d mld mlo) ;; RJP - 09.16.2017 (if (and (setq d (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object)))) (= 'vla-object (type (setq mld (vl-catch-all-apply 'vla-item (list d "ACAD_MLEADERSTYLE")))) ) (= 'vla-object (type (setq mlo (vl-catch-all-apply 'vlax-invoke (list mld 'addobject name "AcDbMLeaderStyle"))) ) ) ) (progn (vla-put-contenttype mlo 2) (vla-put-alignspace mlo 0.1) (vla-put-annotative mlo :vlax-true) (vla-put-arrowsize mlo 0.18) (vla-put-blockconnectiontype mlo 0) (vla-put-breaksize mlo 0.1) (vla-put-description mlo "") (vla-put-dogleglength mlo 0.125) (vla-put-enablelanding mlo :vlax-true) (vla-put-firstsegmentangleconstraint mlo 0) (vla-put-landinggap mlo 0.05) (vla-put-maxleadersegmentspoints mlo 2) (vla-put-scalefactor mlo 1) (vla-put-secondsegmentangleconstraint mlo 0) (vlax-put mlo 'textalignmenttype 0) (vlax-put mlo 'textleftattachmenttype 1) (vlax-put mlo 'textrightattachmenttype 1) (vla-put-textheight mlo 0.1) ;; Make sure you load your texstyle first or it will default to standard (vla-put-textstyle mlo (if (tblobjname "style" txtstyle) txtstyle "standard" ) ) mlo ) ) )

Bạn thử cái này! (command "Text" "J" "MC" (getpoint) (getdist) 0 "Chu gi do" "")

Cảm ơn bác

Nó có rất nhiều tuỳ chọn. Kể cả theo Pixcell nhập vào. P/s: Bác đăng hình lên đây kiểu gì cho dễ vậy? Em phải Up lên trang khác rồi copy link mới cho được hình lên. Bất tiện lắm

Vậy các bác dùng phần mềm này còn ngon hơn nhiều! FastStone Capture! https://bit.ly/3qH9i5R

Bạn có thể chia sẻ các icon đó được ko? Chân thành cảm ơn