| Info | File |
Tác giả: thanhduan2407
Bài viết gốc: 303772
Tên lệnh: loadit |
Gọi Tool Bar trong CUI vừa Add
Chào các bác
Em đang loay hoay việc khi mình load Menu từ CUI thì sẽ hiện lên luôn thanh Tool Bar nhưng không được.
Em cũng nhờ bác Tot77 giúp đỡ nhưng chắc bác ấy bận nên nhờ các bác góp ý hoặc viết Code cho em 1 đoạn.
Hiện tại em cũng đã xong việc Load Menu từ CUI, nhờ các bác viết thêm cho em 1 đoạn để khi chạy LISP thì các Tool Bar trong đó sẽ hiện lên màn hình.
>> Chào các bác
Em đang loay hoay việc khi mình load Menu từ CUI thì sẽ hiện lên luôn thanh Tool Bar nhưng không được.
Em cũng nhờ bác Tot77 giúp đỡ nhưng chắc bác ấy bận nên nhờ các bác góp ý hoặc viết Code cho em 1 đoạn.
Hiện tại em cũng đã xong việc Load Menu từ CUI, nhờ các bác viết thêm cho em 1 đoạn để khi chạy LISP thì các Tool Bar trong đó sẽ hiện lên màn hình.
(defun c:loadit (/ cui_database mnbar flag)
(vl-load-com)
(setq cui_database (list "ISO-VINX" "C:\\ISO-Vinx.cui" "ISO")
flag nil)
(vlax-for n (setq all_menus (vla-get-MenuGroups (vlax-get-Acad-Object)))
(if (= (strcase (vla-get-name n)) (car cui_database)) (setq flag T))
)
(if (null flag)
(progn
(vla-load all_menus (cadr cui_database))
(setq MnBar (vla-get-MenuBar (vlax-get-Acad-Object)))
(vla-InsertInMenuBar
(vla-Item (vla-get-Menus (vla-Item (vla-get-MenuGroups (vlax-get-Acad-Object)) (car cui_database))) (caddr cui_database))
(1- (vla-get-Count MnBar))
)
)
(princ "\n>>..MENU IS ALREADY LOADED..<<")
)
(princ)
)
Đây là file CỦI và MNS
http://www.cadviet.com/upfiles/3/36665_load_cui_1.rar
Cảm ơn các bác sẽ xem và đóng góp
<<
|
|
Filename: 303772_loadit.lsp
|
|
Tác giả: ssg
Bài viết gốc: 13126
Tên lệnh: bx |
Ghi dung sai chọn theo kiểu lắp
Chương trình Ghi dung sai rất hay. Mình cũng đã có đề nghị hoàn thiện tiếp để đưa vào Mechanical CadViet nhưng đáng tiếc là anh bạn dcl bỏ đi đâu lâu quá không thấy vào?
|
Tác giả: Nguyen Hoanh
Bài viết gốc: 13146
Tên lệnh: loadit | |
Tác giả: gia_bach
Bài viết gốc: 303902
Tên lệnh: gs |
Nhờ các anh chị giúp 1 đoạn LISP!
Nhờ các anh chị có thể viết giúp em một đoạn LISP có chức năng đưa tất cả các chân của dimension có khoảng các bằng 0.
Vì không thể diễn tả được hết ý mong muốn nên phiền các anh chị giúp em thì xem file đính kèm nha!
Cảm ơn!
>>
Nhờ các anh chị có thể viết giúp em một đoạn LISP có chức năng đưa tất cả các chân của dimension có khoảng các bằng 0.
Vì không thể diễn tả được hết ý mong muốn nên phiền các anh chị giúp em thì xem file đính kèm nha!
Cảm ơn!
http://www.cadviet.com/upfiles/3/132006_drawing1.dwg
Bạn dùng thử cái này.
(defun C:gs (/ ss ds pt13 pt10 pt13N rot)
;; By : Gia_Bach 2014
(command "_.undo" "_begin")
(princ "\nChon kich thuoc :")
(if (setq ss (ssget "_:L"'((0 . "DIMENSION")(-4 . "<NOT")(-4 . "&")(70 . 7)(-4 . "NOT>"))) )
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq ds (entget e)
pt10 (cdr (assoc 10 ds))
pt13 (cdr (assoc 13 ds))
ds (subst (cons 14 pt10) (assoc 14 ds) ds)
rot (cdr (assoc 50 ds))
pt13N (inters pt10 (polar pt10 rot 1) pt13 (polar pt13 (+ rot (/ pi 2)) 1)nil)
ds (subst (cons 13 pt13N) (assoc 13 ds) ds) )
(entmod ds) ) )
(command "_.undo" "_end")
(princ) )
<<
|
Tác giả: thanhduan2407
Bài viết gốc: 303906
Tên lệnh: loadit |
Gọi Tool Bar trong CUI vừa Add
Em cảm ơn bác Tuệ nhiều.
Thật xấu hổ khi em nhờ cả 2 người giúp đỡ.
Em cũng nhờ bác Tot77 giúp đỡ.
Đây là mã Code bác ấy viết hiện lên Tool Bar khi load CUI.
(defun c:loadit (/ cui_database mnbar flag)
(vl-load-com)
(setq cui_database (list "ISO-VINX" "C:\\ISO-Vinx.cui" "ISO")
flag nil)
(vlax-for n (setq all_menus (vla-get-MenuGroups...
>> Em cảm ơn bác Tuệ nhiều.
Thật xấu hổ khi em nhờ cả 2 người giúp đỡ.
Em cũng nhờ bác Tot77 giúp đỡ.
Đây là mã Code bác ấy viết hiện lên Tool Bar khi load CUI.
(defun c:loadit (/ cui_database mnbar flag)
(vl-load-com)
(setq cui_database (list "ISO-VINX" "C:\\ISO-Vinx.cui" "ISO")
flag nil)
(vlax-for n (setq all_menus (vla-get-MenuGroups (vlax-get-Acad-Object)))
(if (= (strcase (vla-get-name n)) (car cui_database)) (setq flag T))
)
(if (null flag)
(progn
(vla-load all_menus (cadr cui_database))
(setq MnBar (vla-get-MenuBar (vlax-get-Acad-Object)))
(vla-InsertInMenuBar
(setq mewPopUpMenu (vla-Item (vla-get-Menus
(setq newMenuGroup (vla-Item (vla-get-MenuGroups (vlax-get-Acad-Object)) (car cui_database))))
(caddr cui_database)))
(1- (vla-get-Count MnBar))
)
)
(princ "\n>>..MENU IS ALREADY LOADED..<<")
)
(setq newToolBar (vla-item (vla-get-Toolbars newMenuGroup) 0))
(vla-put-Visible newToolBar :vlax-true)
(setq ltb nil lpm nil)
(vlax-for item newToolBar (setq ltb (cons (vla-get-name item) ltb)))
(vlax-for item NewPopUpMenu
(setq lpm (cons (list (vla-get-Index item) (vla-get-TagString item) (vla-get-Caption item) (vla-get-Macro item)) lpm))
)
(setq lpm (vl-sort lpm '(lambda(x y) (car x) (car y))))
(princ)
)
Nó tương đối ổn rồi.
Em đang mong muốn dùng LISP để điều khiển nó. Khi mình dùng lisp load CUI thì cái Tool Bar của CUI mới nó sẽ nhảy vào Tool Bar của AUtocad mà không cần phải gắp từ cái này sang cái khác.
Chân thành cảm ơn sự nhiệt tình của 2 bác
<<
|
|
Filename: 303906_loadit.lsp
|
|
Tác giả: Jin Yong
Bài viết gốc: 13150
Tên lệnh: bx |
Đồ án bê tông cốt thép 2
Nước ngoài họ làm cái sàn BUBBLE DECK.
Thầy Thắng bộ môn Thi Công - Đại học Xây Dựng đã nghiên cứu thành công việc chuyển đổi thành công nghệ thi công sàn ván khuôn tôn. Qua đó không cần lắp ghép cốp pha cho sàn nữa.
|
Tác giả: Tue_NV
Bài viết gốc: 304019
Tên lệnh: test |
Gọi Tool Bar trong CUI vừa Add
Dạ nó như này anh ạ.
Em tham khảo 2 đoạn code này, anh copy nhặt được trên mạng, vì quá bận nên chưa nghiên cứu nhiều ^ _ ^
(vl-load-com)
(defun c:test()
(setq acadObj (vlax-get-acad-object))
(setq currMenuGroup (vla-Item (vla-get-MenuGroups acadObj) "ACAD"))
;; Create the new...
>> Dạ nó như này anh ạ.
Em tham khảo 2 đoạn code này, anh copy nhặt được trên mạng, vì quá bận nên chưa nghiên cứu nhiều ^ _ ^
(vl-load-com)
(defun c:test()
(setq acadObj (vlax-get-acad-object))
(setq currMenuGroup (vla-Item (vla-get-MenuGroups acadObj) "ACAD"))
;; Create the new toolbar
(setq newToolBar (vla-Add (vla-get-Toolbars currMenuGroup) "HA1"))
;; Assign the macro string the VB equivalent of "ESC ESC _open "
(setq openMacro (strcat (Chr 3) (Chr 3) (Chr 95) "open" (Chr 32)))
(setq newButton1 (vla-AddToolbarButton newToolBar "" "NewButton1" "Open a file." openMacro))
;; Display the toolbar
(vla-put-Visible newToolBar :vlax-true)
(vla-put-CommandDisplayName newButton1 "Open a File")
;; Read the current value of the Help string
(alert (strcat "The current CommandDisplayName for the toolbar button is: " (vla-get-CommandDisplayName newButton1)))
;; Change the value of the CommandDisplayName
(vla-put-CommandDisplayName newButton1 "Open File")
;; Read the new value of the CommandDisplayName
(alert (strcat "The new CommandDisplayName for the toolbar button is: " (vla-get-CommandDisplayName newButton1)))
)
Và
(defun C:VBATOOLBARMENU (/ fn acadobj thisdoc menus flag currMenuGroup
newToolbar newToolbarButton openMacro
SmallBitmapName LargeBitmapName)
(vl-load-com)
;;; CreateToolbar is called if the Toolbar in question doesn't exist
(defun createToolbar ()
(setq newToolbar (vla-add (vla-get-toolbars currMenuGroup) "VBA Menu"))
;;------------------------------------------------------------------
;; create the first Toolbar Button, VbaLoad
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaload" (chr 32)))
(setq newToolbarButton (vla-addToolbarButton
newToolbar
(1+ (vla-get-count newToolbar))
"VBA Load" "VBA Load" openMacro
)
)
(setq SmallBitmapName "VbaLoad.bmp")
(setq LargeBitmapName "VbaLoad.bmp")
(vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)
(vla-put-helpString newToolbarButton "Load a VBA Application")
;;------------------------------------------------------------------
;; create the second Toolbar Button, Vbaide
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaide" (chr 32)))
(setq newToolbarButton (vla-addToolbarButton
newToolbar
(1+ (vla-get-count newToolbar))
"VBA Editor" "VBA Editor" openMacro
)
)
(setq SmallBitmapName "Vbaide.bmp")
(setq LargeBitmapName "Vbaide.bmp")
(vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)
(vla-put-helpString newToolbarButton "Switch to the VBA Editor")
;;------------------------------------------------------------------
;; create the third Toolbar Button, Vbarun
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbarun" (chr 32)))
(setq newToolbarButton (vla-addToolbarButton
newToolbar
(1+ (vla-get-count newToolbar))
"VBA Macro" "VBA Macro" openMacro
)
)
(setq SmallBitmapName "Vbamacro.bmp")
(setq LargeBitmapName "Vbamacro.bmp")
(vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)
(vla-put-helpString newToolbarButton "Run a VBA Macro")
;;------------------------------------------------------------------
;; create the fourth Toolbar Button, Vbaman
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaman" (chr 32)))
(setq newToolbarButton (vla-addToolbarButton
newToolbar
(1+ (vla-get-count newToolbar))
"VBA Manager" "VBA Manager" openMacro
)
)
(setq SmallBitmapName "Vbaman.bmp")
(setq LargeBitmapName "Vbaman.bmp")
(vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)
(vla-put-helpString newToolbarButton "Display the VBA Manager")
;;------------------------------------------------------------------
;; re-compile the VBATOOLBARMENU menu - VBATOOLBARMENU.MNC
(vla-save currMenuGroup acMenuFileCompiled)
;; save it as a MNS file
(vla-save currMenuGroup acMenuFileSource)
)
(setq flag nil)
(if (not (findfile "VbaToolbarMenu.mns"))
(progn
(setq fn (open "VbaToolbarMenu.mns" "w"))
(close fn)
)
)
;; get hold of the application object
;; we'll use it to reference the menuGroups collection
(setq acadobj (vlax-get-acad-object))
;; .. and get the active document
(setq thisdoc (vla-get-activeDocument acadobj))
;; get all menu groups loaded into AutoCAD
(setq menus (vla-get-menuGroups acadobj))
(princ "\nLoaded menus: ")
(vlax-for n menus
(if (= (vla-get-name n) "VbaToolbarMenu")
(setq flag T)
)
(terpri)
(princ (vla-get-name n))
)
;; if VbaToolbarMenu wasn't among the loaded menus then load it
(if (null flag)
(vla-load menus "VbaToolbarMenu.mns")
)
(setq currMenuGroup (vla-item menus "VbaToolbarMenu"))
;; if no Toolbars exist in VbaToolbarMenu then go create one
;; otherwise exit with grace
(if (<= (vla-get-count (vla-get-menus currMenuGroup)) 0)
(createToolbar)
(princ "\nThe Vba Toolbar Menu is already loaded")
)
(princ)
)
(princ)
(vl-load-com)
(defun c:test()
(setq acadObj (vlax-get-acad-object))
(setq currMenuGroup (vla-Item (vla-get-MenuGroups acadObj) "ACAD"))
;; Create the new toolbar
(setq newToolBar (vla-Add (vla-get-Toolbars currMenuGroup) "HA1"))
;; Assign the macro string the VB equivalent of "ESC ESC _open "
(setq openMacro (strcat (Chr 3) (Chr 3) (Chr 95) "open" (Chr 32)))
(setq newButton1 (vla-AddToolbarButton newToolBar "" "NewButton1" "Open a file." openMacro))
;; Display the toolbar
(vla-put-Visible newToolBar :vlax-true)
(vla-put-CommandDisplayName newButton1 "Open a File")
;; Read the current value of the Help string
(alert (strcat "The current CommandDisplayName for the toolbar button is: " (vla-get-CommandDisplayName newButton1)))
;; Change the value of the CommandDisplayName
(vla-put-CommandDisplayName newButton1 "Open File")
;; Read the new value of the CommandDisplayName
(alert (strcat "The new CommandDisplayName for the toolbar button is: " (vla-get-CommandDisplayName newButton1)))
)
<<
|
|
Filename: 304019_test.lsp
|
|
Tác giả: ksgia
Bài viết gốc: 13170
Tên lệnh: bx |
vẽ 1 góc so với 1 đường thẳng xiên
- Hiện Auto Cad 2007 có lệnh vừa rotate vừa copy : Chọn đối tượng --> RO -->bắt điểm gốc xoay--> Specify rotation anggle
or <0>:
1- Nhập : C-->Ente--> nhập góc độ thì ta có được vừa rotate vừa copy
2- Nhập : R-->Ente-->bắt điểm gốc xoay --> bắt tiếp điểm ngọn cần xoay đến thì chỉ có rotate
( Auto Cad 2004 không có chức năng copy).
Bạn tham khảo thêm bài viết: >>
- Hiện Auto Cad 2007 có lệnh vừa rotate vừa copy : Chọn đối tượng --> RO -->bắt điểm gốc xoay--> Specify rotation anggle
or <0>:
1- Nhập : C-->Ente--> nhập góc độ thì ta có được vừa rotate vừa copy
2- Nhập : R-->Ente-->bắt điểm gốc xoay --> bắt tiếp điểm ngọn cần xoay đến thì chỉ có rotate
( Auto Cad 2004 không có chức năng copy).
Bạn tham khảo thêm bài viết:
http://www.cadviet.com/forum/index.php?sho...amp;#entry12635 << |
Tác giả: aboutautolisp
Bài viết gốc: 13171
Tên lệnh: bx |
AboutAutolisp1.3
Đây là nội dung phiên bản AboutAutolisp1.3
http://www.cadviet.com/upfiles/AboutAutolisp13.chm
Chúc các bạn vui vẻ !
Phiên bản này dùng cho cad2007 + cad2008 + cad2009
mã number : 0988-5550-8814-0183
Macode : AA556061O
http://www.cadviet.com/upfiles/AboutAutolisp13.exe
Mọi thắc mắc xin gửi qua Email :... >> Đây là nội dung phiên bản AboutAutolisp1.3
http://www.cadviet.com/upfiles/AboutAutolisp13.chm
Chúc các bạn vui vẻ !
Phiên bản này dùng cho cad2007 + cad2008 + cad2009
mã number : 0988-5550-8814-0183
Macode : AA556061O
http://www.cadviet.com/upfiles/AboutAutolisp13.exe
Mọi thắc mắc xin gửi qua Email : Aboutautolisp@yahoo.com.vn << |
Tác giả: nguyentuyen6
Bài viết gốc: 304059
Tên lệnh: fn maublk camcoc |
Lisp chèn block theo khoảng cách và xuất kết quả
Bạn thử cái này, lưu định dạng .CVS
Lệnh là "camcoc"
Điểm chèn block đặt ở tâm nhé.
Muốn chọn lại chỗ lưu file csv dùng lệnh "fn"
Muốn chọn lại block mẫu dùng lệnh "maublk"
(vl-load-com)
(defun c:fn ( / )
(setq fn_camcoc (getfiled "Create Output File" "" "csv" 1))
);;; end defun fi
(defun c:maublk ( /...
>> Bạn thử cái này, lưu định dạng .CVS
Lệnh là "camcoc"
Điểm chèn block đặt ở tâm nhé.
Muốn chọn lại chỗ lưu file csv dùng lệnh "fn"
Muốn chọn lại block mẫu dùng lệnh "maublk"
(vl-load-com)
(defun c:fn ( / )
(setq fn_camcoc (getfiled "Create Output File" "" "csv" 1))
);;; end defun fi
(defun c:maublk ( / camcoc_ten_blk1)
(setq camcoc_ten_blk1 (car (entsel "\nChon block ki hieu chen:")))
(if (= (cdr (assoc 0 (entget camcoc_ten_blk1))) "INSERT")
(progn
(setq camcoc_ten_blk (cdr (assoc 2 (entget camcoc_ten_blk1))))
(setq XscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'XEFFECTIVESCALEFACTOR))
(setq YscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'YEFFECTIVESCALEFACTOR))
)
(alert "\nChua chon duoc block mau!")
);;;end IF
);;; end defun fi
(defun c:camcoc ( / camcoc_gocquay COC EL1 GOC LIST_DON LIST_TONG OSMLAST PHIA_CAM PT10 PT11 PT_CHO_CAM_COC PT_MID TOA_DO_X TOA_DO_Y)
(setq OSMLAST (getvar "osmode"))
(setq list_tong (list)
)
(if (null camcoc_khoang_cach)
(setq camcoc_khoang_cach 5)
)
(if (null camcoc_ten_blk)
(c:maublk)
)
;(setq list_don (list))
(if
(setq coc (car (entsel "\nChon coc:")))
(progn
(if (= (cdr (assoc 0 (entget coc))) "LINE")
(progn
(setq pt_mid ( mid (setq pt10 (cdr (assoc 10 (entget coc)))) (setq pt11(cdr (assoc 11 (entget coc))))));;;setq
);;;progn
);;;end IF
;(setq camcoc_khoang_cach (getreal "\nNhap khoang cach: "));;;setq
;(setq camcoc_khoang_cach (duy:xd_gts camcoc_khoang_cach camcoc_khoang_cach "\nNhap khoang cach: "))
(setq camcoc_khoang_cach (duy:xd_gts gtn camcoc_khoang_cach "Nhap khoang cach:"))
(setq phia_cam (getpoint pt_mid "\nChon phia cam: ") );;;setq
(setvar "osmode" 0)
(setq goc (angle pt_mid phia_cam))
(setq pt_cho_cam_coc (polar pt_mid goc camcoc_khoang_cach));;;setq
(setq camcoc_gocquay (RTD (- goc (/ pi 2))))
(command "_.insert" camcoc_ten_blk pt_cho_cam_coc XscFactor YscFactor camcoc_gocquay)
(setq el1 (entlast))
;(vlax-put-property (vlax-ename->vla-object el1) 'XEFFECTIVESCALEFACTOR XscFactor)
;(vlax-put-property (vlax-ename->vla-object el1) 'YEFFECTIVESCALEFACTOR YscFactor)
(command "_.dimaligned" pt_mid (cdr (assoc 10 (entget el1))) (polar pt_mid (+ goc (/ pi 2)) 8))
(setq toa_do_x (rtos (cadr (assoc 10 (entget el1))) 2 3));;;setq
(setq toa_do_y (rtos (caddr (assoc 10 (entget el1))) 2 3));;;setq
(setq list_don (list (rtos camcoc_khoang_cach 2 10) toa_do_y toa_do_x));;;setq
(setq list_tong (append list_tong (list list_don)));;;setq
;(princ list_tong);;;princ
(while (null fn_camcoc)
(c:fn)
);;; end If
(LM:WriteCSV list_tong fn_camcoc);
;(startapp "explorer" fn)
(setvar "osmode" OSMLAST)
(princ)
)
(progn
(princ "\nChon chua dung");;;princ
(princ)
)
)
);;; end defun c:camcoc
(defun RTD (x) (/ (* x 180) pi) )
(defun mid ( a b )
(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)
(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "a"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)
;; List -> CSV - Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - list containing row of CSV cell values
;; sep - CSV separator token
(defun LM:lst->csv ( lst sep )
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)
(defun LM:csv-addquotes ( str sep / pos )
(cond
( (wcmatch str (strcat "**"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
( str )
)
)
(defun duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)
<<
|
|
Filename: 304059_fn_maublk_camcoc.lsp
|
|
Tác giả: bighead
Bài viết gốc: 13187
Tên lệnh: bx |
Đố vui
Có thể phần gần gốc sẽ cong hơn phần gần ngọn !
Câu trả lời này chống chỉ định cho trường hợp đầu quắn !  |
Tác giả: duongsatdn
Bài viết gốc: 13188
Tên lệnh: loadit | |
Tác giả: Tot77
Bài viết gốc: 304101
Tên lệnh: editbox |
hoi lien ket DCL-AutoLisp.......
Bạn làm như thế này:
(defun sav()
(setq txt(get_tile "edt1"))
)
(defun reload()
(setq id_dcl(load_dialog "editbox.dcl"))
(new_dialog "editbox" id_dcl)
(action_tile "select" "(setq ddiag 3)(done_dialog)")
(action_tile "accept" "(setq ddiag 2)(sav)(done_dialog)")
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
(start_dialog)
(unload_dialog id_dcl)
)
(defun c:editbox ()
(reload)
(if...
>> Bạn làm như thế này:
(defun sav()
(setq txt(get_tile "edt1"))
)
(defun reload()
(setq id_dcl(load_dialog "editbox.dcl"))
(new_dialog "editbox" id_dcl)
(action_tile "select" "(setq ddiag 3)(done_dialog)")
(action_tile "accept" "(setq ddiag 2)(sav)(done_dialog)")
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
(start_dialog)
(unload_dialog id_dcl)
)
(defun c:editbox ()
(reload)
(if (= ddiag 1)
(progn
(princ "chuong trinh da thoat: ")
)
)
(if (= ddiag 3)
(progn
(setq ss (ssget))
(reload)
)
)
(if (= ddiag 2)
(progn
(command "text" "j" "mc" '(0 0) 2.5 0 txt)
(setq sname(ssname ss 0)
obj(vlax-ename->vla-object sname)
are(rtos (vla-get-area obj) 2 3)
ss1(ssget)
sname1(ssname ss1 0)
obj1(vlax-ename->vla-object sname1)
)
(vla-put-textstring obj1 are)
(princ "chay OK: ") (princ)
)
)
)
[
<<
|
|
Filename: 304101_editbox.lsp
|
|
Tác giả: phamdung
Bài viết gốc: 13196
Tên lệnh: ljj |
Phần mềm trắc dọc
maca man nedir Just 604 days after winning the Super Bowl, they are part of the sad sack quartet with the Steelers, Bucs and Jaguars as the only winless teams. Theyâve been outscored 146-61. Their minus-85 point differential is better than only the Jaguars, who might be a historically bad team. >> maca man nedir Just 604 days after winning the Super Bowl, they are part of the sad sack quartet with the Steelers, Bucs and Jaguars as the only winless teams. Theyâve been outscored 146-61. Their minus-85 point differential is better than only the Jaguars, who might be a historically bad team. goodlookingloser penomet vs bathmate Abe ordered the Minister of Economy, Trade and Industry to urgently deal with the water situation and ensure the plant"s operator, Tokyo Electric Power Co, takes appropriate action to deal with the cleanup, which is expected to take more than 40 years and cost $11 billion. nugenix at gnc stores Recent heavy rains have caused mill shutdowns, stallingcrushing of Brazil"s bumper cane crop and prompting a slightrecovery for front-month prices that touched a three-year low of15.93 cents per lb last week. tadaforce online "He"s really excited, obviously. I bet he wishes he was out on the boat racing because he"s just a natural competitor," Spithill told reporters. "On the other side, he"s obviously a very busy man running a business." grow max pills review Once negotiators came up with a draft list of 256 products on which to cut tariffs, countries were asked to identify any "sensitive" items that they wanted to exclude from the agreement or reserve for long tariff phase-outs. other names for tongkat ali The Collins measure has drawn some bipartisan interest, but Senate Democratic leaders oppose it, contending it would give up too much, including scrapping a new medical device tax that would raise $30 billion over 10 years for President Barack Obama"s healthcare law, aides said. what is natural gain plus Thousands are drawn to the Stand Up With Texas Women Rally at State Capitol before the start of the second special session, Monday, July 1, 2013. The anti-abortion legislation rally drew thousands of supporters. penomet europe Fox already has a profitable base of 22 regional sports channels it can tap for its new network. Slated live programming includes college football and basketball games, European soccer, horse racing, ultimate fighting-championship bouts, and select car racing. virectin reviews 2013 The parts involved in the Justice Department"s investigationhave included heater control panels that regulate a car"stemperature, switches for turn signals and wiper blades, powerlocks, dashboard panel instruments, airbags, steering wheels andseat belts. caverject needle size After insisting the main flaw in the cityâs new 911 emergency call system was with the people who dispatched responders, City Hallâs top man on the project admitted that there had been technical glitches. viarex trial promo Asked if there was a timetable, he said: "The Privy Council meets tomorrow, we had a meeting of our committee yesterday. There are a few remaining Is to be dotted and Ts to be crossed following that discussion, so no final decision has been made. endowmax at walmart Derek Jeter opted not to say much on the matter, as he hadnât yet heard of Braunâs suspension when he was approached by reporters. Still, the Captain indicated that while any PED talk detracts from the sport. Braunâs penalty was a positive step in the gameâs fight against drugs. <<
|
Tác giả: thanhduan2407
Bài viết gốc: 304284
Tên lệnh: grm |
LISP truy xuất thông tin đối tượng trong GROUP
Tuyệt vời rồi bác.
Bạn dùng cái này cũng được. Ở đây tôi không kiểm tra đối tượng có thuộc group hay không, tức là bạn phải biết chắc nó thuộc group nào đó (vì acad proxy cũng có mã 102 và 330).
(defun c:grm()
(setq a (car (entsel "\nChon 1 doi tuong cua group:")))
(if (assoc 102 (entget a))
(progn
(setq b (assoc 330 (entget a)))
...
>> Tuyệt vời rồi bác.
Bạn dùng cái này cũng được. Ở đây tôi không kiểm tra đối tượng có thuộc group hay không, tức là bạn phải biết chắc nó thuộc group nào đó (vì acad proxy cũng có mã 102 và 330).
(defun c:grm()
(setq a (car (entsel "\nChon 1 doi tuong cua group:")))
(if (assoc 102 (entget a))
(progn
(setq b (assoc 330 (entget a)))
(vl-remove-if-not '(lambda(x) (member b (entget x)))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X"))))))
)
)
Để em test nốt cái bác Hạ xem đã ạ
<< |
Tác giả: Tot77
Bài viết gốc: 304283
Tên lệnh: grm |
LISP truy xuất thông tin đối tượng trong GROUP
Bạn dùng cái này cũng được. Ở đây tôi không kiểm tra đối tượng có thuộc group hay không, tức là bạn phải biết chắc nó thuộc group nào đó (vì acad proxy cũng có mã 102 và 330).
(defun c:grm()
(setq a (car (entsel "\nChon 1 doi tuong cua group:")))
(if (assoc 102 (entget a))
(progn
(setq b (assoc 330 (entget a)))
(vl-remove-if-not '(lambda(x) (member b (entget...
>> Bạn dùng cái này cũng được. Ở đây tôi không kiểm tra đối tượng có thuộc group hay không, tức là bạn phải biết chắc nó thuộc group nào đó (vì acad proxy cũng có mã 102 và 330).
(defun c:grm()
(setq a (car (entsel "\nChon 1 doi tuong cua group:")))
(if (assoc 102 (entget a))
(progn
(setq b (assoc 330 (entget a)))
(vl-remove-if-not '(lambda(x) (member b (entget x)))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X"))))))
)
)
<< |
Tác giả: thanhduan2407
Bài viết gốc: 304286
Tên lệnh: lcui |
Gọi Tool Bar trong CUI vừa Add
HIện tại em đã gom cách thức để Add Menu và Tool Bar vào Autocad.
Tuy nhiên, nếu CUI có nhiều menu và nhiều Tool Bar thì chưa Load được hết ạ.
Mong được các bác chỉ giáo cho em với ạ.
(defun C:LCUI ( / menu acadobj menus MnBar flag n PD1 )
(progn
(setq menu "C:\\Program Files\\AutoCAD 2007\\Template\\ISO-Vinx.cui")
(setq acadobj (vlax-get-acad-object))
(setq menus...
>> HIện tại em đã gom cách thức để Add Menu và Tool Bar vào Autocad.
Tuy nhiên, nếu CUI có nhiều menu và nhiều Tool Bar thì chưa Load được hết ạ.
Mong được các bác chỉ giáo cho em với ạ.
(defun C:LCUI ( / menu acadobj menus MnBar flag n PD1 )
(progn
(setq menu "C:\\Program Files\\AutoCAD 2007\\Template\\ISO-Vinx.cui")
(setq acadobj (vlax-get-acad-object))
(setq menus (vla-get-menuGroups acadobj))
(setq MnBar
(vla-get-MenuBar
(vlax-get-Acad-Object)
)
)
(setq flag nil)
(vlax-for n menus
(if (= (vla-get-name n) "ISO-Vinx")
(setq flag T)
)
(terpri)
)
(if (= flag nil)
(progn
(vla-load menus menu)
(setq PD1 (vla-item (vla-get-menus (vla-item menus "ISO-Vinx")) 0))
(vla-InsertInMenubar PD1 (vla-get-Count MnBar))
)
)
(setq newMenuGroup (vla-Item (vla-get-MenuGroups (vlax-get-Acad-Object)) "ISO-Vinx"))
(setq newToolBar (vla-item (vla-get-Toolbars newMenuGroup) 0))
(vla-put-Visible newToolBar :vlax-true)
(setq ltb nil lpm nil)
(vlax-for item newToolBar (setq ltb (cons (vla-get-name item) ltb)))
(vlax-for item PD1
(setq lpm (cons (list (vla-get-Index item) (vla-get-TagString item) (vla-get-Caption item) (vla-get-Macro item)) lpm))
)
(setq lpm (vl-sort lpm '(lambda(x y) (car x) (car y))))
)
(princ)
)
<<
|
|
Filename: 304286_lcui.lsp
|
|
Tác giả: nevercry_hp
Bài viết gốc: 304341
Tên lệnh: jt |
Sửa giùm mình lisp
có vẻ khó..
vậy nên pro nào viết giùm mình cái list nối "text1" vs "text2" thành 1 text có dạng "text1-text2L"
Mình cũng có cái lisp join text dưới đây nhưng nó ko chạy được cho nhiều text cùng lúc..vậy nhờ pro nào sửa này chạy nhiều text 1 lúc, thứ tự kết nối là chạy theo vòng lặp cứ text1 hàng 1 nối với text2 hàng 2, nếu 2 cột text số lượng ko bằng nhau thì báo...
>> có vẻ khó..
vậy nên pro nào viết giùm mình cái list nối "text1" vs "text2" thành 1 text có dạng "text1-text2L"
Mình cũng có cái lisp join text dưới đây nhưng nó ko chạy được cho nhiều text cùng lúc..vậy nhờ pro nào sửa này chạy nhiều text 1 lúc, thứ tự kết nối là chạy theo vòng lặp cứ text1 hàng 1 nối với text2 hàng 2, nếu 2 cột text số lượng ko bằng nhau thì báo lỗi..
Thank!
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/34577-co-lisp-nao-biet-cac-text-don-le-thanh-1-mtext-khong/
(defun C:jt (/ i ent obj obj1 ss btwtxt )
(vl-load-com)
(princ "\nSelect First Text or MText Entity: ")
(while (not (and (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))))
(setq ent (ssname ss 0))
(setq obj1 (vlax-ename->vla-object ent))
)
)
(princ "\nError with selection please select again: ")
)
(if(=(cdr(assoc 0 (entget ent))) "MTEXT")
(setq btwtxt "\\P") ;Return in MText.
(setq btwtxt "-") ;Or space between Text selections.
)
(redraw(ssname(ssget "P")0)3) ;Highlight First selection.
(princ "\nSelect text or mtext entities to add to first: ")
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
ss (ssget ":S" (list (cons 0 "TEXT,MTEXT")))
i 0 ;Start with first selection.
)
(if(ssmemb ent ss)(ssdel ent ss))
; Don't delete First selection if selected again.
(repeat (sslength ss)
(vla-startundomark thisdrawing)
(setq ent (ssname ss i)
obj (vlax-ename->vla-object ent)
i (1+ i) ;increment to next selection.
)
(if(= btwtxt " ")
(while(vl-string-search "\\P" (vla-get-textstring obj))
(vla-put-textstring obj
(vl-string-subst " " "\\P" (vla-get-textstring obj))
)
)
)
(vla-put-textstring obj1
(strcat
(vla-get-textstring obj1)
btwtxt
(vla-get-textstring obj)
"L"
)
)
(vla-delete obj)
(vla-endundomark thisdrawing)
)
(princ)
)
<< |
Tác giả: Tot77
Bài viết gốc: 304350
Tên lệnh: nt |
Sửa giùm mình lisp
Bạn dùng cái này, chỉ quét 2 cột profile và chiều dài thôi, cái nào có chiều dài thì nó mới nối.
(defun C:nt(/ tm tm1 cao)
(defun dxf (id v) (cdr (assoc id (entget v))))
(setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
'(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm))))
(while tm
(setq...
>> Bạn dùng cái này, chỉ quét 2 cột profile và chiều dài thôi, cái nào có chiều dài thì nó mới nối.
(defun C:nt(/ tm tm1 cao)
(defun dxf (id v) (cdr (assoc id (entget v))))
(setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
'(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm))))
(while tm
(setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
'(lambda (x y) (< (caar x) (caar y)) ))
tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
(if (= (length tm1) 2)
(entmod (subst
(cons 1 (strcat (dxf 1 (last (car tm1))) "-" (dxf 1 (last (last tm1))) "L"))
(assoc 1 (entget (last (car tm1)))) (entget (last (car tm1)))))
)
) (princ)
)
<< |
Tác giả: Tot77
Bài viết gốc: 304359
Tên lệnh: tinh |
Sửa giùm mình lisp
Vậy sửa cái lisp trên chút xíu. Cứ quét hết 3 cột rồi nhập phép tính +-*/ . Không cần phải quét từng cột nếu 3 cột sát nhau.
(defun C:tinh(/ tm tm1 cao)
(defun dxf (id v) (cdr (assoc id (entget v))))
(setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
'(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40...
>> Vậy sửa cái lisp trên chút xíu. Cứ quét hết 3 cột rồi nhập phép tính +-*/ . Không cần phải quét từng cột nếu 3 cột sát nhau.
(defun C:tinh(/ tm tm1 cao)
(defun dxf (id v) (cdr (assoc id (entget v))))
(setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
'(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm)))
ptinh (getstring "\nPhep tinh:"))
(while tm
(setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
'(lambda (x y) (< (caar x) (caar y)) ))
tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
(if (= (length tm1) 3)
(entmod (subst
(cons 1 (rtos ((eval (read ptinh)) (atof (dxf 1 (last (car tm1))))
(atof (dxf 1 (last (cadr tm1)))))))
(assoc 1 (entget (last (last tm1)))) (entget (last (last tm1)))))
)
) (princ)
)
<<
|
|
Filename: 304359_tinh.lsp
|
|