Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
phamhung12

Nhờ viết lisp ghi chú kích thước

Bởi phamhung12 , trong AutoLisp

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

phamhung12    1

phamhung12
Đã đăng

Nhờ các Lisper giúp giùm mình cái lisp ghi chú thép như sau:

1/ Pick điểm 1

2/ Pick điểm 2

3/ Nhập Text

4/ Vẽ đường tròn nhập R

5/ Nhập Text số tại tâm

Gửi file đính kèm:

http://www.cadviet.com/upfiles/4/132202_ghi_chu_kich_thuoc.dwg

Mong được giúp đỡ. Trân trọng!

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

nhoclangbat    392

nhoclangbat
Đã đăng

- bạn test thử xem đúng ý chưa hì ^^

;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 62 (if clr clr 256))
    '(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
(entmakex Lst))
	;end;=================================
;=================================HAM ENTMAKE VE CICLE
	(defun K:tron (point R Layer Color)
	(entmakex (list '(0 . "CIRCLE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
    (cons 62 (if Color Color 256))
	(cons 10 point)
	(cons 40 R)
	)))
	;end;=================================
;;ham tao text 3
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 layer)
							  (cons 7 textstyle)
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  )	;end K:text
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;===========================================================================================
 (defun C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj)
(vl-load-com)
  (setq old (getvar "OSMODE") oldd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
   (if (null (tblsearch "style" "VHELVEI")) (K:style "VHELVEI" "VHELVEI.ttf"))
  (if (null (tblsearch "layer" "GHI-CHU")) (K:layer "GHI-CHU" 7))
  (setq str2 (getint "\nNhap so text trong tam:"))
  (setq bk (getreal "\nNhap ban kinh:"))
  (setvar "OSMODE" 512)
  (initget 1)
  (setq pt1 (getpoint "\nChon diem dau: "))
  (setvar "OSMODE" 0)
  (setq pt2 (getpoint pt1 "\ndiem thu 2: "))
  (setq goc (angle pt1 pt2))
  (setq str1 (getstring 1 "\nNhap text ngang: "))
  (setq lenstr1 (strlen str1))
  (setq pt3 (getpoint pt2 "\nHuong diem cuoi: "))
  (if (< (car pt2) (car pt3))
  (progn
    (setq vttext (polar pt2 (/ pi 4) 1.5))
	(setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil))
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
	(setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
	(setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 0 (+ 2.0 kcx)))
	(setq pt4 (polar pt3 0 bk))
   )
   (progn
   (setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5))
   (setq obj (K:text vttext 2.5 str1 "R" "GHI-CHU" "VHELVEI" nil nil))
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
	(setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
	(setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 PI (+ 2 kcx)))
    (setq pt4 (polar pt3 pi bk))
	)
  );if
  (K:pline (list pt1 pt2 pt3) nil "GHI-CHU" nil)
  (K:tron pt4 bk "GHI-CHU" nil)
  (K:text pt4 3.0 (itoa str2) "M" "GHI-CHU" "VHELVEI" nil nil)
  (setvar "OSMODE" old)
  (setvar "cmdecho" oldd)
  (princ)
  
)
  • Vote tăng 1

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

nhoclangbat    392

nhoclangbat
Đã đăng 
;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 62 (if clr clr 256))
    '(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
(entmakex Lst))
;end;=================================
;=================================HAM ENTMAKE VE CICLE
	(defun K:tron (point R Layer Color)
	(entmakex (list '(0 . "CIRCLE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
    (cons 62 (if Color Color 256))
	(cons 10 point)
	(cons 40 R)
	)))
;end;=================================
;ham tao text 3
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 (if layer layer (getvar 'clayer)))
							  (cons 7 (if textstyle textstyle (getvar 'textstyle)))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  );end K:text
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;===========================================================================================
 (defun C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj)
(vl-load-com)
  (setq old (getvar "OSMODE") oldd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
   (setq str2 (getint "\nNhap so text trong tam:"))
  (setq bk (getreal "\nNhap ban kinh:"))
  (setvar "OSMODE" 512)
  (initget 1)
  (setq pt1 (getpoint "\nChon diem dau: "))
  (setvar "OSMODE" 0)
  (setq pt2 (getpoint pt1 "\ndiem thu 2: "))
  (setq goc (angle pt1 pt2))
  (setq str1 (getstring 1 "\nNhap text ngang: "))
  (setq lenstr1 (strlen str1))
  (setq pt3 (getpoint pt2 "\nHuong diem cuoi: "))
  (if (< (car pt2) (car pt3))
  (progn
    (setq vttext (polar pt2 (/ pi 4) 1.5))
	(setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil))
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
	(setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
	(setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 0 (+ 2.0 kcx)))
	(setq pt4 (polar pt3 0 bk))
   )
   (progn
   (setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5))
   (setq obj (K:text vttext 2.5 str1 "R" nil nil nil nil))
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
	(setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
	(setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 PI (+ 2 kcx)))
    (setq pt4 (polar pt3 pi bk))
	)
  );if
  (K:pline (list pt1 pt2 pt3) nil nil nil)
  (K:tron pt4 bk nil nil)
  (K:text pt4 3.0 (itoa str2) "M" nil nil nil nil)
  (setvar "OSMODE" old)
  (setvar "cmdecho" oldd)
  (princ)
  
)

- hi tối giờ nhoc bận, đã sữa cho bạn theo hiện hành ^^

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

ketxu    2.931

ketxu
Đã đăng

@nhoclangbat : hàm tạo text sai mục (cons 8 layer), chưa kiểm tra đặt đối số nil như mấy hàm khác

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

nhoclangbac    4

nhoclangbac
Đã đăng

Hihi...Nhoc sửa lại cho chính các đây "

(defun K:pline (listpoint closed / Lst) ;Layer clr
    (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
    ;(cons 8 (if Layer Layer (getvar "Clayer")))
    ;(cons 62 (if clr clr 256))
    '(100 . "AcDbPolyline")
    (cons 90 (length listpoint))
    (cons 70 (if closed 1 0))))
    (foreach PP listpoint    (setq Lst (append Lst (list (cons 10 PP)))))
(entmakex Lst))
    ;end;=================================
;=================================HAM ENTMAKE VE CICLE
    (defun K:tron (point R)  ; Layer Color
    (entmakex (list '(0 . "CIRCLE")
    ;(cons 8 (if Layer Layer (getvar "Clayer")))
    ;(cons 62 (if Color Color 256))
    (cons 10 point)
    (cons 40 R)
    )))
    ;end;=================================
;;ham tao text 3
(defun K:text(pt height string justify ang / lst)   ;layer textstyle mau
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
                              (cons 40 height)
                              (cons 1 string)
                              (cons 50 (if ang ang 0))
                              ;(cons 8 layer)
                              ;(cons 7 textstyle)
                              ;(cons 62 (if mau mau 256))
                              
            )
            justify (strcase justify))
        (cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
                ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
                ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
                ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
                )
    (entmakex Lst)
  )    ;end K:text
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;===========================================================================================
 (defun C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj)
(vl-load-com)
  (setq old (getvar "OSMODE") oldd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
   ;(if (null (tblsearch "style" "VHELVEI")) (K:style "VHELVEI" "VHELVEI.ttf"))
  ;(if (null (tblsearch "layer" "GHI-CHU")) (K:layer "GHI-CHU" 7))
  (setq str2 (getint "\nNhap so text trong tam:"))
  (setq bk (getreal "\nNhap ban kinh:"))
  (setvar "OSMODE" 512)
  (initget 1)
  (setq pt1 (getpoint "\nChon diem dau: "))
  (setvar "OSMODE" 0)
  (setq pt2 (getpoint pt1 "\ndiem thu 2: "))
  (setq goc (angle pt1 pt2))
  (setq str1 (getstring 1 "\nNhap text ngang: "))
  (setq lenstr1 (strlen str1))
  (setq pt3 (getpoint pt2 "\nHuong diem cuoi: "))
  (if (< (car pt2) (car pt3))
  (progn
    (setq vttext (polar pt2 (/ pi 4) 1.5))
    (setq obj (K:text vttext 2.5 str1 "L" nil))  ; "GHI-CHU" "VHELVEI" nil
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
    (setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
    (setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 0 (+ 2.0 kcx)))
    (setq pt4 (polar pt3 0 bk))
   )
   (progn
   (setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5))
   (setq obj (K:text vttext 2.5 str1 "R" nil))  ;"GHI-CHU" "VHELVEI" nil
    (setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
    (setq pdau (vlax-safearray->list minp))
    (setq pcuoi (vlax-safearray->list maxp))
    (setq kcx (- (car pcuoi) (car pdau)))
    (setq pt3 (polar pt2 PI (+ 2 kcx)))
    (setq pt4 (polar pt3 pi bk))
    )
  );if
  (K:pline (list pt1 pt2 pt3) nil) ; "GHI-CHU" nil
  (K:tron pt4 bk) ; "GHI-CHU" nil
  (K:text pt4 3.0 (itoa str2) "M" nil)  ;"GHI-CHU" "VHELVEI" nil
  (setvar "OSMODE" old)
  (setvar "cmdecho" oldd)
  (princ)
 
)

  • Vote tăng 1

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×