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

thiep

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    514

  • Đã tham gia

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

  • Ngày trúng

    48

Bài đăng được đăng bởi thiep

  1. Đã đăng · Trả lời báo cáo

    3 giờ trước, ngoctruongthienphu đã nói:

    Chào mọi người, có cách nào mình lấy toàn bộ nội dung Mtext (có sẵn trong cad) sang vị trí Excel đang mở nhanh không?

    Hiện tại mình vẫn làm thủ công TEXTEDIT (Ed) chọn MText, rồi nhấp ctr+a, ctr+c rồi chuyển sang Excel --> chọn vị trí rồi Ctr+V.

     

    Đế giảm bớp 2 bước Ctr+A và Ctr+C thì mình làm như thế nào?

    Cám ơn. 

    image.png.7af77db26063fec790dabef6fa82b988.png

    image.png.fc6f19afa71a0cd988b6a191b65ae44d.png

    image.thumb.png.425dfbb84527854e324d035b8f465b8b.png

    thu1.dwg

    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.

    • Like 3

  3. Đã đăng · Trả lời báo cáo

    6 giờ trước, binbin72088@gmail.com đã nói:

    Cảm ơn anh @cuongtk2 nhiều lắm, lisp đúng ý lun, lần đầu tiên e xài lisp bằng vba luôn. Đồng thời cũng cảm ơn anh @thiep vì rất hào hiệp. E cũng muốn biết bản chất cách làm như nào để tự làm cho trục oy nữa, mấy anh cho em biết nguyên lý được ko? Ban đầu e nghĩ là dùng SSget rồi chọn các vertex, rồi dùng hàm for cho từng điểm, sau đó move lần lượt các điểm về 0, e biết sơ sơ ko biết vậy có đúng ko?

    "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)
)

     

    • Like 1

  5. Đã đăng · Trả lời báo cáo

    4 giờ trước, keviet226 đã nói:

    Gửi các anh, chị diễn đàn cadviet.com

    Lần đầu tiên em đến với diễn đàn nên có gì không phải mong các anh, chị bỏ qua cho!
    Em nhờ anh chị hướng dẫn, hoặc viết giúp em lisp theo yêu cầu như sau:
    1. Sau khi quét chọn sẽ lọc ra đối tượng để tự tính tổng. VD loại A sẽ lọc theo loại A; B theo B và C theo C, nghĩa là thống kê mỗi loại có tổng bao nhiêu.
    2. Sau khi đối tượng nào đã được thống kê thì đổi màu để dễ kiểm soát. VD loại A đã tính tổng xong thì biến thành màu vàng chẳng hạn.
    Mong anh chị nào có thể hướng dẫn em viết, hoặc viết giúp em. Em sẽ trả phí đầy đủ ạ!
    Em xin cảm ơn nhiều!
     

    image.png

    Có phải thống kê theo theo kiểu này:

    image.png.5e0c62503cd03887c5c8e656b1a1e2b4.png 

    nếu ok thì đt: 0918841230

  6. Đã đăng · Trả lời báo cáo

    2 giờ trước, Hoàng trọng vinh 88 đã nói:

    Chào mọi người trong diễn đàn. Mình tìm mãi trên mạng, cũng như đã hỏi mua 1 số lisp về thông kê thép dầm, sàn, cột, đai nhưng vẫn chưa dùng được. Mình hỏi trong diễn đàn ai có bộ lisp ấy không cho mình xin với, mình trả phí. Cảm ơn mọi người

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

  8. Đã đăng · Trả lời báo cáo

    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

    • Like 1

  9. Đã đăng · Trả lời báo cáo

    Vào lúc 27/6/2021 tại 19:33, vanhuyou đã nói:

    Chào các bác, em có tìm được lisp xuất chiều dài pline ra text field, nhờ các bác giúp em sữa lại cho phù hợp công việc của em:

     - Chiều dài chỉ lấy số nguyên và làm tròn lên 10

     - Text xuất ra có định dạng L=xxxx

     - Chiều dài của text theo chiều cao text dim mặc định 

    Cám ơn các bác.

    MIDLEN.lsp

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

  11. Đã đăng · Trả lời báo cáo

    3 giờ trước, Tuan_Luong đã nói:

    Mình ghé top nhé, Mình có tạo block attribute về ghi chú vật liệu, nhưng khi copy block ra thì phải sửa tay lại thông tin.

    Không biết có Lisp hay cách cài đặt nào trong cad mà có thể thực hiện được 2 yêu cầu:

     - Sau khi copy (Cp/Co) thì block attribute hiện ra bảng để sửa nội dung.

    - Các giá trị, hoặc giá trị "So_luong" trở về "default" không nhỉ??

    Mình dùng AutoCAD Mechanical 2019

    Có bác nào giúp mình với, mình xin cảm ơn.

    block attribute.dwg

     

    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ị.

  12. Đã đăng · Trả lời báo cáo

    5 giờ trước, vanhuyou đã nói:

    Chào các bác, em có tự tạo block động để vẽ thép sàn, nhưng có 1 lỗi mà em vẫn chưa khắc phục được, em có 2 ATT là SH và CHU_THICH, nhưng 2 cái ATT lại có lúc lại nằm chồng lên nhau, em không hiểu tại sao. Nhờ các bác giúp em tìm ra cái lỗi này bị gì. Em cám ơn.

    image.png.8b1edb1cb8e6c8d1fbdfdb2a135b772a.png

    Drawing2.dwg

    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.

    image.png.b1dbf8f2c3ab1724b91fc37cf2e2ed6a.png

     

    image.png

  13. Đã đăng · Trả lời báo cáo

    Vào lúc 3/6/2021 tại 10:51, tuanlt.humg đã nói:

    Chào các anh ạ.

    Hiện tại do yêu cầu công việc, nên em phải sử dụng taluy như hình dưới.

    Nhờ các anh hỗ trợ điều chỉnh autolisp rải taluy như hình dưới giúp em được không ạ.

    Em cảm ơn nhiều ạ

    tayluy.jpg

    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.

  14. Đã đăng · Trả lời báo cáo

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

     

    • Like 1
    • Vote tăng 1

  17. Đã đăng · Trả lời báo cáo

    22 giờ trước, gia_bach đã nói:

    Offset 500 và -500 rồi so sánh 2 pline mới, thằng nào có diện tích (AREA) lớn hơn thì chọn, xóa thằng kia.

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

     

    • Like 1

  18. Đã đăng · Trả lời báo cáo

    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.

  19. Đã đăng · Trả lời báo cáo

    Lisp có sẵn chỉ chỉnh lại 1 chút. Lisp gửi đến bạn, lệnh là GID 

    (defun c:gid (/ ss acadobj doc ent_lst ss po_og Y_og po_10 po_n eng)
    (defun *error* (msg)
        (and doc (_EndUndo doc))
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (princ)
    )
    (defun _StartUndo (doc) (vla-StartUndoMark doc))
    (defun _EndUndo (doc)
        (if (= 8 (logand 8 (getvar 'UNDOCTL)))
            (vla-EndUndomark doc)
        )
    )
    (setq acadobj (vlax-get-acad-object)
          doc     (vla-get-ActiveDocument acadobj)
    )
    (_StartUndo doc)
    (acet-sysvar-set (list "cmdecho" 0 "osmode" 0))
    (command "_ucs" "w")
    (setq ss (ssget '((0 . "POINT"))))
    (if (null ss)
        (progn (princ "\nNo objects selected.") (exit))
    )
    (setq ent_lst (acet-ss-to-list ss))
    (setq po_og (getpoint "\nPick 1 \U+0111i\U+1EC3m \U+0111\U+1EC3 l\U+1EA5y tung \U+0111\U+1ED9 Y:"))
    (setq Y_og (caDr po_og)) 
    (foreach x ent_lst
        (setq eng   (entget x)
              po_10 (acet-dxf 10 eng)
              po_n  (list (car po_10) Y_og (caddr po_10))
        )
        (entmod (subst (cons 10 po_n) (assoc 10 eng) eng))
        (entupd x)
    )   
    (ACET-SYSVAR-RESTORE)
    (command "_ucs" "P")
    (_EndUndo doc)
    (princ)
    (princ "\nOk")    
)

     

    • Vote tăng 1

  21. Đã đăng · Trả lời báo cáo

    16 phút trước, TranAnhTuong đã nói:

    Đúng rồi ah!

    Bạn xem ở topic này, lisp doubleoffset viết chung cho tất cả các đối tượng đường, LINE, LWPOLYLINE, SPLINE, ARC, CIRCLE, cùng 1 lúc chọn nhiều đường để doubleoffset, xoá hay không xoá đối tượng gốc, có hộp thoại.

    https://www.cadviet.com/forum/topic/179621-nhờ-giúp-đỡ-về-lisp-offset-double/?do=findComment&amp;comment=444609

    • Like 1

  25. Đã đăng · Trả lời báo cáo

    14 giờ trước, ngokiet đã nói:

    Mình đâu nói lisp bác sai gì đâu. Do post này đang nói về 3d. Nên cái lisp nó hơi sai chủ đề 1 chút.
    - còn cái lisp bác mới viết thì sai rồi đấy.

    Tích vô hướng dùng để tính diện tích tam giác bất kỳ qua 3 điểm. Khi S =0 là 3 điểm mới thẳng hàng.
    Lisp bác hơi rối. Mình góp ý 1 chút là : (equal (- a b) 0 fz) <=> (equal a b fz) dễ nhìn và hiệu quả hơn.

     

    Sai như thế nào bạn?

×