Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
8 replies to this topic

#1 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2014 - 02:42 PM

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.c..._kich_thuoc.dwg

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


  • 0

#2 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 08 December 2014 - 03:58 PM

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


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#3 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2014 - 04:18 PM

Thanks bạn Nhoc, có lisp này đỡ mất công phải canh khi Copy + Paste từ cái có sẵn :D


  • 0

#4 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2014 - 04:36 PM

Ý nhưng mà hơi bất tiện khi lại ra thêm Layer và TextStyle mới :wacko: , bạn cho nó là hiện hành luôn đi :huh:


  • 0

#5 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 08 December 2014 - 09:26 PM

;;;;;;;;;;;============================================================
(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 ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#6 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 09 December 2014 - 08:17 AM

Thanks, nhưng lần này chay nó im ru không thấy ji hết :(


  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 09 December 2014 - 08:50 AM

@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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 nhoclangbac

nhoclangbac

    biết vẽ circle

  • Members
  • PipPip
  • 38 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 09 December 2014 - 09:00 AM

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


  • 1

#9 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 09 December 2014 - 09:14 AM

Ok! Lần này thì Good rồi . Thanks!


  • 0