Chuyển đến nội dung
Diễn đàn CADViet

thanhduan2407

Nhà quảng cáo
  • Số lượng nội dung

    1.144
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    24

Cộng đồng

265 (khá)

1 Người theo dõi

About thanhduan2407

  • Cấp bậc
    biết lệnh adcenter
  • Ngày sinh 24/07/1984

Phương pháp liên hệ

  • Địa chỉ Trang web:
    http://www.cadviet.com/forum/index.php?showtopic=65709
  • ICQ
    0

Thông tin hồ sơ

  • Giới tính
    Male

Khách truy cập Tiểu sử gần đây

16.413 chế độ xem tiểu sử
  1. thanhduan2407

    Nhờ Viết Lisp Tạo Text

    (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
  2. Chào bác, em có xem được lisp vẽ mặt cắt địa hình của bác rất hay, em muốn xin lisp đó để chạy ạ. Cảm ơn bác nhiều

  3. thanhduan2407

    Nối text cao độ

    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
  4. thanhduan2407

    Nối text cao độ

    Liên hệ mình: 0972.0168.25
  5. thanhduan2407

    Xin viết lsp cad vẽ bo từ các đường thẳng

    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.
  6. thanhduan2407

    Xin viết lsp cad vẽ bo từ các đường thẳng

    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)) )
  7. thanhduan2407

    Xin viết lsp cad vẽ bo từ các đường thẳng

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

    Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

    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 ) ) )
  9. thanhduan2407

    Hỏi về hàm lisp

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

    Tặng anh em 1 tool để chụp nhanh màn hình

    Cảm ơn bác
  11. thanhduan2407

    Tặng anh em 1 tool để chụp nhanh màn hình

    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
  12. thanhduan2407

    Tặng anh em 1 tool để chụp nhanh màn hình

    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
  13. thanhduan2407

    Tặng anh em 1 tool để chụp nhanh màn hình

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