thiep

Cái này mình vừa viết xong cho 1 đề án chung: - xuất các giá trị tổng Dim (AlignDim. LinearDim, ArclengDim), vừa tạo xong là xuất luôn, (continuous hay không continuous) - xuất các giá trị tổng Dim có sẵn trên bản vẽ. - xuất gia trị chiều dài, chu vi của các curve có sẵn trên bản vẽ (line, polyline, Spline, Circle) - xuất giá trị tổng diện tích của các đối tượng có diện tích - xuất giá trị tổng text, mtext số. - xuất 1 giá trị text, mtext bất kỳ. Sau khi xuất ra 1 cell của excel đang mở thì các đối tượng chọn, hay các dim vừa tạo sẽ đổi sang màu sáng để đánh dấu. Xong việc, sẽ có 1 lệnh RE2 làm tái tạo lại màu cũ của đối tượng, hay màu theo dimstyle, layer, bất kể bạn đã tắt mở máy bao nhiêu lần, lisp vẫn tái tạo lại màu cũ cho đối tượng.

lisp này cũng đơn giản. thay vì phải vẽ lại như hình, thì bạn gửi file dwg, cho Thiệp viết lisp.

"Bản chất làm như nào để tự làm cho trục oy nữa" là dùng hàm vlax-curve-getClosestPointTo để tìm điểm gần nhất của điểm này trên 1 curve nào đó. Như vậy, bất kỳ curve ở hướng nào, nó cũng tìm được điểm getClosestPoinTo (ở đây curve là 1 line // với trục ox hoặc oy) Bạn thử lisp này với phương Line là // trục Ox hoặc Oy. Nếu bạn muốn phương của Line bất kỳ thì khi lisp yêu cầu "Pick endpoint line:" thì nhấn nút F8. (defun emLINE (pt1 pt2) (entmakex (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 10 pt1) (cons 11 pt2) ) ) ) (defun PointInside (pt ptlst / l_dis) (mapcar '(lambda (x) (setq l_dis (cons (distance pt x) l_dis))) ptlst) (acet-geom-point-inside pt ptlst (apply 'max l_dis)) ) ;;; Lisp stretch vertexes's lwpolyline inside a window to line ;;; by Trân Thiêp, tel: 0918841230 (defun c:trev (/ p1 p2 porect enttemp ss entLine enttempLWP p1 p2 p3 p4 entlst obj orthomode_o L1 lstpo vlapt poner ) (setq acadObj (vlax-get-acad-object) doc (vla-get-ActiveDocument acadObj) *Model* (vla-get-ModelSpace doc) ) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (acet-sysvar-restore) (vla-EndUndoMark doc) (princ) ) (vla-StartUndoMark doc) (acet-sysvar-set (list "cmdecho" 0 "osmode" 0)) (setq orthomode_o (getvar "ORTHOMODE")) (setq p1 (getpoint "\nPick point1 window: ") p2 (getcorner p1 "\nPick point2 corner: ") ) (setq ss (ssget "_C" p1 p2 '((0 . "*POLYLINE")))) (setq porect (acet-geom-rect-points p1 p2)) (setvar "ORTHOMODE" 1) (setq p3 (getpoint "\nPick startpoint line: ") p4 (getpoint p3 "\nPick endpoint line: ") ) (setq entLine (emLINE p3 p4)) (setvar "ORTHOMODE" orthomode_o) (setq l1 nil) (setq vlapt (vlax-make-safearray vlax-vbdouble '(0 . 1))) (setq entlst (acet-ss-to-list ss)) (if entlst (progn (foreach ent entlst (setq L1 nil) (setq obj (vlax-ename->vla-object ent)) (setq lstpo (acet-geom-vertex-list ent)) (foreach po lstpo (if (PointInside po porect) (progn (setq poner (vlax-curve-getClosestPointTo entLine po T)) (vlax-safearray-fill vlapt (list (car poner) (cadr poner))) (vla-put-Coordinate obj (fix (vlax-curve-getParamAtPoint ent po)) vlapt ) ) ) ) ) (acet-sysvar-restore) (vla-EndUndoMark doc) (princ "\nOk") ) ) (princ) )

Lisp sẽ gửi tặng bạn sớm nhất trong buổi sáng mai. đợi nhé

Có phải thống kê theo theo kiểu này: nếu ok thì đt: 0918841230

Gửi cho Thiep BV để hoàn chỉnh lisp cho phù hợp. Đt: 0918841230

Thiep có 1 khoá cứng TDT không dùng, liên lại qua đt: 0918841230 cho nhanh, hoặc zalo.

Ơ, đã giúp rồi còn gì? Bạn chạy trên autoCad đời nào? Bạn đã chạy lisp và kết quả như thế nào? chụp hình gửi lên xem?

Dựa theo lisp MIDLEN.lsp của LEEMAC, Thiep ra lisp LENGFIELD.lsp phù hợp với ý của bạn Nhớ là cách chọn đối tượng là kiểu Fence nhe bạn, mục đích của mình là đối tượng polyline nào "dính" hàng rào trước thì lisp sẽ tạo ra 1 text gắn field trước, như vậy sẽ pick điểm chèn text cho phù hợp theo trật tự. ;;-------------------=={ Length *POLYLINE _ field }==-------------------;; ;; ;; ;; This program prompts the user for a selection of objects to be ;; ;; labelled and proceeds to generate an MText object located at ;; ;; the midpoint of each object displaying a Field Expression ;; ;; referencing the length of the object. ;; ;; ;; ;; The program is compatible for use with *Polylines, and under ;; ;; all UCS & View settings. ;; ;; The MText will have a background mask ;; ;; enabled and will use the active Text Style and Text Height settings ;; ;; at the time of running the program. ;; ;;----------------------------------------------------------------------;; ;; Author: Trân Thiêp base lisp midlen.lsp by Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;----------------------------------------------------------------------;; ;; - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;; ;;----------------------------------------------------------------------;; (defun c:lengfield (/ *error* ent fmt idx ins ocs par sel spc txt typ uxa) (setvar "textsize" (getvar "DIMTXT")) (defun *error* (msg) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (if (setq sel (ssget "F" (acet-ui-fence-select) (list '(0 . "*POLYLINE") '(-4 . "<NOT") '(-4 . "<AND") '(0 . "POLYLINE") '(-4 . "&") '(70 . 80) '(-4 . "AND>") '(-4 . "NOT>") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model") ) ) ) ) (progn (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace ) ) ) (setq ocs (trans '(0.0 0.0 1.0) 1 0 t) uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t)) ) (LM:startundo (LM:acdoc)) (repeat (setq idx (sslength sel)) (setq ent (ssname sel (setq idx (1- idx))) par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0) ) ins (vlax-curve-getpointatparam ent par) typ (cdr (assoc 0 (entget ent))) ) (setq txt (vlax-invoke spc 'addmtext ins 0.0 (strcat "L=" "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu2%pr0%ps[,0]%ct8[0.1]\">%" ) ) ) (vla-put-backgroundfill txt :vlax-true) (vla-put-attachmentpoint txt acattachmentpointmiddlecenter) (vla-put-insertionpoint txt (vlax-3D-point (getpoint "\pick a point for inserttext_field")) ) ) (LM:endundo (LM:acdoc)) ) ) (princ) ) ;; Readable - Lee Mac ;; Returns an angle corrected for text readability. (defun LM:readable ( a ) ( (lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (LM:readable (+ a pi)) a ) ) (rem (+ a pi pi) (+ pi pi)) ) ) ;; ObjectID - Lee Mac ;; Returns a string containing the ObjectID of a supplied VLA-Object ;; Compatible with 32-bit & 64-bit systems (defun LM:objectid ( obj ) (eval (list 'defun 'LM:objectid '( obj ) (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring) (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false) '(LM:ename->objectid (vlax-vla-object->ename obj)) ) '(itoa (vla-get-objectid obj)) ) ) ) (LM:objectid obj) ) ;; Entity Name to ObjectID - Lee Mac ;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name (defun LM:ename->objectid ( ent ) (LM:hex->decstr (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent)) ent (substr ent (+ (vl-string-position 58 ent) 3)) ) ) ) ;; Hex to Decimal String - Lee Mac ;; Returns the decimal representation of a supplied hexadecimal string (defun LM:hex->decstr ( hex / foo bar ) (defun foo ( lst rtn ) (if lst (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn)) (apply 'strcat (mapcar 'itoa (reverse rtn))) ) ) (defun bar ( int lst ) (if lst (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst)) (cons (rem int 10) (bar (/ int 10) (cdr lst))) ) (bar int '(0)) ) ) (foo (vl-string->list (strcase hex)) nil) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) (vl-load-com) (princ (strcat "\n:: Lengfield.lsp | by TranThiep | " (menucmd "m=$(edtime,0,yyyy)") ", based lisp midlen.lsp \\U+00A9 Lee Mac " "\n:: Type \"lengfield\" to Invoke ::" ) ) (princ) ;;----------------------------------------------------------------------;; ;; End of File ;; ;;----------------------------------------------------------------------;; Thân ái, chúc bạn thành công. TranThiep tel:0918841230

Có thể giúp bạn, cũng không khó, nhưng câu thứ 3 màu đỏ, chưa hiểu???

Ừ đúng vậy, giá trị chiều dài thép là tổng các field của các giá trị L1, L2, L3 của các linear grip.

Wow, chỉ cần lệnh insert thôi cần gì lisp, sau lệnh insert, cad sẽ ra bảng thuộc tính để chỉnh sửa. Hoặc với cad2007, trên dòng nhắc lệnh sau khi insertblock, cad sẽ đưa ra từng ATT cho bạn thay đổi giá trị.

Thiep thấy bạn insert block với giá trị âm ScaleX = -33.8876. Khi thay ScaleX = 33.8876 thì các ATT không bị chồng lên nhau nữa. Tuy nhiên, lúc đó các thông số động trong block động bị mất hết, và liên kết giá trị field cũng thành #### luôn, không hiểu sao. Theo Thiep nghĩ, bạn đã dùng 1 lisp để insert block thép dầm này, trong lisp có liên kết field chiều dài polyline vào trong ATT, nếu bạn có thể share cho lisp này cho Thiep xem thì quý hoá. Thiệp cũng lisp liên kết chiều dài kiểu này vào trong ATT nhưng chiều dài không phải là 1 polygon mà là 1 thuộc tính động của block động. Bạn cũng nên đổi tên block thành không dấu, cho không bị lỗi vặt.

Bạn có thể gửi 1 bản vẽ mẫu có tỷ lệ bản vẽ, Thiep có thể giúp bạn.

Lisp của bạn, các toạ độ góc được gắn vào biến polst (defun sysvar-set (lst_setvar / strN var var_oldname n) (setq n 0 lstvar_thiep nil lstValue_thiep nil ) (repeat (/ (length lst_setvar) 2) (setq var (nth n lst_setvar) var_oldname (strcat "oldvar_thiep" (itoa n)) ) (setq lstvar_thiep (append lstvar_thiep (list var))) (set (read var_oldname) (getvar var)) (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname)))) (setvar var (nth (+ n 1) lst_setvar)) (setq n (+ 2 n)) ) ) (defun c:gdt (/ ucshold po ent_bo polst lstvar_thiep lstValue_thiep) (sysvar-set '("cmdecho" 0 "osmode" 0)) (setq ucshold (acet-ucs-get nil)) (acet-ucs-cmd '("w")) (setq po (getpoint "\Pick a point inside the closed boundary ")) (command "_.-boundary" po "") (if (and (setq ent_bo (entlast)) (eq (acet-dxf 0 (entget ent_bo)) "LWPOLYLINE")) (progn (setq polst (acet-geom-object-point-list ent_bo nil)) (if (equal (car polst) (last polst) 0.01) (setq polst (cdr polst)) ) (entdel ent_bo) ) ) (acet-ucs-set ucshold) (mapcar '(lambda (var value) (setvar var (eval value))) lstvar_thiep lstValue_thiep ) (and polst(princ polst)) (princ) )

ok, hãy đợi nhe.

Tôi sẽ giúp bạn nhưng toạ độ cần lấy sẽ đặt ở đâu?

Một cách khác không phải so sánh diện tích rồi xoá đỡ tốn thời gian. Lisp này lấy trên nền lisp OFS của @tranducanh18 gửi ở trên (vl-load-com) (defun GetA (lst) (apply '+ (mapcar '(lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) lst (cons (last lst) lst) ) ) ) (defun c:ofs (/ ss lay lst obj bit #d #dold) (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark ActDoc) (acet-sysvar-set '("cmdecho" 0 "osmode" 0)) (setq #dold (getvar "offsetdist")) (cond ((setq ss (ssget '((0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")))) (if (null (setq #d (getdist (strcat "\nOffsetdist <" (rtos #dold 2 2) ">"))) ) (setq #d #dold) (setvar "offsetdist" #d) ) (foreach ent (acet-ss-to-list ss) (setq obj (vlax-ename->vla-object ent) bit (GetA (acet-geom-vertex-list ent)) ) (if (vlax-method-applicable-p obj 'Offset) (cond ((< bit 0) (vlax-invoke obj 'Offset #d)) ((> bit 0) (vlax-invoke obj 'Offset (- #d))) ) ) ) ) (T (princ "\nNo thing to do")) ) (acet-sysvar-restore) (vla-EndUndoMark ActDoc) (princ) )

Lisp của bạn đây, lệnh là AL9 ;;; Lisp add lwpolyline promt insertpoint of texts blocks === by Trân Thiêp 05/2020 (defun DXF (code en) (cdr (assoc code (entget en)))) (defun TD:Text (ent / X11) (setq Ma10 (dxf 10 ent)) (setq Ma11 (dxf 11 ent)) (setq X11 (car Ma11)) (setq Ma71 (dxf 71 ent)) (setq Ma72 (dxf 72 ent)) (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0)) (and (= Ma71 0) (= Ma72 3)) (and (= Ma71 0) (= Ma72 5)) ) Ma10 Ma11 ) ) ;;;================================================= (defun c:al9 (/ doc ss entlst lstpo po) (defun *error* (msg) (and doc (_EndUndo doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (princ) ) (defun _EndUndo (doc) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc) ) ) (acet-sysvar-set '("cmdecho" 0 "osmode" 0)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark doc) (command "_ucs" "w") (prompt "\nCh\U+1ECDn t\U+1EADp h\U+1EE3p các text, block b\U+1EB1ng ph\U+01B0\U+01A1ng th\U+1EE9c FENC:" ) (setq lstpo nil) (if (setq ss (ssget "F" (ACET-UI-FENCE-SELECT) '((0 . "TEXT,INSERT")))) (progn (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (foreach ent entlst (cond ((= (dxf 0 ent) "TEXT") (setq po (TD:Text ent))) ((= (dxf 0 ent) "INSERT") (setq po (dxf 10 ent))) ) (setq lstpo (cons po lstpo)) ) (acet-lwpline-make (list lstpo)) ) (prompt "\nCh\U+01B0a ch\U+1ECDn t\U+1EADp h\U+1EE3p texts, blocks") ) (acet-sysvar-restore) (command "_ucs" "P") (_EndUndo doc) (princ "\nOk") ) Chúc bạn vui.