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

nguyentuyen6

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    212

  • Đã tham gia

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

  • Ngày trúng

    3

Bài đăng được đăng bởi nguyentuyen6

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

    Với thằng dimRadius hay dimDiameter thì làm gì có DimensionLineExtend nên Cad báo lỗi.

    Bạn thử xóa mấy thằng đó đi, chỉ để dimLinear xem sao ?

     

    Em thử thêm 1 thằng dimLinear vẫn không sửa được = lisp đầu tiên bác ah

    Em không biết tại sao nó không nhận cái DimensionLineExtend và ExtensionLineExtend trong lisp đầu tiên mặc dù các cái khác nó nhận đc hết :wub:

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

    Bạn thử cái này nghe :

    Tạo 1 hàm con kiểm tra xem cái DIMENSION xem nó có chưa thuộc tính Pro không? Nếu có thì gán luôn cho nó thuộc tính Pro, nếu không có thì bỏ qua bằng hàm con sau :

     

    (defun Ktra_ganPro(obj pro gtrigan)

    (if (vlax-property-available-p obj pro)

    (vlax-put-property obj pro gtrigan)

    )

    )

     

    Trong chương trình chính thì gọi như sau : (ví dụ thuộc tính scalefactor)

    (Ktra_ganPro el 'scalefactor 1.0)

    Các thuộc tính khác gọi hàm Ktra_ganPro để kiểm tra và gán tương tự

    ......

    Chúc thành công. Nếu làm không được thì post cái file .dwg và file .lsp mà bạn làm lên đây, Tue_NV xem thế nào nhé.

     

    E thử làm như bạn và kết quả nó chạy được.

     

    Nhưng mà cái chỗ có hay không có thuộc tính PRO đó có lẽ không phải vấn đề. Bởi e dùng 1 lisp khác tương tự thì nó lại thay đổi đc mà không cần phải kiểm tra bác ạ. Bác thử kiểm với bản vẽ này nhé

     

    http://www.cadviet.com/upfiles/3/drawing2_12.dwg

     

    Rồi dùng 2 lisp sau thấy khác biệt:

    Dùng trước: http://www.cadviet.com/upfiles/3/ftnew_1.lsp

    Dùng sau: http://www.cadviet.com/upfiles/3/ft.lsp

     

    Thì thấy cái sau chỉnh đc tất.

     

    Các bác xem hộ em với nhé !!

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

    Mình có làm 1 Lisp để chỉnh kích thuớc Dim và Text trong bản vẽ dựa vào kích thước Block khung tên như vầy :

     

    http://www.cadviet.com/upfiles/3/ftnew.lsp

     

    					;Can chinh text va dim
(defun C:fdt (/ maublk tenblk loai j ssblk blkname OldEcho OldOs)
 (vl-load-com)
 (setq OldEcho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "undo" "be")
 (princ "\n      From nguyentuyen6 @CadViet ")
 (princ "\n Cai Express-Tools truoc khi su dung!!!")
				;chon mau blok khung ten
 (setq	maublk (car (entsel "\nChon Block khung ten: "))
tenblk (cdr (assoc 2 (entget maublk)))
loai   (cdr (assoc 0 (entget maublk)))
 )
				;lay tap hop tat ca cac blk khung ten
 (setq	ssblk (ssget "x" (list (cons 0 loai) (cons 2 tenblk)))
j     0
 )
				; Dat ty le
 (setq
   tileft    (cond (tileft)
	    (1)
      )
   tileftold tileft
   tileft    (getreal
	(strcat "\nChon ty le <" (rtos tileftold 2 2) ">: ")
      )
 )
 (if (= tileft nil)
   (setq tileft tileftold)
 )
				; xu ly tap blk khung ten
 (command "ZOOM" "e")
 (while (< j (sslength ssblk))
     
   (setq blkname (ssname ssblk j))
   (XuLyTextDim blkname)
   (setq j (1+ j))
 )
				; thong bao so blk khten
 (princ (strcat "\nDa Xu Ly : < "
	 (rtos (sslength ssblk) 2 0)
	 " > Khung Ten"
 )
 )
				;Tra lai bien he thong
 (command "undo" "e")
 (setvar "cmdecho" OldEcho)
 (princ "\n...Done...")
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;
(defun BatDau ()
 (setq OldOs (getvar "osmode"))
 (setvar "osmode" 0)
)
(defun KetThuc () (setvar "osmode" OldOs) (princ))
(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;
(defun XuLyTextDim (khungxuly	    /	    Rec	    pt1	    pt2
	    rpt1    rpt2    rpt3    rpt4    dis12   dis14
	    dis	    toadodinh	    caodim  tilechu textgap
	    dimxtend	    i	    el1	    el	    ssd
	    en
	   )
 (setq	Rec (acet-ent-geomextents khungxuly)
pt1 (nth 0 Rec)			;lay dinh               *-----pt2
pt2 (nth 1 Rec)			;lay dinh               | khung |
i   0
 )					;setq                              pt1-----*	
				;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
 (BatDau)
 (command "RECTANG" pt1 pt2)
 (KetThuc)
 (setq el1 (entlast))			;el1
				;-----lay tile, mac dinh la :1

				;-----lay dinh HCN = acet-geom-vertex-list
 (setq	toadodinh (acet-geom-vertex-list el1) ;    	  rpt4----rpt3
rpt1	  (nth 0 toadodinh)	;lay dinh                  |  el1 |
rpt2	  (nth 1 toadodinh)	;lay dinh                 rpt1----rpt2
rpt3	  (nth 2 toadodinh)	;lay dinh 
rpt4	  (nth 3 toadodinh)	;lay dinh
dis12	  (distance rpt1 rpt2)
dis14	  (distance rpt1 rpt4)
 )					;setq
				;----- Chia truong hop khung ngang va khung doc
 (if (> dis12 dis14)
   (setq caodim (* tileft (/ dis14 150))) ;T
   (setq caodim (* tileft (/ dis12 150))) ;F
 )					;if
 (setq	textgap	 (/ caodim 2)		; k/c tu Text den duong Dim
dimxtend (/ caodim 2)		;k/c dau dim 
tilechu	 (* caodim 1.2)		; cao Text so voi cao Dim(text)
 )
				;-----	
 (command "ERASE" el1 "")		;xoa hcn		 
 (princ (strcat "\nDim:<"
	 (rtos caodim 2 0)
	 ">. Text:<"
	 (rtos tilechu 2 0)
	 ">."
 )
 )
				;======================= M A I N =============================
 (setq ssd (ssget "_W" rpt2 rpt4 '((0 . "DIMENSION,TEXT"))))
;;;;;;;;;;;;;;;;;;;;
 (while (< i (sslength ssd))
   (setq en (ssname ssd i))
				;---- Text -----
   (if	(= (cdr (assoc 0 (entget en))) "TEXT")
     (moddxf 40 tilechu en)
   )					;if
				;-- DIMENSION -----
   (if	(= (cdr (assoc 0 (entget en))) "DIMENSION")
     (progn
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'ScaleFactor 1) ; chinh Scalefactor
(vlax-put-property el 'textheight caodim)
				; chieu cao text trong dim
(vlax-put-property el 'textgap textgap)
				; k/c tu Text den duong Dim
(vlax-put-property el 'ArrowheadSize dimxtend) ; do lon mui ten
(vlax-put-property el 'DimensionLineExtend dimxtend)
				;k/c 2 ben duong dim
(vlax-put-property el 'ExtensionLineExtend dimxtend)
				;k/c duong giong dim -> duong dim
(vlax-put-property el 'Arrowhead1Block "ArchTick")
				; loai mui ten
(vlax-put-property el 'Arrowhead2Block "ArchTick")
				; loai mui ten			
     )					;progn						  
   )					;if					  
   (setq i (1+ i))
 )					;while
				;---------------

)					;defun

     

    Vấn đề là: Khi chạy lisp ở 1 vài bản vẽ bị lỗi ở cái hàng ( gần cuối lisp )

    (vlax-put-property el 'DimensionLineExtend dimxtend)

    ;k/c 2 ben duong dim

    (vlax-put-property el 'ExtensionLineExtend dimxtend)

    ;k/c duong giong dim -> duong dim

    Cad nó báo như sau:

    ActiveX Server returned the error: unknown name: DIMENSIONLINEEXTEND

    Tất cả các Dim trong bản vẽ của mình đều cùng dùng 1 loại DimStyle

    Mình không hiểu tại sao nó lại bị như vậy!!!????. Bác nào giúp mình chỗ này với

    p/s: Nếu xóa bỏ 2 dòng kia đi thì lisp chạy băng băng

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

    Gửi bạn Tuyến,

    Lisp này của bạn khi chạy mà chọn block thì layer trong block đổi thành layer hiện hành còn layer ngoài vẫn giữ layer cũ.

    Mình copy code cl.lsp cũ của bạn và paste thêm vào cl2.lsp và đổi tên lệnh thành cl1. Dùng phối hợp cl và cl1 thì đạt được kết quả đề ra là cả layer trong và ngoài block đều thuộc layer hiện hành.

    Bạn có thể gộp 2 đoạn code này thành 1 và dùng chung tên lệnh là cl được không.

    Cám ơn bạn nhiều.

    Hoàng

    Của bạn đây:

     

    http://www.cadviet.com/upfiles/3/cl_3.lsp

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
				;nguyentuyen6 @ Cadviet 
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget))
;;;;;;;; 
   (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
(if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
(if	(= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
       (moddxf 8 curla en)
       (upwblock en)
	)
)
   (entupd en)
   (setq i (1+ i))
 )					; (command ".REGEN")  
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    • Vote tăng 1

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

    Gửi bạn Tuyến,

    Do mình ko download được cl.lsp của bạn nên mình copy đoạn code và tạo ra cl.lsp nhưng khi chạy báo lỗi sau:

     

    Command: ap

    APPLOAD cl.lsp successfully loaded.

    Command: cl

    Unknown command "CL". Press F1 for help.

     

    Mình post cl.lsp lên để bạn kiểm tra lại giúp mình:

    http://www.cadviet.com/upfiles/3/cl.lsp

     

    Hoàng

    http://www.cadviet.com/upfiles/3/cl_2.lsp

     

    Bạn download cái này về nhé, hình như download của diễn đàn bị hỏng

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

    Gửi bạn Nguyentuyen6,

    Lisp của bạn tương đối ổn nhưng khi áp dụng với block thì gặp vấn đề sau:

    - Layer ngoài của block thuộc lớp hiện hành nhưng layer trong vẫn ko đổi. Mình muốn cả layer trong và ngoài đều đổi thì sẽ tiện hơn khi format lại đối tượng.

    Cám ơn bạn nhiều.

    Hoàng

    Bạn dùng cái này nhé:

    Bạn dùng từ "cao thủ" làm mọi người thấy "sợ" đấy

     

    (defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
;nguyentuyen6 @ Cadviet
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget ))
 (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
   (if	(/= (cdr (assoc 0 (entget en))) "INSERT")
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
     (upwblock en)
   )
   (entupd en)
   (setq i (1+ i))
 )
;  (command ".REGEN")
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)

    • Vote tăng 1

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

    Gửi bạn Tú và ketxu,

    Các bạn có thể viết thêm code cho mình theo yêu cầu sau được không.

    - Khi chọn 1 hoặc nhiều đối tượng thì các đối tượng đó tự động thuộc layer hiện hành.

    Hoàng

     

    Bạn thử cái này nhé

     

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
				;nguyentuyen6 @ Cadviet
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget))
;;;;;;;;
   (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
(if (/= (cdr (assoc 8 (entget en))) curla)
          (moddxf 8 curla en)
        )
(if	(= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
          (moddxf 8 curla en)
          (upwblock en)
	)
)
   (entupd en)
   (setq i (1+ i))
 )					; (command ".REGEN")  
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
          (moddxf 8 curla en)
        )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

    Trước mình cũng viết cái Líp này mà dài loàng ngoằng ra. hehe

     

    (defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
(vl-load-com)
(defun c:bylayer (/ ss en el i)
 (vl-load-com)
(setvar "cmdecho" 0)  
(command ".UNDO" "E") 
 (princ "\n >>> Dang xu ly .....")
 (princ "\nChuyen ve ByLayer")
 ;25/11/2010
 ;nguyentuyen86@gmail.com
 (setq ss (ssget "x"))
 (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
   (if	(/= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
(if (/= (cdr (assoc 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)
     )
     (upwblock en)
   )
(entupd en)
   (setq i (1+ i))
 )
(command ".REGEN")
(command ".UNDO" "E")
(setvar "cmdecho" 0)  
(princ "\n....DONE....")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn
(if (/= (cdr (assoc 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)

     )
   )
(entupd en)
   (setq en (entnext en))
 )
)

    • Vote tăng 1

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

    Cảm ơn cac bạn đã tham gia trả lời câu hỏi của mình nhưng mình đã thử theo các cách của các bạn nhưng vẫn chưa dc. Cad 2008 thì máy ko có điều kiện cài. Chạy Cad2007 đã là hành hạ máy lắm rùi đó các bạn ơi!

     

    Nếu bạn vẽ+in trên model thì thử cái Líp này xem có đc ko.

    http://www.cadviet.com/forum/index.php?s=&...st&p=120434

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

    Cảm ơn bác Nguyentuyen6

    Field em làm dc từ ngay lúc đó.

    có lisp thì càng tuyệt vời hơn

    Rất mong bác sớm up lên sớm cùng chia sẻ và hoàn thiện.

     

    Bạn thử cái này nhé. Mình để chiều cao Dim mặc định là bằng 1/150 chiều rộng (ngắn) của blok khung tên. Chiều cao Text cao hơn Dim là 1,2 lần

     

    (defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs)(princ))
(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
;=========== FIX DIM TEXT ===========;
;Chinh chieu cao cua dim & text theo ;
;chieu rong(ngan) cua block khung ten;
;Mac dinh la = 1/150 chieu rong k/ten;
;====================================;
(defun c:ft (/ Rec pt1 pt2 rpt1 rpt2 rpt3 rpt4 dis12 dis14 dis toadodinh 
caodim tilechu textgap dimxtend i el1 el ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n      From nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
(setq Rec (acet-ent-geomextents (car (entsel "\nChon block khung ten:")))
	  pt1 (nth 0 Rec);lay dinh               *-----pt2
	  pt2 (nth 1 Rec);lay dinh               | khung |
	  i 0);setq                              pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1
;-----lay tile, mac dinh la :1
(setq
 tileft (cond (tileft) (1))
 tileftold tileft
 tileft   (getreal (strcat "\nChon ty le <"(rtos tileftold 2 2)">: "))
)
(if (= tileft nil) (setq tileft tileftold))
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1);    	  rpt4----rpt3
	  rpt1 (nth 0 toadodinh);lay dinh                  |  el1 |
	  rpt2 (nth 1 toadodinh);lay dinh                 rpt1----rpt2
	  rpt3 (nth 2 toadodinh);lay dinh 
	  rpt4 (nth 3 toadodinh);lay dinh
	  dis12 (distance rpt1 rpt2)
	  dis14 (distance rpt1 rpt4));setq
;----- Chia truong hop khung ngang va khung doc
(if (> dis12 dis14)		  
	  (setq caodim (* tileft (/ dis14 150)));T
	  (setq caodim (* tileft (/ dis12 150)));F
) ;if
(setq textgap (/ caodim 2); k/c tu Text den duong Dim
  dimxtend (/ caodim 2);k/c dau dim 
  tilechu (* caodim 1.2); cao Text so voi cao Dim(text)
  ) 
;-----	
(command "ERASE" el1 "");xoa hcn		 
(princ (strcat "\nDim:<" (rtos caodim 2 0) ">. Text:<" (rtos tilechu 2 0) ">. Chon Dim & Text can Fix:"))
;======================= M A I N =============================
(setq ssd (ssget '((0 . "DIMENSION,TEXT")))); loc dim text
(while (< i (sslength ssd))
(setq en (ssname ssd i))
;---- Text -----
(if (= (cdr (assoc 0 (entget en))) "TEXT")
	(moddxf 40 tilechu en)
);if
;-- DIMENSION -----
(if (= (cdr (assoc 0 (entget en))) "DIMENSION")
	(progn 
		(setq el (vlax-ename->vla-object en))
		(vlax-put-property el 'ScaleFactor 1); chinh Scalefactor
		(vlax-put-property el 'textheight caodim); chieu cao text trong dim
		(vlax-put-property el 'textgap textgap); k/c tu Text den duong Dim
		(vlax-put-property el 'ArrowheadSize dimxtend); do lon mui ten
		(vlax-put-property el 'DimensionLineExtend dimxtend);k/c 2 ben duong dim
		(vlax-put-property el 'ExtensionLineExtend dimxtend);k/c duong giong dim -> duong dim
		(vlax-put-property el 'Arrowhead1Block "ArchTick"); loai mui ten
		(vlax-put-property el 'Arrowhead2Block "ArchTick"); loai mui ten			
	);progn						  
);if					  
(setq i (1+ i))	 
);while
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

    • Vote tăng 1

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

    Chào bạn nguoi_tho_mo. Không biết bạn đã làm đc cái Block chứa FIELD kia chưa. Nếu chưa thì để mình hướng dẫn luôn.

    Còn vấn đề vẽ trong MODEL mà ta hay scale khung với tỉ lệ khung bất kỳ mà khi muốn in ra các DIM và TEXT luôn bằng nhau thì mình cũng đã từng mắc phải. Mình có viết 1 lisp để làm việc này. Nếu bạn cần thì mai mình úp lên cho bạn tham khảo. Khi dùng líp này thì dù khung có scale bao nhiêu đi nữa thì in ra TEXT và DIM vẫn cứ bằng nhau. hề hề.

    • Vote tăng 1

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

    @ bác Bình:Lúc nhỏ thì phải lổm ngổm bằng bốn vó. Về già đi hai chân không nổi phải chống thêm cái ba tông làm chân thứ ba

    Lúc nhỏ trẻ con bò , vẫn là 2 tay, hai chân... Ba tông không phải là chân. Câu đố em ra là chân thật chứ không phải chân giả đâu nhé!

    câu đố tiếp

    Hoamit.jpg

    là hoa gì???

     

    Quê mình gọi là quả " DÁI MÍT " :leluoi:

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

    Vâng em đi kiếm không ra, còn tự viết thì phải đợi một thời gian nữa vì "Quá gà"

    EM block dim (không có chân) mừng hụt bác ạ. được cái này thì mất cái kia

    EM trình bày rõ mục đích các bác giúp em khác phục khó khăn này:

    em đặt số 1 vào block khung tên khi scale khung tên bao nhiêu lần thì số 1 thay đổi giá trị và kích thước theo.

     

    Cái này dùng FIELD là đc mà bạn. Mình thử 1 cái này xem có đúng ý bạn ko nhé. Scale xong thi` REGEN nhe'

    http://www.cadviet.com/upfiles/3/up_1.dwg

    • Vote tăng 1

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

    E sưu tầm được 1 lisp vẽ ký hiệu đối xứng.Nhưng khi vẽ xong nó không phải block,e lại không biết lisp.Nhờ các bác sửa giùm khi vẽ xong nó là 1 block.Thanks.

    (DEFUN C:dx (/ CMD OSM OLDERR PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
SZ G45 G135 G90 G180 SS loi)
(defun loi (s)
(if (= s "Function cancelled")
(princ)
(princ (strcat "Error:" s))
)
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)
;;***************************************
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *error*
*error* loi)
(SETQ SZ (GETREAL "\nSize <1>:"))
(SETQ bn (getstring "\nTen block:"))
(IF (= SZ nil) (SETQ SZ 100))
(SETQ G45 (/ PI 4))
(SETQ G135 (* 3 (/ PI 4)))
(SETQ G90 (- G45 (/ PI 2)))
(SETQ G180 (+ G135 (/ PI 2)))
(SETQ PT1 (GETPOINT "\nDiem doi xung:"))
(SETVAR "OSMODE" 0)
(SETQ PT2 (POLAR PT1 G45 (* 2 SZ)))
(SETQ PT3 (POLAR PT2 G90 (* 2 SZ)))
(SETQ PT4 (POLAR PT1 G45 (* 1 SZ)))
(SETQ PT5 (POLAR PT1 G135 (* 2 SZ)))
(SETQ PT6 (POLAR PT5 G180 (* 2 SZ)))
(SETQ PT7 (POLAR PT1 G135 (* 1 SZ)))
(SETQ PT8 (POLAR PT1 G45 (* -0.7 SZ)))
(SETQ PT9 (POLAR PT1 G135 (* -0.7 SZ)))
(PRINC "\nGoc quay:")
(SETQ SS (SSADD))
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "150" "")
(COMMAND "LINE" PT8 PT2 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PT9 PT5 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "COLOR" "7" "")
(COMMAND "SOLID" PT2 PT3 PT4 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "SOLID" PT5 PT6 PT7 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "ROTATE" SS "" PT1 PAUSE)
(command "_.BLOCK" bn PT1 ss ""
          "_.INSERT" bn PT1 1 1 0)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)

    • Vote tăng 2

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

    @phamngoctukts: Cảm ơn bác nhé. Hix. Em nhìn vào cái đoạn Líp của bác đưa mà hoa hết cả mắt...

     

    @phamthanhbinh: Cảm ơn bác bình. Cái líp của bác chạy ngon rồi. Cái hàm (upwblock) em hiểu máy móc nó là thế này.

     

    Kiểm tra có phải Block hay ko. Nếu là block thì chạy hàm (upwblock)

     

    (defun upwblock ( blk / s en els el)
(setq s (cdr (assoc 2 (entget blk))))
(setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while en
(setq els (entget en))
(if (wcmatch (cdr (assoc 0 els)) "INSERT")
(UPWBlock en)

........Làm cái gì thì làm ở đây.........

(entupd en)
(setq en (entnext en))
)
)

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

    Ngại quá :leluoi: . Hôm nay em làm cái Líp chuyển tất cả các đối tượng trên bản vẽ về "bylayer" hết. Nhưng khổ nỗi loay hoay mãi không sao làm đc với các đối tuợng trong BLOCK. Em cũng thử mày mò bằng hàm con (UPWB) mà bác Tue hay bác thanhbinh dùng mà chả đc.

     

    (defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
(defun c:bylayer (/ ss en el i)
(vl-load-com)
(princ "\nChuyen ve ByLayer")
(setq ss (ssget "x"))
( setq i 0)
(while (< i (sslength ss)) 
  (setq en (ssname ss i))
	(if (/= (cdr (assoc 62 (entget en))) nil)
		(moddxf 62 256 en)
	)	
  (setq el (vlax-ename->vla-object en))
		    (vlax-put-property el 'Linetype "ByLayer")
		    (vlax-put-property el 'Lineweight -1)
  (setq i (1+ i))
)
)

     

    Các bác sửa giúp em cho nó chạy đc luôn cả trong block với. Viết code theo kiểu của hàm (UPWB) ý nhé. để em ngâm cứu nó phát.

     

    VD về hàm con (UPWB): http://www.cadviet.com/forum/index.php?sho...st&p=105502

×