Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Luongquocsonxd

GHI TEXT CÁCH ĐIỂM POINT MỘT KHOẢNG CÁCH DO TA ẤN ĐỊNH TRƯỚC

Các bài được khuyến nghị

Nhờ anh em hỗ trợ. Cảm ơn!

image.png.08e23bdeaee08d07dc0ddb45be0b6b89.png

GHI TEXT NEW.dwg

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=600
(defun c:Pid(/ cen doc i h height lst msp ov pt row str stt tblobj vl width x y) ;Point ID out
;;  By : Gia Bach, Copyrightゥ December 2009                    ;;
;;  Contact : gia_bach @  www.CadViet.com                      ;;
  (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn
  (princ "\nChon cac POINT de xuat ra Bang toa do :")
  (if (ssget '((0 . "POINT")))
    (progn
      (vl-load-com)
      (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
        msp (vla-get-modelspace doc))
      (vlax-for e (vla-get-ActiveSelectionSet doc)
    (setq cen (vlax-safearray->list (variant-value (vla-get-Coordinates e)))
          lst (cons (list (car cen)(cadr cen) )lst))
    );vlax-for
      (setq lst (vl-sort lst '(lambda (x y) (or    (< (car x) (car y));Check X
                        (and (> (cadr x) (cadr y));Check Y
                             (= (car x) (car y));Equal X
                             )    ) ) ))
      (setq vl '("dimzin" "cmdecho")    ; Sys Var list  
        ov  (mapcar 'getvar vl))    ; Get Old values
      (mapcar 'setvar vl '(0 0))
      (or *h* (setq *h* 175))
      (initget 6)
      (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
      (if h (setq *h* h) (setq h *h*) )
      (setq str (last lst))
      (if (> (car str)(cadr str) )
    (setq str (car str))
    (setq str (cadr str)))
      (setq width (* 2(TxtWidth (rtos str) h msp))
        width1 (* 2 (TxtWidth "STT" h msp))
        height (* 2 h))
      (if (> h 3)
    (setq width (* (fix (/ width 10))10)
          width1 (* (fix (/ width1 10))10)
          height (* (fix (/ height 5))5)))
      (setq i 1
        row 2
        pt (getpoint "\nDiem dat Bang :")
        TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width))
      (vla-put-vertcellmargin TblObj (/ h 4))
      (vla-SetColumnWidth TblObj 0 width1)
      (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
          (list acTitleRow acHeaderRow acDataRow) )
      (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
          (list acTitleRow acHeaderRow acDataRow))
      (vla-setText TblObj 0 0 "Bang toa do")
      (vla-setText TblObj 1 0 "STT")
      (vla-setText TblObj 1 1 "X")
      (vla-setText TblObj 1 2 "Y")
      (foreach pt lst
    (setq stt (itoa i)) 
    (vla-AddText msp stt (vlax-3d-point (polar pt (/ pi 4) (/ h 4))) h)
    (vla-setText TblObj row 0 stt)
    (vla-setText TblObj row 1 (rtos (car pt)))
    (vla-setText TblObj row 2 (rtos (cadr pt)))
    (setq row (1+ row) i (1+ i))
    )
      (vlax-release-object TblObj)
      (mapcar 'setvar vl ov)                     ;reset Sys Vars
      (princ)      
      )
    )
  )
  (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
  )
  )

(defun TxtWidth (val h msp / txt minp maxp)
  (setq    txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))
  )
 

  • Vote giảm 3

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×