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

mr.thanh2610

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

  • Số lượng nội dung

    59

  • Đã tham gia

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

  • Ngày trúng

    1

Bài đăng được đăng bởi mr.thanh2610

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

    Vào lúc 27/2/2023 tại 16:16, Duong Nhat Duy đã nói:

    Bản chất lệnh DT2 là lệnh pick tới đâu cộng dồn tới đó như bạn nói, nhưng cái này là do lisp lỗi nên nó tính nhầm (do biến HPISLANDDETECTION), mình đã fix và update lên đầu topic r nhé, cảm ơn bạn đã tìm ra lỗi này !

    Ok bác, dùng ngon lành rồi, 1 lần nước cảm ơn bác

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

    image.thumb.png.c390d9fdabdab365775aef9297d58fe6.png
    Bác @Duong Nhat Duy cho mình hỏi có thể thêm 2 lựa chọn cho cách tính lệnh DT2 pick điểm-nhiều điểm là : 1 lựa chọn trừ lỗ khoét (như lisp hiện tại), 2 pick tới đâu cộng dồn tới đó (thêm vào) được không ạ, Vì mình đang muốn tính kiểu Pick-nhiều điểm S=S1+S2+S3+S4 hoặc S=S1+S2+S3 chẳng hạn.Mong được phản hồi từ bác, cảm ơn ạ
    P/s: Mình biết có cách tính DT4 sẽ giải quyết vấn đề trên nhưng ý mình muốn tính trong trường hợp không có hatch và pick nhiều điểm

    • Like 1

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

    Vào lúc 9/5/2013 tại 15:59, lyky đã nói:

     

    Vấn đề của bạn đã được đề cập đến trong diễn đàn rồi bạn à, bạn làm theo cách này cũng được:

     

     

    • laykt_stext_sdim.lsp
      lisp help
    •   
    
;;; Khoi tao Layer ;;;

(defun newlay(a b c d) 

(if (not (tblsearch "layer" a)) (command "-layer" "n" a "c" b a "l" c a "lw" d a "")

(command "-layer" "s" a "c" b a "l" c a "lw" d a "")))

;;; Sau do cu viet theo nhu cau: (newlay "name" color "laytype" lineweight), Vi du:

(defun C:laykt()

(newlay "KT-TRUC" 2 "CENTER2" 0.13)

(newlay "KT-BAO" 2 "CONTINUOUS" 0.30)

.....................................................

(prompt "\nBao cao da khoi tao he thong LAYER can thiet\n"))

 

;;; Khoi Textstyle ;;;

(command "style" "stylename" "fontname" "height" "width factor" "" "" "" "")

;;; Vi du:

(defun C:stext()

(command "style" "Standard" "simplex.shx,bigfont.shx" "0" "0.75" "" "" "" "")

.............................................................................

(prompt "\nBao cao da khoi tao to hop template TEXT STYLE can thiet\n"))

 

;;; Khoi Dimstyle ;;;

(defun C:sdim()

(C:stext)

(setvar "DIMBLK" "_Open")

(setvar "DIMLDRBLK" "_Open")

(setvar "DIMCLRD" 0)

(setvar "DIMCLRE" 0)

(setvar "DIMCLRT" 0)

(setvar "DIMCEN" 0)

(setvar "DIMDLI" 7)

(setvar "DIMEXO" 1)

(setvar "DIMEXE" 1)

(setvar "DIMSCALE" 50)

(setvar "DIMTXSTY" "Standard")

(setvar "DIMDSEP" ".")

(setvar "DIMALTD" 0)

(setvar "DIMTMOVE" 2)

(setvar "DIMAUNIT" 1)

(setvar "DIMTXT" 3.5)

(setvar "DIMADEC" 3)

(setvar "DIMTIX" 1)

(setvar "DIMASZ" 2)

(setvar "DIMDEC" 0)

(setvar "DIMGAP" 1)

(setvar "DIMLFAC" 0.4) (command "-dimstyle" "s" "KT-50-20")

(setvar "DIMLFAC" 2) (command "-dimstyle" "s" "KT-50-100")

(setvar "DIMLFAC" 0.2) (command "-dimstyle" "s" "KT-50-10")

(setvar "DIMLFAC" 0.6) (command "-dimstyle" "s" "KT-50-30")

(setvar "DIMLFAC" 1) (command "-dimstyle" "s" "KT-50")

(prompt "\nBao cao da khoi tao to hop template DIMMENSION STYLE can thiet\n"))

 

;;; Cac bien he thong ban tu nghien cuu nhe! ;;;

     

    Goodluck!

    mọi người cho em hỏi sao cái này em dùng không được nhỉ

     

    laykt_stext_sdim (1).lsp

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

    Chào các anh em diễn đàn, em có sưu tầm một lisp của các bác trên diễn đàn mình mà thấy chủ đề cũng rất lâu rồi nên nay em xin mạn phép lập chủ đề mới xin nhờ các anh em giúp đỡ.Vấn đề như sau:

    -Chức năng Lisp cũ: chọn các Text là số (số, số nguyên, số thực...)

    -Mong muốn chỉnh sửa Lisp: Chọn được cả Mtext, Text và phần chọn số thực chọn được dấu ngăn cách với phần thập phân là dấu phẩy(lisp đang lấy dấu chấm) ; Ví dụ: 1.2("một chấm hai" lisp lấy được), giờ muốn lấy theo kiểu 1,2 (một phẩy hai).Xin chân thành cảm ơn ạ. 

    
;; --------------------LOC TEXT LA SO NAM TRONG KHOANG GIA TRI CHO TRUOC---------------------
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=5733&st=20
(defun c:SN1(/ ss i ent content so ans snho slon skhoang socuctieu socucdai)
;copyright by TUE_NV
(setq ss (ssget '((0 . "*TEXT"))) snho (ssadd) slon (ssadd) skhoang (ssadd))
(setq i 0)
(initget "L N K") 
(setq ans (getkword 
	"\n chon so Nho hon N , Chon so Lon hon L , Chon so trong khoang K < N/L/K > : "))

(if (= ans "N")
(progn 
	(setq so (getreal "\n Nhap so nho hon : "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) (< content so))
			(setq snho (ssadd ent snho))
		)
		(setq i (1+ i))
	);while
	(sssetfirst snho snho)
);progn
);if
	(setq i 0)
(if (= ans "L")
(progn 
	(setq so (getreal "\n Nhap so lon hon : "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) (> content so))
			(setq slon (ssadd ent slon))
		)
		(setq i (1+ i))
	);while
	(sssetfirst slon slon)
);progn
);if
	(setq i 0)
(if (= ans "K")
(progn 
	(setq socuctieu (getreal "\n Nhap so cuc tieu MIN : "))
	(setq socucdai (getreal "\n Nhap so cuc dai MAX: "))

	(while (< i (sslength ss))
		(setq ent (ssname ss i))
		(if (and (setq content (distof(cdr(assoc 1 (entget ent))))) 
			 (> content socuctieu)
			 (< content socucdai))
			(setq skhoang (ssadd ent skhoang))
		)
		(setq i (1+ i))
	);while
	(sssetfirst skhoang skhoang)
))
(princ)
)

;; --------------------LOC TEXT LA SO---------------------
(defun c:SN (/ ss ent str ss1)
 (setq ss1 (ssadd))
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq str (cdr(assoc 1 (entget ent))))
(if (distof str 2)
  (ssadd ent ss1)
  )
)      
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so."))
         (sssetfirst nil ss1)
  )
)
     )
   )
 )

;; --------------------LOC TEXT LA SO THUC---------------------

(defun c:STH(/ ent i ss ss1 str)
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (setq i -1 ss1 (ssadd))
     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq str (cdr(assoc 1 (entget ent))))
       (if (and (distof str 2)
	 (= (type (read str)) 'REAL ))
  (ssadd ent ss1) ))
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so thuc."))
         (sssetfirst nil ss1)  )) ) ))

;; --------------------LOC TEXT LA SO NGUYEN---------------------

(defun c:SNG(/ ent i ss ss1 str)
 (if (setq ss (ssget (list (cons 0 "*TEXT"))))
   (progn
     (setq i -1 ss1 (ssadd))
     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq str (cdr(assoc 1 (entget ent))))
       (if (and (distof str 2)
	 (= (type (read str)) 'INT ))
  (ssadd ent ss1) ))
     (if (> (sslength ss1) 0)
       (progn
         (sssetfirst nil)
  (princ (strcat "\nChon duoc " (itoa (sslength ss1)) " doi tuong Text co noi dung la so thuc."))
         (sssetfirst nil ss1)  )) ) ))

     

    16.LOC TEXT LA SO(SN, SN1, STH, SNG).lsp

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

    Chào tất cả anh em trong diễn đàn,do có nhu cầu nên có sưu tầm 1 lisp ghi giá trị thép đai dưới đường kích thước, nhưng vấn đề nằm ở chỗ lisp này ghi thêm số lượng cốt đai, giờ em muốn nhờ các bác bỏ giúp em chỗ ghi số lượng cốt đai với ạ ví dụ: 18xØ6a200 -->thành Ø6a200.Và nếu được nhờ các bác phát triển thêm lisp này hoặc viết lisp mới với nội dung như sau với ạ:

    LISP CŨ:

    -Nhập lệnh(tên lệnh GT)->nhập bước thép->chọn đường kích thước->kết thúc.(ở đây lisp muốn sửa đường kính đai phải vào lại trong lisp)

    Ý MONG MUỐN LISP MỚI(HOẶC SỬA LISP CŨ):

    -Nhập lệnh->nhập đường kính đai->nhập bước thép -> lựa chọn có/ không ghi số lượng thép ->chọn đường kích thước->kết thúc.

    Em xin chân thành cảm ơn các bác ạ.

     

    gt.lsp

    Capture.PNG

    • Vote giảm 1

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

    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 [O]ffset | [</>] for [R]otation | [M]ultiple | <[E]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 [O]ffset | [</>] for [R]otation | [M]ultiple | <[E]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                              ;;
;;----------------------------------------------------------------------;;

     

    ObjectAlignV1-5.lsp

    • Vote tăng 1

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

    Vào lúc 1/6/2016 tại 16:40, quocmanh04tt đã nói:

    - Lệnh WPL

    - Đối tượng áp dụng: LINE, LWPOLYLINE, ARC, CIRCLE và ELLIPSE.

    http://www.cadviet.com/upfiles/6/141736_wpl.rar

    P/s: đối tượng Ellipse cần phải cài Express.

    Chào anh, quocmanh04tt, em thấy lisp của anh rất hay, xin anh cho em file đuôi .lsp được không ạ, để tiện trong việc đặt lại tên, em chân thành cảm ơn

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

    Mình có sưu tầm một lisp trên CV của bác KangKung, lisp có công dụng xoay đối tượng block theo đường line, pline, nhưng spline thì không thực hiện được.

    Xin nhờ các anh em trong diễn đàn chỉnh sửa giúp nhé, xin cảm ơn. 

    ;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/69764-y%C3%AAu-c%E1%BA%A7u-lisp-xoay-block-theo-h%C6%B0%E1%BB%9Bng-pline-cho-tr%C6%B0%E1%BB%9Bc/
;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:QB()
  (command "UNDO" "BE")
  (setq tuyen nil)
  (while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq block(entget (ssname taphop index)))
    (setq insertpoint(cdr (assoc 10 block)))
    (if (= (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) (vla-get-length (vlax-ename->vla-object tuyen)))
      (entmod (subst (cons 50 (+ pi (angle (vlax-curve-getClosestPointTo tuyen insertpoint) ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) -0.001))))) (assoc 50 block) block))
      (entmod (subst (cons 50 (+ pi (angle ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) 0.001)) (vlax-curve-getClosestPointTo tuyen insertpoint)))) (assoc 50 block) block))
      )
    (setq index (+ index 1)))
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 28/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

     

    QUAY BLOCK THEO DUONG DAN (QB).lsp

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

    Vào lúc 11/7/2019 tại 13:57, Biet ve CAD đã nói:

    Không biết có cần lọc tuyệt đối ko vì chọn mẫu là cons 62 thì nó vẫn lấy cả truecolor ( ví dụ mẫu là RED, truecolor là 254,0,0 hoặc 255,0,0)

    Nhưng theo mình nếu đã là truecolor và cons 62 vẫn phải tách riêng nhau ( nếu truecolor nó trả về gần màu cons 62 thì đành chịu )

     

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

    Cái trường hợp ngược với op2 là gì?

    Mâu là gì? Bạn muốn kêt quả là gì?

    Hình như bạn muốn là :

    Mẫu color bylayer thuộc layer color x

    Ma kết quả là các obj có color là x?

    Vậy thì mẫu cũng ko dc chọn?

    2 bác lỡ giúp rồi giúp em cú chót luôn được không 2 bác, tại em đang làm nhiệm vụ chỉnh lại tất cả bản vẽ của mấy anh em vẽ layer rất lung tung, đa số đổi màu nên giờ phải chỉnh lại rất mất công, nhờ vả 2 bác cú chót nhé , cảm ơn

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

    41 phút trước, ngokiet đã nói:

    Cái trường hợp ngược với op2 là gì?

    Mâu là gì? Bạn muốn kêt quả là gì?

    Hình như bạn muốn là :

    Mẫu color bylayer thuộc layer color x

    Ma kết quả là các obj có color là x?

    Vậy thì mẫu cũng ko dc chọn?

    Ví dụ cụ thể là: có 1 layer nét thấy màu Red thuộc bylayer vẽ 1 đường thẳng,  1 layer nét đậm cũng màu Red  thuộc bylayer vẽ 1 đường thẳng  , 1 layer nét tường màu Blue thuộc bylayer vẽ 1 đường thẳng rồi đổi màu tùy chọn là màu Red.

    *Ý em là dùng lệnh chọn 1 trong hai thằng nét thấy hoặc nét đậm ---> quét vùng chọn cho cả 3 đường thẳng vừa vẽ ---> kết quả  chọn được 2 đường thẳng  nét thấy và nét đậm màu Red thuộc bylayer, còn thằng tùy chọn màu Red (tùy chọn) thuộc layer nét tường thì loại ra

    Ý em là thế đó bác ạ, bác xem xét thử :), cảm ơn

×