KangKung
-
Số lượng nội dung
192 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
28
Bài đăng được đăng bởi KangKung
-
-
-
App cho các bác quan tâm đây ạ. Mới code xong nên có thể có lỗi. Các bác Test và phản hồi giúp. Thanks
-
1
-
-
Khi làm việc với các file word có nhiều hình ảnh thì dung lượng của file đó thường rất nặng và gây khó khăn cho việc gửi qua email hay upload lên Internet nếu như đường truyền chậm. Các ứng dụng nén file như Zip hay Rar chỉ nén được Text thôi chứ khó mà nén được hình ảnh nên dung lượng file word cũng không giảm đi đáng kể. Tôi thường làm việc với tốc độ Internet chậm nên đặc biệt quan tâm đến dung lượng của file khi gửi thư. Vì vậy tôi có viết 1 App dùng để nén ảnh trong file word. Sau khi nén thì dung lượng ảnh giảm đi đáng kể (60-90%) nhưng chất lượng ảnh vẫn gần như tương đương file gốc.
Không biết trên diễn đàn đã có App nào như vậy chưa? Nếu chưa có và anh em Cadviet quan tâm, tôi sẽ chia sẻ.
-
1
-
1
-
-
8 giờ trước, anhcos đã nói:Cái này thì dễ, bác cứ theo sự kiện DropDown của ComboBox mà lấy lại danh sách bản vẽ đang mở từ AutoCAD thôi.
Vấn đề là tôi muốn App cập nhật ngay khi người dùng đóng bản vẽ. Nếu dùng sự kiện DropDown của ComboBox thì App chỉ update khi người dùng di chuột vào ComboBox và nó còn xảy ra chậm hơn sự kiện Me.Activated và Me.MouseEnter mà tôi đang dùng.
19 giờ trước, ksxdTVC đã nói:Cách này cũng được rồi nè, không thì cứ thêm 1 nút refresh, mỗi lần qua form thì nhấn nút cho nó load lại danh sách. :D
Cách này thì còn thủ công hơn nữa.
Cảm ơn các bác đã góp ý.
-
Hiện tại thì tôi đang dùng Me.Acticvated ( thêm Me.MouseEnter nữa) để update cái List bản vẽ trong App. Hơi thủ công tí nhưng dùng tốt khi chưa biết cách bắt sự kiện trên bản vẽ.
-
8 giờ trước, hung37cespk đã nói:thông qua thuộc tính IsReadOnly của document bạn có thể biết bản vẽ có được mở hay không mà
Vấn đề là như này bác ơi:
1. Chạy một App được viết bằng VB.net ( .exe )
2. Link App với AutoCAD (CAD đã mở từ trước) thì toàn bộ bản vẽ đang mở trong AutoCAD sẽ được list trong combobox như hình dưới:
3. Nếu người dùng đóng 1 file bất kì trong CAD (ví dụ đóng file "Drawing5.dwg" bằng phần mềm AutoCAD) thì làm sao để combobox tự động update như hình dưới. (App tự động update ngay khi có sự kiện nào ở AutoCAD như đóng file hoặc đóng phần mềm AutoCAD)
-
Tôi có một chương trình khi chạy sẽ list các file bản vẽ đang mở trong CAD. Nếu người dùng đóng một file bất kì hoặc tắt AutoCAD đi thì làm sao để hiển thị thông báo sang phần mềm được? Bác nào biết chỉ giùm cách với. Thanks.
-
Lisp của bác Hạ chạy tốt, người viết Lisp có tâm, tuy nhiên còn có lỗi lấy nhầm Justify của Text. Chỉ đúng khi Justify là Left còn lại thì lấy sai điểm dẫn đến lưới mô hình độ cao bị lệch do đó đường đồng mức cũng lệch theo. Bác Hạ nên thay đoạn mã này: (setq lstXYZ (mapcar '(lambda(ent) (cdr (assoc 10 (entget ent)))) lstEnt))
bằng đoạn mã sau đây: (setq lstXYZ (mapcar '(lambda(ent) (if (= (+ (cdr(assoc 72 (setq txt(entget ent)))) (cdr(assoc 73 txt))) 0) (cdr (assoc 10 txt)) (cdr (assoc 11 txt)))) lstEnt))
-
1
-
-
Lisp theo yêu cầu của bạn đây
(defun c:CopyToLayouts (/ *error* ss)
(princ "\rCOPYTOLAYOUTS ")
(vl-load-com)
(defun *error* (msg)
(if acDoc (vla-endundomark acDoc))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** ")))) ; Fatal error, display it
(princ))
(prompt "\nSelect objects to copy to layouts: ")
(if (setq ss (ssget "_:L"))
((lambda (acDoc / oItemList oCurLayout)
(vla-startundomark acDoc)
(vlax-for oItem (setq ss (vla-get-activeselectionset acDoc))
(setq oItemList (cons oItem oItemList)))
(vlax-for oLayout (vla-get-layouts acDoc)
(if (and (/= (cond
(oCurLayout)
((setq oCurLayout (vla-get-activeLayout acDoc))))
oLayout)
(/= "Model" (vla-get-name oLayout)))
(vlax-invoke
acDoc
"copyobjects"
oItemList
(vla-get-block oLayout))))
(vla-delete ss)
(*error* nil))
(vla-get-activedocument (vlax-get-acad-object)))
(prompt "\n** Nothing selected ** "))
(princ))
-
2
-
-
Chưa hiểu yêu cầu của bạn Han Tinh. Có thể cho 1 ví dụ cụ thể hơn bằng bản vẽ không?
-
Lisp theo yêu cầu của bạn conghoa đây
;==========LISP CHIA MOI VIEWPORT THANH 1 LAYOUT================ (defun C:CVP( / ACTDOC CLAYOUT LST_VIEWPORT) (vl-load-com) (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (if (= (getvar "TILEMODE") 0) (progn (if (/= (getvar "cvport") 1) (command "PSPACE")) (command "UNDO" "BE") (if (setq lst_Viewport (#SS->List (ssget '((0 . "VIEWPORT"))))) (foreach viewport lst_Viewport (command "layout" "N" (strcat "KH-" (itoa (1+ (vl-position viewport lst_Viewport))))) (command "layout" "Set" (strcat "KH-" (itoa (1+ (vl-position viewport lst_Viewport))))) (setq cLayout (vla-get-ActiveLayout ActDoc)) (vlax-invoke ActDoc 'CopyObjects (list (vlax-ename->vla-object viewport)) (vla-get-Block cLayout) nil) (command "MOVE" "All" "" (Getvar "EXTMIN") (list 0 0)) (command "ZOOM" "E") ) ) ) ) (princ) ) (Defun #SS->List (ss / i lst) (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst))))-
1
-
-
Của bạn đây.
Hướng dẫn:
1. Lệnh CLO
2. Chọn máy in, khổ giấy, style...
3. Đặt tên Layout, tỉ lệ
4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.
5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.
6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout.
;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL (vl-load-com) (defun Make_dcl (/ ret) (if (= Printer nil) (setq Printer 0)) (if (= Size nil) (setq Size 0)) (if (= Style nil) (setq Style 0)) (if (= Block nil) (setq Block 0)) (if (= TenLayout nil) (setq TenLayout "Layout")) (if (= Tyle nil) (setq Tyle "1000")) (setq fl (vl-filename-mktemp "CLO" nil ".dcl")) (setq ret (open fl "w")) (write-line (strcat "CLO : dialog { label = \"Create Layout\"; : column { : boxed_column {label = \"Page Setup\"; : popup_list { key=\"Printer\"; label= \"Printer\"; value = \"" (itoa Printer) "\"; edit_width = 40;} : popup_list { key=\"PaperSize\"; label= \"Paper Size \"; value = \"" (itoa Size) "\"; edit_width = 40;} : popup_list { key=\"Style\"; label= \"Style \"; value = \"" (itoa Style) "\";edit_width = 40;} : edit_box { key = \"LO_name\"; label = \"Layout Name \"; value = \"" TenLayout "\";edit_width = 20;} : edit_box { key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}} : button { key = \"Chonkhung\"; label = \"Select Frame \"; } : boxed_column { label = \"\"; :row { : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;} : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}} : row { : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;} : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}} : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";} } : boxed_row { : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;} : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} " ) ret ) (setq ret (close ret)) ) (defun *error* (msg) (vl-file-delete fl)) (defun Chon () (vl-file-delete fl) (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE")))) (Make_dcl) (setq ddiag 3) ) (defun TaoBlock (/ taphop pt) (vl-file-delete fl) (alert "Chon doi tuong de tao Block khung ten") (if (/= (setq taphop(ssget)) nil) (progn (setq pt(getpoint "\n Chon Base point cua Block: ")) (setq ten(lisped "Nhap ten cua Block")) (while (/= (tblsearch "Block" ten) nil) (setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block"))) (command "BLOCK" ten pt taphop "") (setq dsblock(cons "" (tablelist "Block"))) )) (Make_dcl) (setq ddiag 3) ) (defun Update () (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin)) (setq dsPaper (PaperList)) (start_list "PaperSize" 3) (mapcar 'add_list dsPaper) (end_list) ) (defun Chon_Xref () (if (not Path) (setq Path(getvar "dwgprefix"))) (setq File(getfiled "Chon File khung ten" Path "dwg" 2)) (if (/= File nil) (setq Path File dsFile (list File))) (start_list "Xref_File" 3) (mapcar 'add_list dsFile) (end_list) ) (defun Remove_Xref () (setq File "" dsFile (list File)) (start_list "Xref_File" 3) (mapcar 'add_list dsFile) (end_list) ) (defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object)))) (defun PlotDeviceNamesList () (vla-RefreshPlotDeviceInfo (ActLay)) (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay))))) (defun PaperList (/ PLObj PSL) (setq PLObj (vla-GetCanonicalMediaNames (ActLay))) (foreach i (vlax-safearray->list (vlax-variant-value PLObj)) (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i)))))) (defun PlotStyleTableNamesList () (vla-RefreshPlotDeviceInfo (ActLay)) (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay))))) (defun tablelist (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)))) (defun DeleteLayouts (/ layouts layout i) (vl-load-com) (setq layouts (vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object)))) (if (> (vla-get-count layouts) 2) (vlax-for layout layouts (if (= (vla-get-ModelType layout) :vlax-false) (if (< (vla-get-count (vla-get-block layout)) 2) (vla-delete layout)))))) (setq dsmayin (PlotDeviceNamesList)) (setq dsStyle (PlotStyleTableNamesList)) (setq dsblock(cons "" (tablelist "Block"))) (defun hopthoai () (setq dcl_id (load_dialog fl)) (if (not (new_dialog "CLO" dcl_id)) (exit)) (start_list "Printer" 3) (mapcar 'add_list dsmayin) (end_list) (Update) (action_tile "Printer" "(Update)") (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)") (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)") (start_list "Style" 3) (mapcar 'add_list dsStyle) (end_list) (start_list "Block" 3) (mapcar 'add_list dsBlock) (end_list) (start_list "Xref_File" 3) (mapcar 'add_list dsFile) (end_list) (action_tile "Select_Xref" "(Chon_Xref)") (action_tile "Xref_File" "(Chon_Xref)") (action_tile "Remove" "(Remove_Xref)") (action_tile "cancel" "(setq ddiag 1)(done_dialog)") (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" ) (start_dialog) (unload_dialog dcl_id) ) (defun saveVars () (setq Printer (atoi (get_tile "Printer"))) (setq Size (atoi (get_tile "PaperSize"))) (setq Style (atoi (get_tile "Style"))) (setq Tyle (get_tile "Tyle")) (setq Block (atoi (get_tile "Block"))) (setq Printer1 (nth Printer dsmayin)) (setq Size1 (nth Size (PaperList))) (setq Style1 (nth Style dsStyle)) (setq TenLayout (get_tile "LO_name")) (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000)) (setq Block1 (nth Block dsBlock)) ) (defun C:CLO (/ os) (setvar "CMDECHO" 0) (command "UNDO" "BE") (setq os(getvar "OSMODE")) (setvar "OSMODE" 0) (setvar "TILEMODE" 1) (setq dsblock(cons "" (tablelist "Block"))) (if (= File nil) (setq dsFile (list ""))) (setq tieptuc 0) (Make_dcl) (setq ddiag 3) (while (= ddiag 3) (hopthoai) (if (= ddiag 5) (Chon)) (if (= ddiag 9) (TaoBlock)) ) (vl-file-delete fl) (if (= tieptuc 1) (progn (Sapxepkhung) (Make_Layout) (DeleteLayouts) ) ) (setvar "OSMODE" os) (command "UNDO" "END") (princ) ) (defun Sapxepkhung(/ index khung S1 S2 D1 D2) (setq index 0) (setq lst_Khung(list)) (setq S1 0 S2 0) (while (< index (sslength taphop)) (setq khung (ssname taphop index)) (setq lst_Khung(append lst_Khung (list(list khung S1 S2)))) (setq index (1+ index)) ) (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2)))))))) ) (defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2) (setq disp(getenv "CreateViewports")) (setenv "CreateViewports" "0") (setq index 1) (foreach khung1 lst_Khung (setq khung (car khung1)) (setq lst (acet-geom-vertex-list khung)) (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2)))))) (setq pt0 (nth 0 lst) pt3 (nth 3 lst)) (if (> (cadr (nth 1 lst)) (cadr (nth 2 lst))) (setq pt1 (nth 1 lst) pt2 (nth 2 lst)) (setq pt1 (nth 2 lst) pt2 (nth 1 lst))) (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index)))) (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index)))) (command "ERASE" "ALL" "") (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" "")) (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" "")) (command "ZOOM" "E") (if (> (distance pt2 pt0) (distance pt1 pt0)) (command "RECTANG" (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1))) (command "RECTANG" (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1))) ) (command "MVIEW" "O" (entlast)) (command "MSPACE") (if (> (distance pt2 pt0) (distance pt1 pt0)) (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "") (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) "")) (command "ZOOM" "W" pt0 pt3) (command "PSPACE") (command "ZOOM" "E") (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX")) (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N") (command "MODEL") (setq index (+ index 1)) ) (setenv "CreateViewports" disp) (princ) ) (princ "\n Type CLO to run program\n")-
4
-
-
Tặng bạn Lisp này. Xem được cả màu RGB và Color Index.
(defun C:SD(/ obj oColor) (setq obj(vlax-ename->vla-object(car(nentsel)))) (setq oColor(vlax-get-property obj 'TrueColor)) (princ "\nRGB = ") (princ (vla-get-red oColor)) (princ ",") (princ (vla-get-green oColor)) (princ ",") (princ (vla-get-blue oColor)) (princ "\nIndexColor = ") (princ (vla-get-colorindex oColor)) (princ) )
-
Cái này thì phải có chuyên môn về Trắc địa thì mới làm được Polyline ah.
-
Lâu quá không ghé thăm Cadviet nên chậm trễ trong việc phản hồi mong các bạn thông cảm.
Chào bạn minhphuong_humg. Kết quả convert của bạn hoàn toàn đúng không có vấn đề gì cả. Việc số liệu nhảy sang Trung Quốc là do mình lấy số liệu ngẫu nhiên thôi chứ không phải số liệu thực tế.
Bạn phuongkq. Số liệu của bạn ở dạng tọa độ phẳng XY trong khi Lisp mình viết chỉ convert số liệu ở dạng tọa độ WGS84 thôi. Bạn chuyển đổi số liệu từ hệ XY sang WGS84 trước khi chạy Lisp là được.
-
1
-
-
Lisp chuyển màu, linetype, lineweight tất cả các đối tượng trong bản vẽ về ByLayer.
(defun C:ByLayer() (vl-load-com) (vla-startundomark (vla-get-activedocument(vlax-get-acad-object))) (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))) (vlax-for item for-item (vla-put-Lineweight item -1) (vla-put-color item 256) (vla-put-linetype item "ByLayer") ) ) (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) (princ) )-
4
-
-
(VLA-PUT-COLOR item 256)
-
2
-
-
ThuyLinh nhầm rồi. Lisp trên hỗ trợ nhiều kiểu truy bắt điểm cùng lúc chứ không phải chỉ duy nhất 1 kiểu. Chỉ thực hiện 1 kiểu bắt điểm duy nhất khi người dùng chọn cách bắt điểm bằng menu khi rightclick.
-
Góp vui với bác Hạ chút.
http://www.cadviet.com/upfiles/3/71162_lisp_ve_hcn_nghiengosnap_ver10_1.lsp
Đây là Lisp vẽ hình chữ nhật có sử dụng grread và osnap để tạo hiệu ứng động cho đẹp mắt. Mục đích của Lisp này là vẽ hình chữnhật không chỉ theo phương đứng hoặc phương nằm ngang mà còn có thể vẽ theo hướng xiên bất kì. Lisp cho phép bắt điểm bằng osnap trong khi đang thực hiện lệnh. Có thể bấm F3 để On/Off chế độ Osnap hoặc chọn chế độ bắt điểm bằng Shift+Rightclick (or Rightclick). Ngoài ra còn có thể On/Off chế độ Orthormode để chuyển HCN từ xiên thành ngang.
;; Lisp ve Hinh chu nhat (dung, nam ngang, nghieng) ;; ;;---------------------------------------------------------------------------;; ;; Author: KangKung 01-10-2013 v1.0 ;; ;; Member of CADMagic Group ;; ;;---------------------------------------------------------------------------;; (vl-load-com) (defun OrthoRound (ang) (* (/ pi 2) (fix (/ (+ (/ pi 4) ang) (/ pi 2)))) ) (defun *error* (msg) (redraw) (setvar "osmode" os) ) (defun C:Tre( / os ANG ANG1 GR PT PT1 str LOOP N PO PT X-DIM Y-DIM rightclick batdiem os_pre pt temp) (setq temp '(25 0)) (vla-startundomark (vla-get-activedocument(vlax-get-acad-object))) (setq os(getvar "osmode")) (setq rightclick 0) (initget 1) (setq pt1(getpoint "\n Specify first corner point: ")) (setq ang(getangle pt1 "\n Angle: ")) (setq ang1 ang) (prompt "\n Specify second corner point: ") (setq loop T) (while (and (setq gr (grread T 12 0)) loop) (cond ;; Dragging ((= 5 (car gr)) (redraw) (setq pt (cadr gr)) (if (and (< 0 (getvar "osmode") 16384) (setq po (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap pt x)) (list (distance pt o) o x pt)))) (get_osmode))))) (setq po (cdar (vl-sort po (function (lambda (a b) (< (car a) (car b)))))) pt (car po)) (setq po nil)) (and po (OsMark po)) (#eMake:Rectang_grvecs pt1 pt nil nil ang nil) ) ;; Picked point = ends loop ((= 3 (car gr)) (#eMake:Rectang pt1 pt nil nil ang nil) (redraw) (setq loop nil)) ;; Enter = reads the command line input ((or (equal gr '(2 13)) (equal gr '(2 32))) (cond ;; valid distance = ends loop ((and str (= (substr str 1 1) "@")) (setq str(vl-string-left-trim "@" str)) (setq n(vl-string-search "," str)) (setq X-dim(substr str 1 n)) (setq Y-dim(substr str (+ n 2))) (if (and (distof X-dim) (distof Y-dim) (/= (+ (distof X-dim) (distof Y-dim)) 0)) (progn (#eMake:Rectang pt1 nil (distof X-dim) (distof Y-dim) ang nil) (redraw) (setq loop nil) (grtext) ) (princ "\nInvalid Input\n") ) ) ;; valid point = ends loop ((and str (setq pt (str2pt str))) (#eMake:Rectang pt1 pt nil nil ang nil) (redraw) (setq loop nil) (grtext) ) ;; invalid input (T (setq str nil) (princ "\nInvalid Input\n") ) ) ) ;Right click ((= 25 (car gr)) (setq rightclick(1+ rightclick)) (if (= rightclick 1) (setq os_pre(getvar "osmode"))) (setq temp gr) (setq batdiem(menu-pop500 gr)) (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua") (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea") (2048 "_app")) (if (= batdiem (cadr a)) (setvar "osmode" (car a)))) ) ;Shift + Right click ((equal gr '(11 1000)) (setq rightclick(1+ rightclick)) (if (= rightclick 1) (setq os_pre(getvar "osmode"))) (setq batdiem(menu-pop500 temp)) (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua") (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea") (2048 "_app")) (if (= batdiem (cadr a)) (setvar "osmode" (car a)))) ) ;; F3 = toggles osmode ((equal gr '(2 6)) (if (= (getvar "osmode") 0) (setvar "osmode" (if (/= os 0) os 15359)) (setvar "osmode" (if (/= os 0) 0 os)) )) ;; F8 = toggles orthomode ((equal gr '(2 15)) (setvar "ORTHOMODE" (boole 6 1 (getvar "ORTHOMODE"))) (if (= (getvar "ORTHOMODE") 1) (setq ang(OrthoRound ang)) (setq ang ang1) ) (princ (chr 8)) (princ (chr 32)) ) ;; getting and printing command line input (T (if (= (cadr gr) 8) ;_ backspace (or (and str (/= str "") (setq str (substr str 1 (1- (strlen str)))) (princ (chr 8)) (princ (chr 32)) ) (setq str nil) ) (or (and str (setq str (strcat str (chr (cadr gr))))) (setq str (chr (cadr gr))) ) ) (and str (princ (chr (cadr gr)))) ) ) ) (if os_pre (setvar "osmode" os_pre)) (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) (princ) ) ;--------------------------------------------------------------------------- SUB FUNCTIONS ;----- T¹o Icon Osnap vµ g¸n vµo ®iÓm po, EX: !po = ((94.4953 17.8586 0.0) "_mid" (94.0427 14.9045 0.0)), lÊy pt = (car po). (defun osMark (o / s osGrv) (setq osGrv (osmode-grvecs-lst (vla-get-AutoSnapMarkerColor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object)) ) ) (vla-get-AutoSnapMarkerSize (vla-get-drafting (vla-get-preferences (vlax-get-acad-object)) ) ) ) ) (setq s (/ (getvar "viewsize") (cadr (getvar "screensize"))) o (cons (trans (car o) 1 3) (cdr o)) ) (grvecs (cdr (assoc (cadr o) osGrv)) (list (list s 0. 0. (caar o)) (list 0. s 0. (cadar o)) (list 0. 0. s 0.) (list 0. 0. 0. 1.) ) ) ) (defun osmode-grvecs-lst (col ass / -ass ass col) ; By Evgeniy Elpanov (Modified by Lee McDonnell) (setq -ass (- ass)) (list (list "_end" col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list ass ass) (list ass -ass) col (list (1+ ass) (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_mid" col (list -ass -ass) (list 0. ass) col (list (1- -ass) (1- -ass)) (list 0. (1+ ass)) col (list 0. ass) (list ass -ass) col (list 0. (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_cen" 7 (list (* -ass 0.2) 0.) (list (* ass 0.2) 0.) 7 (list 0. (* -ass 0.2)) (list 0. (* ass 0.2)) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5) (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86) (* -ass 0.5)) (list -ass 0.)) (list "_nod" col (list -ass -ass) (list ass ass) col (list -ass ass) (list ass -ass) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5) (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86) (* -ass 0.5)) (list -ass 0.)) (list "_qua" col (list 0. -ass) (list -ass 0.) col (list 0. (1- -ass)) (list (1- -ass) 0.) col (list -ass 0.) (list 0. ass) col (list (1- -ass) 0.) (list 0. (1+ ass)) col (list 0. ass) (list ass 0.) col (list 0. (1+ ass)) (list (1+ ass) 0.) col (list ass 0.) (list 0. -ass) col (list (1+ ass) 0.) (list 0. (1- -ass))) (list "_int" col (list -ass -ass) (list ass ass) col (list -ass (1+ -ass)) (list ass (1+ ass)) col (list (1+ -ass) -ass) (list (1+ ass) ass) col (list -ass ass) (list ass -ass) col (list -ass (1+ ass)) (list ass (1+ -ass)) col (list (1+ -ass) ass) (list (1+ ass) -ass)) (list "_ins" col (list (* -ass 0.1) (* -ass 0.1)) (list -ass (* -ass 0.1)) col (list -ass (* -ass 0.1)) (list -ass ass) col (list -ass ass) (list (* ass 0.1) ass) col (list (* ass 0.1) ass) (list (* ass 0.1) (* ass 0.1)) col (list (* ass 0.1) (* ass 0.1)) (list ass (* ass 0.1)) col (list ass (* ass 0.1)) (list ass -ass) col (list ass -ass) (list (* -ass 0.1) -ass) col (list (* -ass 0.1) -ass) (list (* -ass 0.1) (* -ass 0.1)) col (list (1- (* -ass 0.1)) (1- (* -ass 0.1))) (list (1- -ass) (1- (* -ass 0.1))) col (list (1- -ass) (1- (* -ass 0.1))) (list (1- -ass) (1+ ass)) col (list (1- -ass) (1+ ass)) (list (1+ (* ass 0.1)) (1+ ass)) col (list (1+ (* ass 0.1)) (1+ ass)) (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) col (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) (list (1+ ass) (1+ (* ass 0.1))) col (list (1+ ass) (1+ (* ass 0.1))) (list (1+ ass) (1- -ass)) col (list (1+ ass) (1- -ass)) (list (1- (* -ass 0.1)) (1- -ass)) col (list (1- (* -ass 0.1)) (1- -ass)) (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))) (list "_tan" col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5)(* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86)(* -ass 0.5)) (list -ass 0.)) (list "_per" col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass)) col (list -ass 0.) (list 0. 0.) col (list -ass -1.) (list 0. -1.) col (list 0. 0.) (list 0. -ass) col (list -1. 0.) (list -1. -ass)) (list "_nea" col (list -ass -ass) (list ass ass) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list -ass ass) (list ass -ass) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_app" col (list -ass -ass) (list ass ass) col (list ass -ass) (list -ass ass) col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list ass ass) (list ass -ass) col (list (1+ ass) (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))))) (princ "\n Type TRE to run") ;;;(defun #Rectang(pt) ;;; (redraw) ;;; (#eMake:Rectang2 pt1 pt nil nil ang nil) ;;; ) ;; STR2PT ;; Convert a string into a 3d point (input with grread) ;; ;; Argument: a string (ex: "25,63") ;; Return: a 3d point (ex (25.0 63.0 0.0) or nil if invalid string (defun str2pt (str) (setq str (mapcar 'read (str2lst str ","))) (if (and (vl-every 'numberp str) (< 1 (length str) 4) ) (trans str 0 0) ) ) ;; STR2LST ;; Transforms a string with separator into a list of strings ;; ;; Arguments ;; str = the string ;; sep = the separator pattern (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) ;;----------------=={ Entmake a Rectang }==--------------------------------;; ;; ;; ;; Make a Rectang entity by Entmake ;; ;;-------------------------------------------------------------------------;; ;; Author: KangKung 24-6-2012 v1.0 ;; ;;-------------------------------------------------------------------------;; ;; Arguments: there are 2 options ;; ;; a) pt1, pt2 - First conner, opposite conner (nil if width and Height) ;; ;; Tilt: Tilt angle of Rectang (Radian) ;; ;; lst : List of dxf / nil ;; ;; b) pt1, Width, Height - First conner point, 2 dimension (nil if pt2) ;; ;; Tilt: Tilt angle of Rectang (Radian) ;; ;; lst : List of dxf / nil ;; ;;-------------------------------------------------------------------------;; ;; Returns: Rectang Entity ;; ;;-------------------------------------------------------------------------;; ;; Usage: ;; ;; a) (#eMake:Rectang '(0.0 0.0 0.0) '(5.0 5.0 0.0) nil nil (/ pi 6) nil) ;; ;; b) (#eMake:Rectang '(0.0 0.0 0.0) nil 20 40 (/ pi 6) nil) ;; ;;-------------------------------------------------------------------------;; (defun #eMake:Rectang (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4) (if (/= nil pt2) (progn (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt)))) (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt)))) (setq p1 pt1 p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt)))) p3 pt2 p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt)))) ) ) (setq p1 pt1 p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt)))) p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt)))) p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt)))) ) ) (setq lst_Temp (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4) ) ) (if lst (setq lst_Temp(append lst_Temp lst))) (entmake lst_Temp) ) (defun #eMake:Rectang_grvecs (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4) (if (/= nil pt2) (progn (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt)))) (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt)))) (setq p1 pt1 p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt)))) p3 pt2 p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt)))) ) ) (setq p1 pt1 p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt)))) p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt)))) p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt)))) ) ) (grvecs (list 1 p1 p2 2 p2 p3 5 p3 p4 4 p4 p1)) ) (defun menu-pop500 (d / lst s) ; Choice function of OSNAP through the shortcut menu. ; Only, as an example. ; Is checked up in AutoCad 2004-2007 (En) ; by ElpanovEvgeniy ; (2006-10-11) ; (menu-pop500 (grread t 5)) (setq lst (reverse (menu-index ((lambda (x) (list (1- (vla-get-count x)) x)) (vla-item (vla-get-menus (vla-item (vla-get-menugroups (vlax-get-acad-object) ) ;_ vla-get-MenuGroups "ACAD" ) ;_ vla-item ) ;_ vla-get-Menus "&Object Snap Cursor Menu" ) ;_ vla-item ) ) ;_ menu-index ) ;_ reverse ) ;_ setq (while (and (listp d) (or (= (car d) 5) (= (car d) 11) (= (car d) 12) (= (car d) 25) ; For old version AutoCad ) ;_ or ) ;_ and (cond ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad ((equal d '(11 0)) (menucmd "POP500=*")) ((= (car d) 11) (setq s (nth (- (cadr d) 500) lst))) ) ;_ cond (if s (setq d s) (setq d (grread t 5)) ) ;_ if ) ;_ while (substr s 1 4) ) ;_ defun (defun menu-index (l) ; Creation of the list of choices of choice of OSNAP ; Is checked up in AutoCad 2004-2007 (En) ; by ElpanovEvgeniy ; (2006-10-11) ;| (menu-index ((lambda (x) (list (1-(vla-get-count x)) x)) (vla-item (vla-get-menus (vla-item (vla-get-menugroups (vlax-get-acad-object) ) ;_ vla-get-MenuGroups "ACAD" ) ;_ vla-item ) ;_ vla-get-Menus "&Object Snap Cursor Menu" ) ;_ vla-item ) ) ;_ menu-index |; (if (not (minusp (car l))) (cond ((= (vla-get-type (vla-item (cadr l) (car l))) 0) (cons (vla-get-macro (vla-item (cadr l) (car l))) (menu-index (cons (1- (car l)) (cdr l))) ) ;_ cons ) ((= (vla-get-type (vla-item (cadr l) (car l))) 1) (menu-index (cons (1- (car l)) (cdr l))) ) ((= (vla-get-type (vla-item (cadr l) (car l))) 2) (append (menu-index ((lambda (x) (list (1- (vla-get-count x)) x)) (vla-get-submenu (vla-item (cadr l) (car l))) ) ;_ menu-index ) ;_ menu-index (menu-index (cons (1- (car l)) (cdr l))) ) ;_ append ) ) ;_ cond ) ;_ if ) ;_ defun (defun get_osmode nil ; Function create list osmode macro ; for result (getvar "OSMODE") ; by Evgeniy Elpanov ; (get_osmode) (mapcar (function cdr) (vl-remove-if (function (lambda (x) (zerop (logand (getvar "OSMODE") (car x))) ) ;_ lambda ) ;_ function (append (if (< 0 (setq cur_mode (getvar "osmode")) 16384) '((1 . "_end") (2 . "_mid") (4 . "_cen") (8 . "_nod") (16 . "_qua") (32 . "_int") ;(4096 . "_ext") ; Is not realized ) ) ;_ if (if (not (zerop (logand (getvar "autosnap") 16))) '((64 . "_ins") (128 . "_per") (256 . "_tan") (512 . "_nea") ;(1024 . "_qui") ; Is not realized (2048 . "_app") ;(8192 . "_par") ; Is not realized ) ) ;_ if ) ;_ append ) ;_ substr ) ;_ mapcar ) ;_ defun-
1
-
-
- A và B là 2 điểm trên đường Polyline.
- P là điểm cần xác định.
Lisp xác định vị trí điểm P so với đường Polyline nối từ A đến B.(defun C:test( / A B P kt) (setq A(getpoint "\n Chon diem thu nhat tren Polyline: ")) (setq B(getpoint "\n Chon diem thu hai tren Polyline: ")) (setq P(getpoint "\n Chon diem can kiem tra:")) (setq kt(sin (- (angle A P) (angle A B)))) (cond ((= kt 0) (princ "\nTren duong")) ((< kt 0) (princ "\nBen PHAI duong")) ((> kt 0) (princ "\nBen TRAI duong"))) (princ) )-
1
-
-
Select viewport:; error: AutoCAD variable setting rejected: "cvport" nil
DanKhaosat spam kinh thế. Lỗi trên là do bạn tạo viewport bằng polyline có sẵn. Còn Lisp trên là tôi viết ví dụ cho viewport đơn lẻ thôi. Lisp của HoaVien đã khắc phục được lỗi này.
-
Bạn thử Lisp này xem:
(defun C:test( / n vp) (vl-load-com) (if (= (getvar "Tilemode") 0) (progn (if (/= (getvar "cvport") 1) (command "PSPACE")) (setq vp(car(entsel "\n Select viewport:"))) (setq n(cdr(assoc 69 (entget vp)))) (command "MSPACE") (setvar "cvport" n) (vla-put-twistangle (vlax-ename->vla-object vp) (/ pi 4)) (command "Zoom" "E") ) (alert "\n Chuyen sang Layout truoc khi chay Lisp!") ) (princ) )-
1
-
-
Có đây:
(vl-load-com)
(vla-put-twistangle(vlax-ename->vla-object(car(entsel))) (/ pi 4))
-
1
-
-
<pre class="_prettyXprint _lang-sql">
(defun C:test ()
(vl-load-com)
(if (not (tblsearch "LAYER" "A"))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) "A"))
(if (not (tblsearch "LAYER" "B"))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) "B"))
(if (not (tblsearch "LAYER" "C"))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) "C"))
(if (not (tblsearch "LAYER" "D"))
(vla-add (vla-get-layers(vla-get-ActiveDocument (vlax-get-acad-object))) "D"))
(vlax-for for-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object)))
(vlax-for item for-item
(if (wcmatch (vla-get-ObjectName item) "*Hatch*")
(vla-put-layer item "A")
)
(if (wcmatch (vla-get-ObjectName item) "*Dim*")
(vla-put-layer item "B")
)
(if (wcmatch (vla-get-ObjectName item) "*Leader*")
(vla-put-layer item "C")
)
(if (wcmatch (vla-get-ObjectName item) "*Text*")
(vla-put-layer item "D")
)
)
)
)
</pre>
<p>Lisp trên chỉ tạo ra 4 layer theo yêu cầu của bạn</p>
-
1
-
Chia sẻ App nén dung lượng file word
trong Lập trình khác
Đã đăng · Trả lời báo cáo
@Két: Mấy hôm nữa đi cafe rồi bắt bệnh nhé.