Info | File | ||
Tác giả: quansla Bài viết gốc: 443200 Tên lệnh: phundiem |
lisp Phun tọa độ các điểm từ file txt vào CAD
Lười và ăn sẵn quá
(vl-load-com)
(defun c:phundiem(/ f fn l p r vText2 LM:str->lst)
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
(defun vText2(str p layer k mau)
... Lười và ăn sẵn quá
(vl-load-com)
(defun c:phundiem(/ f fn l p r vText2 LM:str->lst)
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
(defun vText2(str p layer k mau)
(entmakex
(list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1 str);string
(cons 7 (getvar "textstyle"));style
(cons 8 layer);layer
(cons 62 mau);color
(cons 10 p);insertion point
(cons 11 p);alignment point
(cons 40 k);text height - change by suit
(cons 41 1.0);text width
(cons 50 0.0);1.5708 - vertical, 0.0 - horizontal
(cons 51 0.0);oblique angle
'(71 . 0);alignment
'(72 . 0);alignment
'(73 . 0);alignment
)
)
;(princ)
)
;(setq f (getfiled "\nChon file " "" "txt" 2))
(setq f "C:\\Users\\Admin\\Desktop\\33.txt")
(setq fn (open f "r"))
(while (setq l (read-line fn))
(setq r (vl-remove-if '(lambda(x) (= x "")) (LM:str->lst l " "))
p (mapcar 'atof (list (nth 2 r) (nth 3 r) (nth 4 r))))
(vText2 (car r) p "ten_diem" 0.5 1)
(vText2 (cadr r) p "Ghi_chu" 0.25 3)
(entmakex
(list
'( 0 . "POINT")
(cons 10 p)
(cons 62 4)
(cons 8 "Point")))
)
(close fn)
(princ)
)
Nên thu phí đi thôi <<
| ||
Tác giả: phamthanhbinh Bài viết gốc: 228547 Tên lệnh: loctext |
Lọc các Text có cùng chiều cao?
| ||
Tác giả: whatcholingon Bài viết gốc: 169785 Tên lệnh: rb |
Lisp chèn text vào Pl
| ||
Tác giả: Doan Van Ha Bài viết gốc: 421227 Tên lệnh: pmax pmin |
Tìm đối tượng Point có Position Z nhỏ nhất hoặc lớn nhất
Âm mưu của tôi là cố tình chỉ chọn 1 gái đẹp, bởi bạn không nói rõ là sẽ chọn luôn cả đám vào chung kết hoa hậu để làm bồ nhí. Đợi. Lần sau y/c cho rõ vào.
(defun C:PMAX( / lst ss) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (setq lst (vl-sort lst '(lambda (e1 e2) (> (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2))))))) (setq lst... Âm mưu của tôi là cố tình chỉ chọn 1 gái đẹp, bởi bạn không nói rõ là sẽ chọn luôn cả đám vào chung kết hoa hậu để làm bồ nhí. Đợi. Lần sau y/c cho rõ vào.
(defun C:PMAX( / lst ss) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (setq lst (vl-sort lst '(lambda (e1 e2) (> (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2))))))) (setq lst (vl-remove-if-not '(lambda(x) (equal (cadddr (assoc 10 (entget (car lst)))) (cadddr (assoc 10 (entget x))) 1E-3)) lst)) (setq ss (ssadd)) (foreach s lst (ssadd s ss)) (sssetfirst nil ss)) (defun C:PMIN( / lst ss) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (setq lst (vl-sort lst '(lambda (e1 e2) (< (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2))))))) (setq lst (vl-remove-if-not '(lambda(x) (equal (cadddr (assoc 10 (entget (car lst)))) (cadddr (assoc 10 (entget x))) 1E-3)) lst)) (setq ss (ssadd)) (foreach s lst (ssadd s ss)) (sssetfirst nil ss))
<<
| ||
Tác giả: Doan Van Ha Bài viết gốc: 421223 Tên lệnh: pmax pmin |
Tìm đối tượng Point có Position Z nhỏ nhất hoặc lớn nhất
Quick code:
(defun C:PMAX( / lst) ; Max (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (sssetfirst nil (ssadd (car (vl-sort lst '(lambda (e1 e2) (> (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2)))))))))) (defun C:PMIN( / lst) ; Min (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (sssetfirst nil (ssadd (car (vl-sort lst '(lambda (e1 e2) (<... Quick code:
(defun C:PMAX( / lst) ; Max (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (sssetfirst nil (ssadd (car (vl-sort lst '(lambda (e1 e2) (> (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2)))))))))) (defun C:PMIN( / lst) ; Min (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT"))))))) (sssetfirst nil (ssadd (car (vl-sort lst '(lambda (e1 e2) (< (cadddr (assoc 10 (entget e1))) (cadddr (assoc 10 (entget e2))))))))))
<<
| ||
Tác giả: tnmtpc Bài viết gốc: 101863 Tên lệnh: exta |
lisp Phun tọa độ các điểm từ file txt vào CAD
| ||
Tác giả: Danh Cong Bài viết gốc: 443327 Tên lệnh: congdim |
Thay đổi giá trị của dim
| ||
Tác giả: quocmanh04tt Bài viết gốc: 443363 Tên lệnh: tt |
Thay đổi giá trị của dim
Không đúng ý chắc là do khâu trình bày. Không biết lisp dưới đây đã đúng ý chưa? Cách dùng: - Pick điểm cần đo đến đoạn thẳng (LINE hoặc PLINE) . - Pick đoạn thẳng (Pick điểm bất kỳ trên đoạn thẳng) => Kết quả đo luôn là k/c vuông góc từ điểm đến đoạn thẳng...
* Đối với PLINE nhiều phân đoạn: khi pick vào phân đoạn nào thì sẽ DIM đến... >> Không đúng ý chắc là do khâu trình bày. Không biết lisp dưới đây đã đúng ý chưa? Cách dùng: - Pick điểm cần đo đến đoạn thẳng (LINE hoặc PLINE) . - Pick đoạn thẳng (Pick điểm bất kỳ trên đoạn thẳng) => Kết quả đo luôn là k/c vuông góc từ điểm đến đoạn thẳng... * Đối với PLINE nhiều phân đoạn: khi pick vào phân đoạn nào thì sẽ DIM đến phân đoạn đó. ** Trong lisp có con số 13 là số mà bạn có thể chỉnh sửa.
(defun c:tt (/ asp dim doc ent par per poi sel val)
(setq asp (vlax-get (setq doc (vla-get-activedocument (vlax-get-acad-object)))
(cond ((> (vla-get-activespace doc) 0) 'ModelSpace)
('PaperSpace)))
val 13)
(while (and (setq poi (getpoint "\nPick diem: "))
(setq sel (entsel "\nChon doan thang: "))
(setq ent (car sel))
(wcmatch (cdr (assoc 0 (entget ent))) "LINE,*POLYLINE")
(setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (cadr sel) t)))
(setq per (inters poi
(polar poi
(+ (* 0.5 pi) (angle '(0 0 0) (vlax-curve-getFirstDeriv ent par)))
1.0)
(vlax-curve-getPointAtParam ent (fix par))
(vlax-curve-getPointAtParam ent (1+ (fix par)))
nil))
(setq dim (vlax-invoke asp 'AddDimAligned poi per poi)))
(vla-put-TextOverride dim (rtos (- (distance poi per) val) 2 (getvar 'LUPREC))))
(princ))
<<
| ||
Tác giả: mr.thanh2610 Bài viết gốc: 443417 Tên lệnh: oa |
Lisp rải đối tượng theo đường dẫn của Lee Mac
Thân chào tất cả anh em, em có sưu tầm 1 lisp rất hay của cụ Lee Mac. Nhưng quá trình sử dụng mình thấy Lisp không có chế độ truy bắt điểm (không biết có thể thêm được không, nếu có thì quá tốt), nhờ anh em nào có thể thêm giúp được không ạ, xin chân thành cảm ơn (Em không biết gì về Lisp nên có gì sai sót anh em bỏ qua nhé ).
Liên kết đến Lisp đó đây ạ: >> Thân chào tất cả anh em, em có sưu tầm 1 lisp rất hay của cụ Lee Mac. Nhưng quá trình sử dụng mình thấy Lisp không có chế độ truy bắt điểm (không biết có thể thêm được không, nếu có thì quá tốt), nhờ anh em nào có thể thêm giúp được không ạ, xin chân thành cảm ơn (Em không biết gì về Lisp nên có gì sai sót anh em bỏ qua nhé ). Liên kết đến Lisp đó đây ạ: http://www.lee-mac.com/objectalign.html ;;--------------------------=={ Object Align }==------------------------;; ;; ;; ;; This program will enable the user to dynamically align a selection ;; ;; of objects to a selected curve, with intuitive placement controls. ;; ;; ;; ;; Upon starting the program with the command syntax 'OA', the user is ;; ;; prompted to make a selection of objects to be aligned. Following a ;; ;; valid selection, the user is prompted to specify a base point to ;; ;; use during alignment; at this prompt, the program will use the ;; ;; center of the bounding box of the selection of objects by default. ;; ;; ;; ;; The user is then prompted to select a curve object (this may be a ;; ;; Line, Polyline, Arc, Circle, Ellipse, XLine, Spline etc.) to which ;; ;; the objects are to be aligned. The selected curve may be a primary ;; ;; object, or nested with a Block or XRef to any level. After ;; ;; selection, the program offers several controls to aid with object ;; ;; placement displayed at the command line: ;; ;; ;; ;; for ffset | for otation | ultiple | <xit>: ;; ;; ;; ;; The offset of the objects from the curve may be controlled ;; ;; incrementally by a tenth of the object height using the '+' / '-' ;; ;; keys, or a specific offset may be entered upon pressing the 'O' or ;; ;; 'o' key. ;; ;; ;; ;; The set of objects may be rotated anti-clockwise or clockwise by ;; ;; 45 degrees relative to the curve by pressing the '<' or '>' keys ;; ;; respectively; alternatively, the user may enter a specific rotation ;; ;; by pressing the 'R' or 'r' key. ;; ;; ;; ;; The user may toggle 'Multiple mode' by pressing the 'M' or 'm' key; ;; ;; when enabled, the user may continuously align multiple copies of ;; ;; the selected objects to the selected curve. ;; ;; ;; ;; Finally, the user may place the objects and exit the program by ;; ;; either clicking the left or right mouse buttons, pressing Enter or ;; ;; Space, or by pressing the 'E' or 'e' keys. ;; ;; ;; ;; The program should perform successfully in all UCS & Views, and in ;; ;; all versions of AutoCAD that have Visual LISP functions available ;; ;; (AutoCAD 2000 onwards running on a Windows OS). ;; ;; ;; ;;----------------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;----------------------------------------------------------------------;; ;; Version 1.0 - 2010-05-01 ;; ;; ;; ;; - First release. ;; ;;----------------------------------------------------------------------;; ;; Version 1.1 - 2011-05-07 ;; ;;----------------------------------------------------------------------;; ;; Version 1.2 - 2012-12-11 ;; ;;----------------------------------------------------------------------;; ;; Version 1.3 - 2012-12-14 ;; ;;----------------------------------------------------------------------;; ;; Version 1.4 - 2018-05-06 ;; ;; ;; ;; - Program modified to enable compatibility with all UCS & Views. ;; ;;----------------------------------------------------------------------;; ;; Version 1.5 - 2019-08-09 ;; ;; ;; ;; - Added 'Multiple' mode to allow the user to align multiple copies ;; ;; of the selected objects. ;; ;;----------------------------------------------------------------------;; (defun c:oa ( / *error* bb1 bb2 blk bnm bpt def dis ent fac gr1 gr2 idx inc llp lst mat msg obj ocs oss pi2 pt1 pt2 pt3 pt4 sel tma tmp trm urp uxa vec ) (defun *error* ( msg ) (if (and (= 'list (type trm)) (= 'ename (type ent)) (entget ent)) (entdel ent) ) (if (and (= 'vla-object (type blk)) (not (vlax-erased-p blk))) (vl-catch-all-apply 'vla-delete (list blk)) ) (if (and (= 'vla-object (type def)) (not (vlax-erased-p def))) (vl-catch-all-apply 'vla-delete (list def)) ) (foreach obj lst (if (not (vlax-erased-p obj)) (vl-catch-all-apply 'vla-delete (list obj)) ) ) (oa:endundo (oa:acdoc)) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (oa:startundo (oa:acdoc)) (if (null oa|rot) (setq oa|rot 0.0)) (if (null oa|off) (setq oa|off 0.0)) (cond ( (or (oa:layerlocked (getvar 'clayer)) (oa:layerlocked "0") ) (princ "\nThe current layer or layer \"0\" is locked - please unlock these layers before using this program.") ) ( (null (setq oss (oa:ssget "\nSelect objects to align: " '("_:L" ((0 . "~VIEWPORT")))))) (princ "\n*Cancel*") ) ( (progn (setq bpt (getpoint "\nSpecify basepoint <center>: ")) (while (progn (setvar 'errno 0) (setq sel (nentselp "\nSelect curve to align objects <exit>: ")) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (= 'ename (type (car sel))) (if (not (or (= "VERTEX" (cdr (assoc 0 (entget (car sel))))) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list (car sel))))) ) ) (princ "\nInvalid object selected.") ) ) ) ) ) (while (/= 5 (car (setq pt1 (grread t 13 1))))) (null sel) ) ) ( (not (or (and (setq trm (caddr sel)) (setq ent (oa:copynested (car sel) trm)) ) (and (= "VERTEX" (cdr (assoc 0 (entget (car sel))))) (setq ent (cdr (assoc 330 (entget (car sel))))) ) (setq ent (car sel)) ) ) (princ "\nUnable to recreate nested entity.") ) ( (progn (setq ocs (trans '(0 0 1) 1 0 t) uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t)) mat (mxm (list (list (cos uxa) (sin uxa) 0.0) (list (- (sin uxa)) (cos uxa) 0.0) '(0.0 0.0 1.0) ) (mapcar '(lambda ( a ) (trans a ocs 0 t)) '( (1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0) ) ) ) vec (mapcar '- (mxv mat (trans '(0.0 0.0 0.0) ocs 0))) tma (vlax-tmatrix (append (mapcar 'append mat (mapcar 'list vec)) '((0.0 0.0 0.0 1.0)))) ) (repeat (setq idx (sslength oss)) (setq idx (1- idx) obj (vla-copy (vlax-ename->vla-object (ssname oss idx))) lst (cons obj lst) ) (vla-transformby obj tma) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq bb1 (cons (vlax-safearray->list llp) bb1) bb2 (cons (vlax-safearray->list urp) bb2) ) ) (vla-put-visible obj :vlax-false) ) (not (and bb1 bb2)) ) (*error* nil) (princ "\nUnable to calculate bounding box for the selection.") ) ( t (setq bb1 (apply 'mapcar (cons 'min bb1)) bb2 (apply 'mapcar (cons 'max bb2)) bpt (cond ( bpt (mapcar '+ (mxv mat (trans bpt 1 0)) vec)) ((mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) bb1 bb2))) fac (/ (- (cadr bb2) (cadr bb1)) 2.0) pi2 (/ pi -2.0) inc 0 ) (while (tblsearch "block" (setq bnm (strcat "$tmp" (itoa (setq inc (1+ inc))))))) (foreach obj lst (vla-put-visible obj :vlax-true)) (vla-copyobjects (oa:acdoc) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst ) ) (setq def (vla-add (vla-get-blocks (oa:acdoc)) (vlax-3D-point bpt) bnm)) ) (foreach obj lst (vla-delete obj)) (setq lst nil blk (vla-insertblock (vlax-get-property (oa:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (vlax-3D-point (trans (cadr pt1) 1 0)) bnm 1.0 1.0 1.0 0.0 ) ) (vla-put-layer blk "0") (vla-put-normal blk (vlax-3D-point ocs)) (setq msg (princ "\n for ffset | for otation | ultiple | <xit>: ")) (while (progn (setq gr1 (grread t 15 0) gr2 (cadr gr1) gr1 (car gr1) ) (cond ( (member gr1 '(3 5)) (setq pt2 (trans gr2 1 0) pt1 (vlax-curve-getclosestpointtoprojection ent pt2 ocs) pt3 (oa:2d (trans pt1 0 ocs)) pt4 (oa:2d (trans pt2 0 ocs)) ) (if (not (equal pt3 pt4 1e-8)) (progn (setq dis (/ (* fac oa|off) (distance pt3 pt4))) (vla-put-insertionpoint blk (vlax-3D-point (trans (append (mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt3 pt4) (list (caddr (trans pt1 0 ocs))) ) ocs 0 ) ) ) (vla-put-rotation blk (+ (angle (trans pt1 0 ocs) (trans gr2 1 ocs)) oa|rot pi2)) ) ) (cond ( (= 5 gr1)) ( oa|mtp (vla-explode blk) t) ) ) ( (= 2 gr1) (cond ( (member gr2 '(043 061)) (setq oa|off (+ oa|off 0.1)) ) ( (member gr2 '(045 095)) (setq oa|off (- oa|off 0.1)) ) ( (member gr2 '(044 060)) (setq oa|rot (+ oa|rot (/ pi 4.0))) ) ( (member gr2 '(046 062)) (setq oa|rot (- oa|rot (/ pi 4.0))) ) ( (member gr2 '(013 032 069 101)) nil ) ( (member gr2 '(082 114)) (if (setq tmp (getangle (strcat "\nSpecify Rotation <" (angtos oa|rot) ">: "))) (setq oa|rot tmp) ) (princ msg) ) ( (member gr2 '(079 111)) (if (setq tmp (getdist (strcat "\nSpecify Offset <" (rtos (* fac oa|off)) ">: "))) (setq oa|off (/ tmp fac)) ) (princ msg) ) ( (member gr2 '(077 109)) (if (setq oa|mtp (not oa|mtp)) (princ "\n<Multiple mode on>") (princ "\n<Multiple mode off>") ) (princ msg) ) ( t ) ) ) ( (member gr1 '(011 025)) nil ) ( t ) ) ) ) (if trm (entdel ent)) (vla-explode blk) (vla-delete blk) (vla-delete def) (oa:endundo (oa:acdoc)) ) ) (princ) ) ;;----------------------------------------------------------------------;; (defun oa:2d ( x ) (list (car x) (cadr x))) ;;----------------------------------------------------------------------;; (defun oa:layerlocked ( lay / def ) (and (setq def (tblsearch "layer" lay)) (= 4 (logand 4 (cdr (assoc 70 def)))) ) ) ;;----------------------------------------------------------------------;; (defun oa:copynested ( ent mat / enx tmp ) (if (= 1 (cdr (assoc 66 (setq enx (entget ent))))) (progn (oa:entmakex enx) (setq ent (entnext ent) enx (entget ent) ) (while (/= "SEQEND" (cdr (assoc 0 enx))) (oa:entmakex enx) (setq ent (entnext ent) enx (entget ent) ) ) (setq tmp (cdr (assoc 330 (entget (oa:entmakex enx))))) ) (setq tmp (oa:entmakex enx)) ) (if tmp (vla-transformby (vlax-ename->vla-object tmp) (vlax-tmatrix mat))) tmp ) ;;----------------------------------------------------------------------;; (defun oa:entmakex ( enx ) (entmakex (append (vl-remove-if (function (lambda ( x ) (or (member (car x) '(005 006 008 039 048 062 102 370)) (= 'ename (type (cdr x))) ) ) ) enx ) '( (006 . "CONTINUOUS") (008 . "0") (039 . 0.0) (048 . 1.0) (062 . 7) (370 . 0) ) ) ) ) ;;----------------------------------------------------------------------;; (defun oa:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) ;;----------------------------------------------------------------------;; (defun oa:startundo ( doc ) (oa:endundo doc) (vla-startundomark doc) ) ;;----------------------------------------------------------------------;; (defun oa:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;;----------------------------------------------------------------------;; (defun oa:acdoc nil (eval (list 'defun 'oa:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (oa:acdoc) ) ;;----------------------------------------------------------------------;; ;; Matrix Transpose - Doug Wilson ;; Args: m - nxn matrix (defun trp ( m ) (apply 'mapcar (cons 'list m)) ) ;; Matrix x Matrix - Vladimir Nesterovsky ;; Args: m,n - nxn matrices (defun mxm ( m n ) ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;;----------------------------------------------------------------------;; (vl-load-com) (princ (strcat "\n:: ObjectAlign.lsp | Version 1.5 | \\U+00A9 Lee Mac " (menucmd "m=$(edtime,0,yyyy)") " www.lee-mac.com ::" "\n:: Type \"oa\" to Invoke ::" ) ) (princ) ;;----------------------------------------------------------------------;; ;; End of File ;; ;;----------------------------------------------------------------------;;
<<
| ||
Tác giả: hiepttr Bài viết gốc: 220633 Tên lệnh: abc |
lisp tính ngược giá trị của mắt lưới san nền ?
| ||
Tác giả: Doan Van Ha Bài viết gốc: 196227 Tên lệnh: ch |
Chỉnh sửa nhanh Scale Hatch, đổi nhanh nhiều góc cho hàng loạt hatch
| ||
Tác giả: Nguyen Hoanh Bài viết gốc: 387804 Tên lệnh: taolayout |
Tách Các Bản Vẽ Bên Layout Thành Từng Bản Vẽ Riêng Biệt
Cách của bạn là đúng rồi.
Lisp dưới đây hỗ trợ thêm cho bạn các tạo layout nhanh
Cách của bạn là đúng rồi.
Lisp dưới đây hỗ trợ thêm cho bạn các tạo layout nhanh
<<
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 443541 Tên lệnh: te |
Tạo lisp thay thế và đánh số thứ tự tăng/giảm của mtext trong multi leader
(Defun c:te (/ x xt xh ss key ent num k n) (while (or (not x) (= x "")) (setq x (getstring (strcat "\nNhap ky tu the hien so:")))) (setq xt (strcase x T) xh (strcase x nil)) (setq ss (acet-ss-to-list (ssget (list (cons 0 "MULTILEADER") (cons 304 (strcat "*" xt "*,*" xh "*")) )))) (setq key (keyword (list "Select-Order" "Left-right" "Top-bottom") "Select-Order" "Kieu sap xep?")) (if (= key "Left-right")(setq ss (vl-sort ss '(lambda (x y) (< (cadr (assoc 10 (entget x))) (cadr (assoc 10 (entget y)))))))) (if (= key "Top-bottom")(setq ss (vl-sort ss '(lambda (x y) (> (caddr (assoc 10 (entget x))) (caddr (assoc 10 (entget y)))))))) (setq n (getint "\nNhap so bat dau:")) (setq k (getint "\nNhap so ky tu muon hien thi:")) (if (and ss n k) (progn (foreach ent ss (setq num (itoa n)) (if (< (strlen num) k) (setq num (repeat (- k (strlen num)) (setq num (strcat "0" num)))) ) (if (vl-string-search xt (dxf 304 ent)) (vla-put-textstring (vlax-ename->vla-object ent) (vl-string-subst num xt (dxf 304 ent))) (vla-put-textstring (vlax-ename->vla-object ent) (vl-string-subst num xh (dxf 304 ent)))) (setq n (1+ n)) ) ) (alert "Khong du du lieu, ket thuc!")) ) (defun keyword (key default promp / str1 str2 str3 str4) (setq str1 (apply 'strcat (mapcar (function (lambda (x) (strcat x " "))) key))) (setq str2 (apply 'strcat (mapcar (function (lambda (x) (strcat x "/"))) key))) (setq str1 (substr str1 1 (1- (strlen str1)))) (setq str2 (substr str2 1 (1- (strlen str2)))) (initget str1) (setq str3 (strcat "\n" promp " <" default "> ")) (if (not (setq str4 (getkword str3))) default str4 ) ) (defun Dxf (Id Obj) (cdr (assoc Id (entget Obj))) ) Trường hợp này đánh số theo mình thấy khó khả thi, bởi sau khi đánh 1 lần, nhỡ đâu đánh sai thì lisp không chọn lại được nữa, có lẽ bạn nên thay ký tự số vào đầu hoặc cuối để dễ sửa chữa sau này. <<
| ||
Tác giả: haiduong2105 Bài viết gốc: 49043 Tên lệnh: fixblock |
Viết Lisp theo yêu cầu
| ||
Tác giả: Phiphi- Bài viết gốc: 49241 Tên lệnh: p2t |
Viết Lisp theo yêu cầu
Chưa có ai giúp chắc vì còn Tết. Lisp num.lsp này cho phép đánh cả Chử + Số +Chử (TD: X1a, X2a, X3a...) Nếu thêm được vào option để cho phép đánh theo cấp số nhân thì hay hơn (TD: +5m, +10m, +15m...) Lệnh NUM ;; ============================================================= ;; ;; ... Chưa có ai giúp chắc vì còn Tết. Lisp num.lsp này cho phép đánh cả Chử + Số +Chử (TD: X1a, X2a, X3a...) Nếu thêm được vào option để cho phép đánh theo cấp số nhân thì hay hơn (TD: +5m, +10m, +15m...) Lệnh NUM ;; ============================================================= ;; ;; ;; ;; NUM.LSP - This program for fast dynamic numbering. To number a ;; ;; suffix and a prefix can be added. ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; Command(s) to call: NUM ;; ;; ;; ;; Specify the text size, a suffix, a prefix and starting number ;; ;; (for erase the old suffix or prefix you should press Spacebar). ;; ;; Insert a numbers or press Esc to quit. The program remembers old ;; ;; properties and it is possible to confirm it pressing of Spacebar ;; ;; key. ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY ;; ;; MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR ;; ;; PARTS OF IT ABSOLUTELY FREE. ;; ;; ;; ;; THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS AND ;; ;; SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY ;; ;; OR FITNESS FOR A PARTICULAR USE. ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; V1.3, 12 May, 2005, Riga, Latvia ;; ;; © Aleksandr Smirnov (ASMI) ;; ;; For AutoCAD 2000 - 2008 (isn't tested in a next versions) ;; ;; ;; ;; http://www.asmitools.com ;; ;; ;; ;; ==================================================================== ;; (defun c:num (/ oldPref oldSuf oldStart curStr newNum actDoc actSp oldEcho oldSize *error*) (defun *error* (msg) (setvar "CMDECHO" oldEcho) (princ) ); end *error* (vl-load-com) (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) (if(not num:Pref)(setq num:Pref "")) (if(not num:Suf)(setq num:Suf "")) (if(not num:Num)(setq num:Num 1)) (setq oldPref num:Pref oldSuf num:Suf oldStart num:Num oldSize num:Size actDoc(vla-get-ActiveDocument (vlax-get-acad-object)) oldEcho(getvar "CMDECHO") ); end setq (setvar "CMDECHO" 0) (if(=(vla-get-ActiveSpace actDoc)1) (setq actSp(vla-get-ModelSpace actDoc)) (setq actSp(vla-get-PaperSpace actDoc)) ); end if (setq num:Size (getreal (strcat "\nText size <"(rtos num:Size)">: "))) (if(null num:Size)(setq num:Size oldSize)) (setq num:Pref (getstring T (strcat "\nPrefix: <"num:Pref">: "))) (if(= "" num:Pref)(setq num:Pref oldPref)) (if(= " " num:Pref)(setq num:Pref "")) (setq num:Suf (getstring T (strcat "\nSuffix: <"num:Suf">: "))) (if(= "" num:Suf)(setq num:Suf oldSuf)) (if(= " " num:Suf)(setq num:Suf "")) (setq num:Num (getint (strcat "\nStarting number <"(itoa num:Num)">: "))) (if(null num:Num)(setq num:Num oldStart)) (princ "\n<<< Insert numbers or press Esc to quit >>> ") (while T (setq curStr(strcat num:Pref(itoa num:Num)num:Suf) newNum(vla-AddText actSp curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)) (vla-put-Alignment newNum acAlignmentMiddleCenter) (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (setq num:Num(1+ num:Num)) ); end while (princ) ); end of c:num (princ "\n*** Dynamic numbering tool. Type NUM to run.*** ") ... nhưng phải select từng point, không được như P2T.lsp
<<
| ||
Tác giả: NguyenNgocSon Bài viết gốc: 158375 Tên lệnh: cs |
Lisp cộng - trừ - nhân - chia 2 hàng số cho ra hàng thứ 3
| ||
Tác giả: vantran Bài viết gốc: 109857 Tên lệnh: isb |
thay thế các đường tròn bằng block
| ||
Tác giả: gia_bach Bài viết gốc: 443586 Tên lệnh: eraseblock |
Xóa đối tượng nằm trên layout khác
| ||
Tác giả: nikizi Bài viết gốc: 443579 Tên lệnh: ctl |
Xóa đối tượng nằm trên layout khác
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 443639 Tên lệnh: cg |
Xin giúp đỡ hoàn thiện Lisp
Ý tưởng khá hay, quick code cho bạn: CG- enter: COPY CG-Enter - Enter: Paste. (defun c:cg (/ ss str pt lst_str ) (if Ý tưởng khá hay, quick code cho bạn: CG- enter: COPY CG-Enter - Enter: Paste. (defun c:cg (/ ss str pt lst_str ) (if (and (setq ss (ssget)) (setq str (getstring T "Nhap ten tap chon:")) (setq pt (getpoint "Pick basepoint:")) ) (progn (setq lst_chon (append lst_chon (list (list str ss pt)))) )(progn (if lst_chon (progn (setq lst_str (list)) (foreach str lst_chon (setq lst_str (append lst_str (list (car str))))) (if (setq tapchon (LM:listbox "Ch\U+1ECDn ten tap chon" lst_str 0)) (progn (setq ss (cadr (assoc (car tapchon) lst_chon)) pt (caddr (assoc (car tapchon) lst_chon))) (Command "COPY" ss "" "_non" pt pause))) )) )) ) (defun LM:listbox (msg lst bit / dch des tmp rtn) (cond ((not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false" ) ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) (t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (read (strcat "(" rtn ")")) (mapcar '(lambda (x) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn )
<<
|
Trang 306/330