Đến nội dung


Hình ảnh
- - - - -

hỏi vấn đề tạo liên kết LSP và dialog DCL


  • Please log in to reply
51 replies to this topic

#41 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 September 2014 - 04:47 PM

Xin lỗi bác Hạ, em mải mê làm việc nên lúc viết quên béng mất điều viết. Em sửa lại rồi bác ạ.

Trong câu 2 là em muốn lựa chọn bảng màu sắc cho chữ đó bác. Nếu viết trong DCL thì viết như nào ạ? và cách gọi nó ra thì ntn ạ?

Trong 3 thì em chưa biết cách gán layer lựa chọn hay style  lựa chọn cho Text.

Em vừa sửa lại thấy tự dưng có layer mới xuất hiện mà em ko tạo ra. Cái này em cảm thấy hơi lạ

 

GHICHU
: dialog
{
label = "Ch\U+01B0\U+01A1ng tr\U+00ECnh ghi ch\U+00FA";
	: boxed_column
	{
		: edit_box
		{
			label = "Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA";
			key = "Text_ghichu";
			edit_width = 30;
			alignment = left;
			edit_limit = 50;
			value = "Vi\U+1EBFt ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y";

		}
		: edit_box
		{
			label = "Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:";
			key = "Height_Text";
			edit_width = 3.0;
			alignment = left;
			edit_limit = 5;
			value = 1;
		}


	}
	: boxed_column
	{
        	: row
		{
		 : column
		 {
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn Layer" ;
		          key         = "LTSLAY" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		      : popup_list
		      {
		          label       = "L\U+1EF1a ch\U+1ECDn TextStyle" ;
		          key         = "LTSTEXTSTYLE" ;
		          edit_width  = 50 ;  
		          list        = "" ;
		          alignment = left;
		      }
		 }
		}
	}	
	: boxed_column
	{
		: button
		{
			label = "Pick >>>";
			key = "Accept";
			is_default = true;
			fixed_width = centered;
		}
		: button
		{
			label = "H\U+1EE7y";
			key = "Cancel";
			is_default = false;
			fixed_width = centered;
		}

	}

}

 

(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)

  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")

(setq LtsLayer_ (Getlayer))
(start_list "LTSLAY")
(mapcar 'add_list  LtsLayer_)
(end_list)
(set_tile "LTSLAY" "0")
(action_tile "LTSLAY" "(setq LayerText_ $value)")


(setq LtsStyle_ (GetTextStyle))
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list  LtsStyle_)
(end_list)

;;;(action_tile "LTSTEXTSTYLE" "(setq TextStyle_ $value)")
  

(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")

(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
	(progn
		(GCT TextGhiChu h LayerText_ )
	)
)
(if (= UseButton 2)
	(alert (strcat "\nTho\U+00E1t"))
)


(Princ)
)




(defun Getlayer ( / lyr LstLayer)
(vlax-for lyr
	(vla-get-layers
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstLayer (cons (vla-get-name lyr) LstLayer))
)
LstLayer
)




(defun GetTextStyle ( / styl_  LstTextStyle)
(vlax-for styl_
	(vla-get-textstyles
		(vla-get-activedocument
			(vlax-get-acad-object)
	        )
        )		
(setq LstTextStyle (cons (vla-get-name styl_) LstTextStyle))
)
LstTextStyle
)


(defun GCT(TextGhiChu h LayerText  / i Olmode Gocxoay);;;;GHI CHU TEXT
(setq i 0)
(while
  	(setvar "OSMODE" 0)
	(setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: :  "))
	(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT:  "))
  	(setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
		      )
	)
	(command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
;;;	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay) (cons 7 TextStyle) (cons 1 TextGhiChu)))
  	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay)(cons 7 "Times New Roman")   (cons 1 TextGhiChu)))
  	(setq i (1+ i))
)
)

;;;-------------------------------------------------------------



  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#42 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 September 2014 - 04:55 PM

Gán Layer cho Text:

(vla-put-Layer (vlax-ename->vla-object ent_text))

Gán TextStyle cho Text:

(vla-put-TextStyle (vlax-ename->vla-object ent_text))

Hàm gọi bảng màu: ví dụ màu 3

(acad_colordlg 3)


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#43 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 06 September 2014 - 04:59 PM

Sửa lại cho bạn.

(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY"  "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
 
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
  
 
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
 
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
  
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
 
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn 
 (GCT TextGhiChu h #CurLay #CurStyle)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
 
(defun Getlayer ( / lyr l)
  (setq l nil)
  (vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name lyr) l))
  )
  l
)
 
(defun GetTextStyle ( / styl_ l)
  (setq l nil)
  (vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name styl_) l))
  )
  l
)
 
 
(defun GCT(TextGhiChu h LayerText TextStyle / i Olmode Gocxoay);;;;GHI CHU TEXT
  (command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
  (while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
   (setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
     )
) 
(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu)))   
  )
)
 
;;;-------------------------------------------------------------
 
 

  • 1

#44 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 September 2014 - 05:04 PM

Dạ, bác chưa hiểu ý em rồi ạ. Em tạo Text chứ ko phải gán thuộc tính cho Text ạ

Em có hàm 

(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay)(cons 7 TextStyle)   (cons 1 TextGhiChu)))

Em muốn hàm Entmake này nó nhận LayerText và TextStyle do mình lựa chọn trên  hộp thoại.

Thêm vào đó, em muốn gán thêm màu sắc cho Text nữa ạ. 

Như kiểu hộp thoại Mtext đó ạ

36665_hhhhhhh.jpg


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#45 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 September 2014 - 05:07 PM

Tot77: Tuyệt vời ạ. 

Anh có thể giúp em thêm 1 hộp màu lựa chọn được ko anh? 

Làm phiền anh rùi ạ.

Cảm ơn anh nhiều


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#46 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 September 2014 - 05:24 PM

Cho em hỏi đoạn này với ạ

(nth (atoi LayerText) LstLayer))

Em thắc mắc là hàm: (nth n lst)

n : The number of the element to return from the list (zero is the first element).

Nếu (atoi LayerText) ko phải number thì sao ạ?

Đâu thể dùng được đoạn này ạ: (nth (atoi LayerText) LstLayer))

Arguments
n
The number of the element to return from the list (zero is the first element).
lst
The list.
Return Values
 
Arguments
n
The number of the element to return from the list (zero is the first element).
lst
The list.
Return Values

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#47 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 06 September 2014 - 05:40 PM

Cho em hỏi đoạn này với ạ

(nth (atoi LayerText) LstLayer))

Em thắc mắc là hàm: (nth n lst)

n : The number of the element to return from the list (zero is the first element).

Nếu (atoi LayerText) ko phải number thì sao ạ?

Đâu thể dùng được đoạn này ạ: (nth (atoi LayerText) LstLayer))

Arguments
n
The number of the element to return from the list (zero is the first element).
lst
The list.
Return Values
 
Arguments
n
The number of the element to return from the list (zero is the first element).
lst
The list.
Return Values

 

Biến #CurLay truyền cho biến LayerText qua hàm con GCT. Mà  #CurLay lấy kiểu string (thứ tự trong LstLayer) nên (atoi LayerText) chỉ có thể là number (integer) => (nth (atoi LayerText) LstLayer)) là lấy tên Layer tương ứng với thứ tự #CurLay trong danh sách LstLayer


  • 1

#48 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 06 September 2014 - 05:50 PM

Thêm màu thì bạn làm như sau:

1. Trong file dcl thêm một khúc :

 :row { 
                  : text { label = "Nhap mau"; alignment =left; }
                  : image_button {  key = "imgC"; alignment = centered; height = 1.5; width = 1.0;
                        fixed_width = false;   fixed_height = true; }
                }

 

2. Trong lệnh C:GCD thêm 1 đoạn :

(if (not col) (setq col 1))
(action_tile "imgC" "(setq col (acad_colordlg col)) (tomau col)")
  (defun tomau©
    (start_image "imgC")
    (fill_image 0 0 (dimx_tile "imgC")  (dimy_tile "imgC") c)
    (end_image)
  )

 

3. Thêm biến col vào hàm 

(defun GCT(TextGhiChu h LayerText TextStyle col / i Olmode Gocxoay);;;;GHI CHU TEXT

 và trong entmake có (cons 62 col)

 

4. Dĩ nhiên cái dòng (gct ... col) phải thêm biến col.

 

 :row { 
                  : text { label = "Nhap mau"; alignment =left; }
                  : image_button {  key = "imgC"; alignment = centered; height = 1.5; width = 1.0;
                        fixed_width = false;   fixed_height = true; }
                }
 :row { 
                  : text { label = "Nhap mau"; alignment =left; }
                  : image_button {  key = "imgC"; alignment = centered; height = 1.5; width = 1.0;
                        fixed_width = false;   fixed_height = true; }
 
 :row { 
                  : text { label = "Nhap mau"; alignment =left; }
                  : image_button {  key = "imgC"; alignment = centered; height = 1.5; width = 1.0;
                        fixed_width = false;   fixed_height = true; }
                }

  • 1

#49 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 06 September 2014 - 05:55 PM

Bác Tot trả lời nhanh quá!

Mần cho Thanhduan rồi đây:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/27610-hoi-van-de-tao-lien-ket-lsp-va-dialog-dcl/page-3
(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY"  "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
 
(if (null #Color) (setq #Color 2))
(fill-rec "color" #color )
(action_tile "color" "(if (setq #color (acad_colordlg #color)) (fill-rec \"color\" #color ))")
 
 
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
  
 
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
 
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
  
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
 
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn
 (GCT TextGhiChu h #CurLay #CurStyle #color)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
(defun Getlayer ( / lyr l)
  (setq l nil)
  (vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
       )
        )
    (setq l (cons (vla-get-name lyr) l))
  )
  l
)
(defun GetTextStyle ( / styl_ l)
  (setq l nil)
  (vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
       )
        )
    (setq l (cons (vla-get-name styl_) l))
  )
  l
)
(defun GCT(TextGhiChu h LayerText TextStyle col / i Olmode Gocxoay);;;;GHI CHU TEXT
  (command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
  (while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
   (setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
     )
)
(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu) (cons 62 col) ))  
  )
)
;;;-------------------------------------------------------------
(defun fill-rec (MyTile col / x y)
(start_image MyTile)
(setq x (dimx_tile MyTile) y (dimy_tile MyTile))
(fill_image 0 0 x y col)
(end_image)

DCL:

GHICHU

: dialog

{

label = "Ch\U+01B0\U+01A1ng tr\U+00ECnh ghi ch\U+00FA";

            : boxed_column

            {

                        : edit_box

                        {

                                    label = "Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA";

                                    key = "Text_ghichu";

                                    edit_width = 30;

                                    alignment = left;

                                    edit_limit = 50;

                                    value = "Vi\U+1EBFt ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y";

 

                        }

                        //:row{

                        : edit_box

                        {

                                    label = "Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:";

                                    key = "Height_Text";

                                    edit_width = 3.0;

                                    alignment = left;

                                    edit_limit = 5;

                                    value = 1;

                        }

                        //}

            }

            : boxed_column

            {

            : row

                        {

                         : column

                         {

                              : popup_list

                              {

                                  label       = "L\U+1EF1a ch\U+1ECDn Layer" ;

                                  key         = "LTSLAY" ;

                                  edit_width  = 50 ; 

                                  list        = "" ;

                                  alignment = left;

                              }

                              : popup_list

                              {

                                  label       = "L\U+1EF1a ch\U+1ECDn TextStyle" ;

                                  key         = "LTSTEXTSTYLE" ;

                                  edit_width  = 50 ; 

                                  list        = "" ;

                                  alignment = left;

                              }

                                    :image_button{key = "color"; width=1; height=2; alignment=centered;}

                         }

                        }

            }         

            : boxed_column

            {

                        : button

                        {

                                    label = "Pick >>>";

                                    key = "Accept";

                                    is_default = true;

                                    fixed_width = centered;

                        }

                        : button

                        {

                                    label = "H\U+1EE7y";

                                    key = "Cancel";

                                    is_default = false;

                                    fixed_width = centered;

                        }

 

            }

 

}

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...alog-dcl/page-3
(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY"  "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
 
(if (null #Color) (setq #Color 2))
(fill-rec "color" #color )
(action_tile "color" "(if (setq #color (acad_colordlg #color)) (fill-rec \"color\" #color ))")
 
 
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
  
 
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
 
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
  
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
 
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn 
 (GCT TextGhiChu h #CurLay #CurStyle #color)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
(defun Getlayer ( / lyr l)
  (setq l nil)
  (vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name lyr) l))
  )
  l
)
(defun GetTextStyle ( / styl_ l)
  (setq l nil)
  (vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name styl_) l))
  )
  l
)
(defun GCT(TextGhiChu h LayerText TextStyle col / i Olmode Gocxoay);;;;GHI CHU TEXT
  (command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
  (while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
   (setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
     )
(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu) (cons 62 col) ))   
  )
)
;;;-------------------------------------------------------------
(defun fill-rec (MyTile col / x y)
(start_image MyTile)
(setq x (dimx_tile MyTile) y (dimy_tile MyTile))
(fill_image 0 0 x y col)
(end_image)
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...alog-dcl/page-3
(defun C:GCD ( / dcl_id  LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
 (exit)
)
  
(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text"  "(setq h $value)")
(mode_tile "Height_Text" 2)
 
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
  
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY"  "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
 
(if (null #Color) (setq #Color 2))
(fill-rec "color" #color )
(action_tile "color" "(if (setq #color (acad_colordlg #color)) (fill-rec \"color\" #color ))")
 
 
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
  
 
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
 
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
  
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
 
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn 
 (GCT TextGhiChu h #CurLay #CurStyle #color)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
(defun Getlayer ( / lyr l)
  (setq l nil)
  (vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name lyr) l))
  )
  l
)
(defun GetTextStyle ( / styl_ l)
  (setq l nil)
  (vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
       )
        ) 
    (setq l (cons (vla-get-name styl_) l))
  )
  l
)
(defun GCT(TextGhiChu h LayerText TextStyle col / i Olmode Gocxoay);;;;GHI CHU TEXT
  (command "Style" "Times New Roman"  "Times New Roman"  0 1 0 "" "" "" )
  (while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
   (setq Gocxoay (Angle (trans P1 1 0)
                             (trans P2 1 0)
     )
(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu) (cons 62 col) ))   
  )
)
;;;-------------------------------------------------------------
(defun fill-rec (MyTile col / x y)
(start_image MyTile)
(setq x (dimx_tile MyTile) y (dimy_tile MyTile))
(fill_image 0 0 x y col)
(end_image)
)

  • 2

#50 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 September 2014 - 07:34 PM

Hic hic. Em cảm động quá. 
Cảm ơn 2 anh đã nhiệt tình giúp đỡ.

Kiểu này em phải mần cho ra trò rồi giúp đỡ người khác.

Cảm ơn anh Tot77, anh Tue_NV và bác Doan Van Ha nhiều. 


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#51 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 06 September 2014 - 08:04 PM

Sao em chạy bị lỗi :(  :

Chọn điểm chèn TEXT ghi chú:
Chon huong ghi chu TEXT: ; error: bad DXF group: (62)

Nho anh Duan xem giúp


  • 0

#52 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 06 September 2014 - 08:20 PM

à quên đánh nội dung text :D


  • 0