Đây là đoạn Code Tue_NV viết theo ý bạn. Hy vọng bạn hài lòng.

Có thể hiện sáng đối tượng khi bạn pick điểm.

Hãy chạy thử xem nhé :

>>

Đây là đoạn Code Tue_NV viết theo ý bạn. Hy vọng bạn hài lòng.

Có thể hiện sáng đối tượng khi bạn pick điểm.

Hãy chạy thử xem nhé :

(defun c:NBPL()
(vl-load-com)
(setq ss (car (entsel "\n Pick chon doi tuong : ")))
(Hli ss)
(setq po (getpoint  "\n Chon diem cat : "))
(setq ddau (vlax-curve-getStartPoint ss))
(setq dcuoi (vlax-curve-getEndPoint ss))
(Command "break" ss po "@")
(Command "Pedit" "m" ddau dcuoi "" "j" "0" "")
(Hli ss)
(while po (setq po (getpoint  "\n Chon diem cat tiep theo : "))
(Command "select" ddau dcuoi "")
(setq ss (ssget "P"))
(Command "break"  ss po "@")
(Command "Pedit" "m" ddau dcuoi "" "j" "0" "")
(sssetfirst ss ss)
)
(princ)
)
;
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))
)

Chào bác Tue_NV,

Mình đọc lisp của bác rồi nhưng mà chưa hiểu cái tham số "@" của lệnh break bác ạ. Một số lisp khác trên diễn đàn đã sử dụng (Command "break" dt p p) để cắt đối tượng tại điểm chọn.

Hai cách dùng này có gì khác nhau và tại sao, bác có thể giải thích thêm một chút cho mình sáng ra được không?

Còn về cái sai của mình như bác và bác Duy nói là hoàn toàn chính xác do mình không phân biết được khái niệm node và point. Thành thực nhận lỗi và mong các bác chỉ dạy thêm. Giờ mình đã hiểu thêm node là gì.

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

<<

Sau khi entupd vẫn không được bác Hạ ạ.

(defun C:00(/ ss0 ss item Caodo Ma_Pnt Tdo Pnt)
(setq ss0 (ssget (list (cons 0  "TEXT"))))
(setq ss (acet-ss-to-list ss0))
(foreach item ss
	(setq temp  (entget item))
	(setq Caodo  (cdr (assoc 1 temp)))
	(setq Ma72 (car (TD:Ma_And_Pnt item )))
	(setq Ma73 (cadr (TD:Ma_And_Pnt item )))
	(setq Ma_Pnt (caddr (TD:Ma_And_Pnt item )))
	(setq Pnt  (cdr (assoc Ma_Pnt temp)))
	(entmod
		(subst (list Ma_Pnt...
>>

Sau khi entupd vẫn không được bác Hạ ạ.

(defun C:00(/ ss0 ss item Caodo Ma_Pnt Tdo Pnt)
(setq ss0 (ssget (list (cons 0  "TEXT"))))
(setq ss (acet-ss-to-list ss0))
(foreach item ss
	(setq temp  (entget item))
	(setq Caodo  (cdr (assoc 1 temp)))
	(setq Ma72 (car (TD:Ma_And_Pnt item )))
	(setq Ma73 (cadr (TD:Ma_And_Pnt item )))
	(setq Ma_Pnt (caddr (TD:Ma_And_Pnt item )))
	(setq Pnt  (cdr (assoc Ma_Pnt temp)))
	(entmod
		(subst (list Ma_Pnt (car Pnt) (cadr Pnt) (atof Caodo)) (assoc Ma_Pnt temp)
			(subst (cons 72 Ma72) (assoc 72 temp)
				       (subst (cons 73 Ma73) (assoc 73 temp) temp)
			)
		)
	)
  	(entupd item)
   
)
(princ)
)

Gửi bạn xem đã ok chưa????

(defun C:layt (/ oldos s text ndtext)
 (command "undo" "be")
 (setq oldos (getvar "OSMODE")) 
 (setvar "cmdecho" 0)
 (setvar "osmode" 512)
 (setq s (GetClipBoardText))
 (setq ndtext nil)
 (while (vl-string-search "\n" s)
 (setq text (substr s 1 (vl-string-search "\n" s)))
 (setq ndtext (cons (substr text 1 (- (strlen text) 1)) ndtext))
 (setq s (substr s (+ 2...
>>

Gửi bạn xem đã ok chưa????

(defun C:layt (/ oldos s text ndtext)
 (command "undo" "be")
 (setq oldos (getvar "OSMODE")) 
 (setvar "cmdecho" 0)
 (setvar "osmode" 512)
 (setq s (GetClipBoardText))
 (setq ndtext nil)
 (while (vl-string-search "\n" s)
 (setq text (substr s 1 (vl-string-search "\n" s)))
 (setq ndtext (cons (substr text 1 (- (strlen text) 1)) ndtext))
 (setq s (substr s (+ 2 (vl-string-search "\n" s))))
 )
 (setq ndtext (reverse ndtext))
 (foreach lst ndtext
 (thaythe lst)
 )
 (setvar "osmode" oldos)
 (setvar "cmdecho" 1)
 (command "undo" "end")	
 (princ )
 )
(defun thaythe(s / giatrimoi giatricu thongtin)
(setq giatriold (entsel "\nGia tri can thay the"))
	(while
 	 (or
   	 (null giatriold)
   	 (/= "TEXT" (cdr (assoc 0 (entget (car giatriold)))))
	 )
	(princ "\nDoi tuong khong phai la text! Chon lai")
 	(setq giatriold (entsel "\nGia tri can thay the"))
	)
(setq thongtin (entget (car giatriold)))
(setq giatricu (assoc 1 thongtin))
(setq giatrimoi (cons 1  s))
(setq thongtin (subst giatrimoi giatricu thongtin))
(entmod thongtin)
(command "_change" giatriold "" "p" "c" "1" "")
)
(defun GetClipBoardText( / htmlfile result ) ; By Patrick_35
 (setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'GetData "Text" ) )
 (vlax-release-object htmlfile)
 result
)

 

1 lệnh cũng được, nhiều lệnh cũng được, trên diễn đàn có lisp để bạn là việc này rồi mà.Bạn chịu khó search nhé.Trường...

>>

 

1 lệnh cũng được, nhiều lệnh cũng được, trên diễn đàn có lisp để bạn là việc này rồi mà.Bạn chịu khó search nhé.Trường hợp của bạn có thể dùng lệnh nối các line liền nhau lại thành 1 Pline, khi đó khối lượng công việc giảm đi nhiều

Còn đây là 1 lisp tính tổng chiều dài các đoạn được chọn.

;; free lisp from cadviet.com @Bommak(defun add_mline ()  (foreach e_record_sub	e_record    (cond ((= 10 (car e_record_sub))	   (setq pt1	   (cdr e_record_sub)		 mline_len 0.0	   )	  )	  ((= 11 (car e_record_sub))	   (setq pt2	   (cdr e_record_sub)		 mline_len (+ mline_len (distance pt2 pt1))		 pt1	   pt2	   )	  )    )  )  (setq tot_len (+ tot_len mline_len))  (ssdel e_name ss));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defun WriteRes(kq / OK e data)(setq OK nil)(while (not OK)(setq e (car (entsel "\tChon text ghi ket qua:")))(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text")))(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))(princ));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defun C:tg2a (/ tot_len ss e_name e_record e_type)  (setq tot_len 0.0)  (setq ss (ssget))  (if (null ss)    (exit)  )  (while (> (sslength ss) 0)    (setq e_name (ssname ss 0))    (setq e_record (entget e_name))    (setq e_type (cdr (assoc '0 e_record)))    (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")	   (command "lengthen" e_name "")	   (setq tot_len (+ tot_len (getvar "PERIMETER")))	   (ssdel e_name ss)	  )	  ((wcmatch e_type "MLINE") (add_mline))	  (e_type (ssdel e_name ss))    )  );De dong nay neu muon cong them gia tri vao kq	;(setq tot_len (+ tot_len (getreal "\nGia tri cong them : ")))  (writeres tot_len))

Mình có dùng cái lipsp này của bạn nhưng cũng đến bước chọn text ghi kết quả là nó cũng bị lỗi. Bạn kia nói không rõ lắm thôi, sau đây là lỗi trên dòng command "ketxu" à:

Command: TG2A

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:

Current length: 4.91263

Current length: 0.47663   Chon text ghi ket qua:; error: no function

definition: CHECKOBJ

Command:

Nó có tính được chiều dài các đối tượng rồi nhưng đến ghi ra text thì bị lỗi

Bạn xem lại xem có gì sai sót ko vì khi mình dùng lisp TL để tính chiều dài thì ngon lành nhưng nó chỉ tính được có 1 đối tượng mà thôi

Mình search nên giờ mới thấy topic này

<<

5 giờ trước, khongban231 đã nói:

Thank bạn...

>>

5 giờ trước, khongban231 đã nói:

Thank bạn nhé!

Nhưng mình muốn dùng lisp cắt cái như file đính kèm chỉ 1 thao tác, các hình trong file chỉ là ví dụ thôi chứ hiình của mình nó là cac đường giao mấy trăm đối tượng nên ko làm thủ công được. 

Drawing1.dwg

Quick code tí cho bạn. Chưa test hết các trường hợp nhưng thử bản vẽ drawing thì thấy chạy được. ^_^

(defun c:test  (/ vl-pline-centroid n pt ss ent)
  (defun vl-pline-centroid  (pl / acdoc space obj reg cen)
    (vl-load-com)
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          space (if (= (getvar "CVPORT") 1)
                  (vla-get-paperspace acdoc)
                  (vla-get-modelspace acdoc)
                  )
          )
    (or (= (type pl) 'vla-object)
        (setq obj (vlax-ename->vla-object pl))
        )
    (setq reg (vlax-invoke space 'addregion (list obj))
          cen (vlax-get (car reg) 'centroid)
          )
    (vla-delete (car reg))
    (trans cen 1 (vlax-get obj 'normal))
    )
  (if (setq ss (ssget))
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq pt (vl-pline-centroid (ssname ss n)))

        (setq ent (entmake
                    (list '(0 . "POINT") (cons 10 pt))
                    )
              )
        (command "_.Zoom" "obj" (ssname ss n) "")
        (etrim (ssname ss n) pt)
  
        (setq n (1+ n))
        ) ;repeat
      ) ;progn
    ) ;if
  (command "zoom" "all")
  )

 

<<

Để dấu mũi tên Closed filled lớn theo tỉ lệ thì bạn này có thể chỉnh thêm như sau:

Mình có chỉnh lisp của bạn này 1 tí. Xin lỗi...

>>

Để dấu mũi tên Closed filled lớn theo tỉ lệ thì bạn này có thể chỉnh thêm như sau:

Mình có chỉnh lisp của bạn này 1 tí. Xin lỗi nha:

(defun c:TL()
(setvar "REGENMODE" 0)
(setq SCALE (getstring "\nInput current scale : "))
(setq scal (atof (substr SCALE 1 3)))
(setvar "DIMBLK" "")
(setvar "DIMCLRE" 2) ;Color
(setvar "DIMCLRD" 2) ;Color
(setvar "DIMCLRT" 2) ;Color
(setvar "DIMZIN" 8) ;Trailing
(command "STYLE" "3" "VNI-Times" (* 3 scal) "0.9" "0" "N" "N")
(command "STYLE" "5" "VNI-Times" (* 5 scal) "1.0" "0" "N" "N")
(command "STYLE" "2" "vn_vni" (* 2 scal) "0.65" "0" "N" "N" "N")
(command "STYLE" "22" "vn_bk1" (* 2 scal) "0.70" "0" "N" "N" "N")
(setvar "DIMEXE" (* 0.6 scal)) ;Extension above line
(setvar "DIMEXO" 0) ;Feature offset
(setvar "DIMASZ" 0.18) ;Arrow size
(setvar "DIMTSZ" 0) ;Tick size
(setvar "DIMCEN" (* 0.95 scal));Center mark size( them vao)
(setvar "DIMDEC" 1) ;
(setvar "DIMDLE" 0) ;Closed blanK
(setvar "DIMDLE" 0) ;Tick extension
(setvar "DIMTXT" (* 2 scal)) ;Text height  
(setvar "DIMTAD" 1) ;Verical (defauft)
(setvar "DIMTIH" 0) ;Horizontal
(setvar "DIMTOH" 0) ;Horizontal
(setvar "DIMTIX" 1) ;Force text inside
(setvar "DIMSOXD" 0) ;Force text inside
(setvar "DIMFIT" 5) ;No leader
(setvar "DIMGAP" (* 0.45 scal))
(setvar "DIMTXSTY" "2")
(setq dsn (strcat "TL" (substr SCALE 1 3))) 
(setq ao (vlax-get-acad-object)) 
(setq ad (vla-get-ActiveDocument ao)) 
(setq obj (vla-add(vla-get-dimstyles ad) dsn)) 
(vla-copyfrom Obj ad) 
(vla-put-activedimstyle ad Obj)
(setvar "REGENMODE" 1)
(Princ)
) 

 

Thanhks với!

 

Vẫn ko được bạn ơi, size mũi tên vẫn ko nhúc nhít >"<

<<

Thử xem được chưa

;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;chuong trinh thong ke block - Pham Tien Chien - XMT
;phien ban V1.0
;================
(defun c:bc( / ss bn sl lst txt n)
  (defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)
(setq ss (ssget...
>>

Thử xem được chưa

;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;chuong trinh thong ke block - Pham Tien Chien - XMT
;phien ban V1.0
;================
(defun c:bc( / ss bn sl lst txt n)
  (defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)
(setq ss (ssget '((0 . "insert"))))
(if (null ss) (exit))
  (setq
    n 0
;;;    ent (entget (ssname ss 0))
;;;    bn (cdr (assoc 2 ent))
;;;    lst (list (cons bn 1))
    )
 
  (repeat (sslength ss)
    (setq
      bn (LM:effectivename (vlax-ename->vla-object (ssname ss n)))
;;;      ent (entget (ssname ss n))
;;;      bn (cdr (assoc 2 ent))
      )
    (if (not (assoc bn lst))
      (setq lst (cons (cons bn 1) lst))
      (setq
	sl (cdr (assoc bn lst))
	sl (1+ sl)
	lst (subst (cons bn sl) (assoc bn lst) lst)
	)
      )
    (setq n (1+ n))
    )
(setq txt "")
(setq n 0)
(repeat (length lst)
  (setq a (nth n lst))
  (setq txt (strcat txt "\n" (itoa (cdr a)) "....." (car a) ))
  (setq n (1+ n))
  )
(command "_Mtext" pause pause txt "")
(princ)
);the end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Sửa thế này được không Bạn?

(defun c:cb ()
(vl-load-com)
(setq p1 (getpoint "\nKhoanh vung chon doi tuong: ")
  	p2...
>>

Sửa thế này được không Bạn?

(defun c:cb ()
(vl-load-com)
(setq p1 (getpoint "\nKhoanh vung chon doi tuong: ")
  	p2 (getcorner p1)
  	ht (getvar "textsize")
  	oldos (getvar "osmode"))
(setq name T)
(setvar "osmode" 0)
(while name
 (setq name (car (entsel "\nChon loai block can dem: ")))
 (while (= name nil)
  (setq name (car (entsel "\nChon loai block can dem: "))))
 (setq ent (entget name))
 (command "zoom" p1 p2)
 (setq nhomb (ssget "c" p1 p2 (list (assoc 0 ent) (assoc 2 ent)))
       noidung (strcat "so den: " (cdr (assoc 2 ent)) " co " (rtos (sslength nhomb) 2 0) " cai"))
 (alert noidung)
 (command "zoom" "p")
 (setq dk (getstring "\nBan co muon tiep tuc khong: Co/Khong: <CO>: "))
 (if (= (strcase dk) "K") (setq name nil))
 (if (or (= (strcase dk) "C") (= dk "")) (setq name T)))
(setvar "osmode" 15359))

P/S 790312: "ý mình là nó hiện lên giống dòng KHOANH VÙNG CHỌN ĐỐI TƯỢNG và CHỌN LOẠI BLOCK CẦN ĐẾM ...bạn ah.Dù gì cũng vote bạn 1 cái."

Cái này tôi chưa biết nên chịu!!! Ai biết chỉ giùm 790312.

Nếu ý bạn đó muốn hiện trên command line thì dùng

(prompt noidung)

(getstring)

thay cho

(alert noidung)

<<

Sau khi được bác nhoclangbat sửa lisp chuyển layer như sau

;; free lisp from cadviet.com
;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch...
>>

Sau khi được bác nhoclangbat sửa lisp chuyển layer như sau

;; free lisp from cadviet.com
;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;************************Chuyen doi tuong ve dung layer

(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
 (setq OBJS (ssget "X" (list (cons 0 _TYPE))))
 (if (not (tblsearch "layer" LAYER)) 
  (command ".layer" "m" LAYER "")
 );_ end if
 (command ".chprop" OBJS "" "la" LAYER "")
 (princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
;(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT")
(if (and (setq ss (ssget  "_x" '((0 . "HATCH") (-4 . "<not")(8 . "---Q63-LAT NEN")(-4 . "not>")))))
(command ".chprop" ss "" "la" "---Q8-HATCH" ""))
)

Thì em có thêm một yêu cầu nhỏ là khi dùng lệnh "9" để chuyển layer, các đối tượng hatch thuộc layer "X1" sẽ không bị chuyển về layer "---Q8-HATCH", các đối tượng text thuộc layer "X2" sẽ không bị chuyển về layer "---Q9-TEXT". Mong bác nào giúp em chỉnh sửa lisp trên. Cảm ơn mọi người đã đọc.

Hề hề hề,

Không biết thời không có tội tình chi cả. Song nếu không muốn biết mà cái sự biết ấy lại rất cần cho...

>>

Hề hề hề,

Không biết thời không có tội tình chi cả. Song nếu không muốn biết mà cái sự biết ấy lại rất cần cho công việc của mình thì nó là tội to đấy. Tội LƯỜI, tội Ỷ LẠI, tội THIẾU TRÁCH NHIỆM, ..... trăm thứ tội cơ đấy.

Mình muốn giúp mà bạn không muốn thì chỉ có trời giúp được bạn thôi.

Đây là cái mình chỉ cần mươi phút để làm nhưng rất không muốn làm vì nó không có ý nghĩa gì với mình cả. Vì bạn quá cần nên mình nhín chút giận mà làm nhưng hy vọng bạn sẽ có thay đổi trong cách làm việc của bạn để có thể tiến bộ hơn. Chúc bạn chóng thành tài.

Mình sẽ không giải thích gì thêm và cũng sẽ không sửa gì nữa đâu, nếu bạn thấy không dùng được thì cứ cho vào sọt rác cho rảnh nợ nhé.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...t=0
(defun c:taluy (/)
(setvar "CMDECHO" 0)
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(setvar "unitmode" 0)
(setvar "dimzin" 0)
(setvar "blipmode" 0)
(setvar "aunits" 0)
(setvar "angbase" (/ pi 2))
(setvar "angdir" 1)
(if (not (tblsearch "layer" "BATTER"))  
(command "layer" "n" "BATTER" "color" "8" "BATTER" "s" "BATTER" \n)
(command "layer" "s" "BATTER" \n)
)  
(if (not lint)
(setq lint 10.0)
)
(setq int (getdist (strcat "\nNhap khoang cach chia taluy <" (rtos lint 2 3) ">: " ))  )
(if int
   (setq lint int)
   (setq int lint)
)
(setq kth0 5)
(setq kth (getint (strcat "\n Nhap so khoang ho khong ve net taluy <" (rtos kth0 2 0) ">: ")) )
(if kth
     (setq kth0 kth)
     (setq kth kth0)
)
(command "line" (list 0.0 0.0) (list 0.0 0.0001) "")
(if (tblsearch "block" "tadtick")
(command "block" "tadtick" "y" (list 0.0 0.0) (entlast) "")
(command "block" "tadtick" (list 0.0 0.0) (entlast) "")
)
(while (setq refent (entsel "\nChon doi tuong can rai taluy : "))
(command "undo" "group")  
(redraw (car refent) 3)
(initget 1 "daO daP")
(setq reply (getkword "\nChon kieu taluy Nen Da hay Nen Da: "))
(print "\n")
(print "Chon cac doi tuong can batter :")
(setq s (ssget))
(command "measure" refent "b" "tadtick" "y" int)
(setq p  (ssget "p") cn 0)
(if s  
		(progn  
             (while (< cn (sslength p))
              		(setq en (entget (ssname p cn))
                      		p0 (cdr (assoc 10 en))
                      		pt1 p0
                      		pt2 nil
                      		b (cdr (assoc 50 en))
              		)
              		(entdel (ssname p cn))
              		(setq p1 (polar p0 (+ (/ pi 2) b ) 0.0001))  
              		(command "line" p0 p1 "")
              		(command "extend" s "" (list (entlast) p1) "")
              		(setq xent (entget (entlast)))    
              		(setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))    
              		(if (not (equal xdist 0.0001 0.0001))      
                  		(setq pt2 (cdr (assoc 11 xent)))      
                  		(progn        
                                 (command "extend" s "" (list (entlast) p0) "")        
                                 (setq xent (entget (entlast)))        
                                 (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))        
                                 (if (not (equal xdist 0.0001 0.0001))       
                                     (setq pt2 (cdr (assoc 10 xent)))        
                                 )      
                  		)    
                       )    
                       (entdel (entlast))    
                       (if pt2      
                           (if (= reply "daP")  
                               (cond        
                               ((or (= (rem cn  (+ kth 5)) 0) (= (rem cn (+ kth 5)) 2) (= (rem cn (+ kth 5)) 4))  
                                   (setvar "lwdefault" 9) (setvar "clayer" "net manh") (setvar "cecolor" "8") (command "line" pt1 pt2 "") )
                               ((or (= (rem cn (+ kth 5)) 1) (= (rem cn (+ kth 5)) 3))       
                                   (setvar "lwdefault" 20)(setvar "clayer" "net 0.2") (setvar "cecolor" "6")(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 3)) "") )
                               (T nil)        
                               )  
                               (cond      
                               ((or (= (rem cn (+ kth 5)) 0) (= (rem cn (+ kth 5)) 2) (= (rem cn (+ kth 5)) 4))	       
                                   (setvar "lwdefault" 9)(setvar "clayer" "net 0.2")(setvar "cecolor" "8") (command "line" pt2 pt1 "") )
                               ((or (= (rem cn (+ kth 5)) 1) (= (rem cn (+ kth 5)) 3))       
                                   (setvar "lwdefault" 20) (setvar "clayer" "net manh") (setvar "cecolor" "6") (command "line" pt2 (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 3)) "")  )
                               (T nil)          
                               )      
                    		)    
                         )    
                         (setq cn (1+ cn))  
                 )      
           )    
     )    
     (command "undo" "en")  
)  
(setvar "blipmode" 1)  
(setvar "osmode" osmode)
(princ)
)

 

Cảm ơn Bác Bình rất nhiều! Thế mà Bác Ketxu bảo khoảng cách giữa không thể viết được. Em rất muốn học hỏi nhưng em không biết gì về ngôn ngữ autolisp cả nên mới rất cần Bác giúp dỡ. Thanhks bác Bình!

<<

Sony sử dụng code này thử nhé :

(defun c:kmm(/ ss sss doc Util ent)
 (vl-load-com)
 (if (not (tblsearch "LAYER" "LAYERCHUNG"))
   (command "Layer" "N" "LAYERCHUNG" "S"...
>>

Sony sử dụng code này thử nhé :

(defun c:kmm(/ ss sss doc Util ent)
 (vl-load-com)
 (if (not (tblsearch "LAYER" "LAYERCHUNG"))
   (command "Layer" "N" "LAYERCHUNG" "S" "LAYERCHUNG" "")
  )
 (setq ss (ssget "X" '((-4 . "") ))  )
 (setq doc (vla-get-activeDocument (vlax-get-acad-object))
Util (vla-get-utility doc))
 (vlax-for x (setq sss (vla-get-ActiveSelectionSet doc))
   (setq ent (vlax-vla-object->ename x))

   (if (= (assoc 62 (entget ent)) nil)
       (setq ent_cont (entget(tblobjname "LAYER" (cdr(assoc 8 (entget ent))))))
       (setq ent_cont (entget ent))
   )
  (vlax-put x 'Color (cdr(assoc 62 ent_cont)))
   (if (= (assoc 6 (entget ent)) nil)
       (setq ent_cont (entget(tblobjname "LAYER" (cdr(assoc 8 (entget ent))))))
       (setq ent_cont (entget ent))
   )
   	  (vlax-put x 'Linetype (cdr(assoc 6 ent_cont)))
   (vlax-put x 'layer "LAYERCHUNG")
 )
 (vla-delete sss)
 (alert "\n Da chuyen tat ca thanh LAYERCHUNG")
(princ)
)

Chức năng download của diễn đàn bị lỗi. Bạn nhấn Reply bài viết của Tue_NV -> chép hết code về và apload -> sử dụng nhé.

 

Đúng ý em rùi. Cám ơn bác Tuệ rất nhiều...........

<<

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc...
>>

Chui vào bên trong xem tốc độ có ổn hơn không. Mình sử dụng VL

 

(defun c:cisov(/ _table _vlacol lays adoc col)
	(vl-load-com) 
	(defun _table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append  (list (cons (cdr (assoc 2 d)) (cdr (assoc 62 d)))) r))
		)	
	)
	(defun _vlacol(obj lays / col)(if (/= (setq col (vla-get-color obj)) 256) col (cdr (assoc (vla-get-layer obj) lays))))
	(setq lays (table "LAYER"))
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq col (get_vlacol (vlax-ename->vla-object (car(entsel))) lays)) 
	(vla-startundomark adoc)
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(if (/= (get_vlacol ent lays) col) (vla-put-visible ent 0))
		)
	)
	(vla-endundomark adoc)
)

(defun c:cunisov(/ adoc)
	(vl-load-com) 	
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))	
	(vlax-for block (vla-get-blocks adoc)     
		  (vlax-for   ent block 
			(vla-put-visible ent 1)
		)
	)
)

Bạn xem lại mình chạy thử thấy bị lỗi về hàm định nghĩa  table và hàm get_vlacol và mình đã sửa lại rồi thì chạy được tốc độ nhanh hơn gấp 2 lần so với lisp trước nhưng chạy xong vẫn thấy báo lỗi, và lỗi này mình không biết xử lý. Dòng báo lỗi cả 2 lệnh như nhau:

Select object: ; error: Automation Error. On locked layer 

<<

 

Của bạn đây.

 

 

Hướng...

>>

 

Của bạn đây.

 

 

Hướng dẫn: 

1. Lệnh CLO

2. Chọn máy in, khổ giấy, style...

3. Đặt tên Layout, tỉ lệ

4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.

5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.

6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout.

;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL
(vl-load-com)
(defun Make_dcl	(/ ret)
  (if (= Printer nil) (setq Printer 0))
  (if (= Size nil) (setq Size 0))
  (if (= Style nil) (setq Style 0))
  (if (= Block nil) (setq Block 0))
  (if (= TenLayout nil) (setq TenLayout "Layout"))
  (if (= Tyle nil) (setq Tyle "1000"))
  (setq fl (vl-filename-mktemp "CLO" nil ".dcl"))
  (setq ret (open fl "w"))
  (write-line
    (strcat
      "CLO : dialog { label = \"Create Layout\";
      : column {
      : boxed_column {label = \"Page Setup\";
      : popup_list { key=\"Printer\"; label= \"Printer\";  value = \"" (itoa Printer) "\"; edit_width = 40;}
      : popup_list { key=\"PaperSize\"; label= \"Paper Size   \"; value = \"" (itoa Size) "\"; edit_width = 40;}
      : popup_list { key=\"Style\"; label= \"Style            \"; value = \"" (itoa Style) "\";edit_width = 40;}
      : edit_box {   key = \"LO_name\"; label = \"Layout Name  \"; value = \"" TenLayout "\";edit_width = 20;}
      : edit_box {   key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}}
      : button { key = \"Chonkhung\"; label = \"Select Frame \"; }
      : boxed_column {
      label = \"\";
      :row {
      : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;}
      : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}}
      : row {
      : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;}
      : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}}
      : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";}
      }
      : boxed_row {
      : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;}
      : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} "
    )
    ret
  )
  (setq ret (close ret))
)
(defun *error* (msg) (vl-file-delete fl))
(defun Chon ()
  (vl-file-delete fl)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (Make_dcl)
  (setq ddiag 3)
)
(defun TaoBlock (/ taphop pt)
  (vl-file-delete fl)
  (alert "Chon doi tuong de tao Block khung ten")
  (if (/= (setq taphop(ssget)) nil)
    (progn
      (setq pt(getpoint "\n Chon Base point cua Block: "))
      (setq ten(lisped "Nhap ten cua Block"))
      (while (/= (tblsearch "Block" ten) nil)
	(setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block")))
      (command "BLOCK" ten pt taphop "")
      (setq dsblock(cons "" (tablelist "Block")))
      ))
  (Make_dcl)
  (setq ddiag 3)
)
(defun Update ()
  (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin))
  (setq dsPaper (PaperList))
  (start_list "PaperSize" 3)
  (mapcar 'add_list dsPaper)
  (end_list)
)
(defun Chon_Xref ()
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq File(getfiled "Chon File khung ten" Path "dwg" 2))
  (if (/= File nil) (setq Path File dsFile (list File)))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun Remove_Xref ()
  (setq File "" dsFile (list File))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object))))
(defun PlotDeviceNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay)))))
(defun PaperList (/ PLObj PSL)
  (setq PLObj (vla-GetCanonicalMediaNames (ActLay)))
  (foreach i (vlax-safearray->list (vlax-variant-value PLObj))
    (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i))))))
(defun PlotStyleTableNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay)))))
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
(defun DeleteLayouts (/ layouts layout i)
  (vl-load-com)
  (setq	layouts	(vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object))))
  (if (> (vla-get-count layouts) 2)
    (vlax-for layout layouts
      (if (= (vla-get-ModelType layout) :vlax-false)
	(if (< (vla-get-count (vla-get-block layout)) 2)
	  (vla-delete layout))))))
(setq dsmayin (PlotDeviceNamesList))
(setq dsStyle (PlotStyleTableNamesList))
(setq dsblock(cons "" (tablelist "Block")))
(defun hopthoai	()
  (setq dcl_id (load_dialog fl))
  (if (not (new_dialog "CLO" dcl_id)) (exit))
  (start_list "Printer" 3)
  (mapcar 'add_list dsmayin)
  (end_list)
  (Update)
  (action_tile "Printer" "(Update)")
  (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)")
  (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)")
  (start_list "Style" 3)
  (mapcar 'add_list dsStyle)
  (end_list)
  (start_list "Block" 3)
  (mapcar 'add_list dsBlock)
  (end_list)
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  (action_tile "Select_Xref" "(Chon_Xref)")
  (action_tile "Xref_File" "(Chon_Xref)")
  (action_tile "Remove" "(Remove_Xref)")
  
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
  (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" )
  (start_dialog)
  (unload_dialog dcl_id)
)
(defun saveVars	()
  (setq Printer (atoi (get_tile "Printer")))
  (setq Size (atoi (get_tile "PaperSize")))
  (setq Style (atoi (get_tile "Style")))
  (setq Tyle (get_tile "Tyle"))
  (setq Block (atoi (get_tile "Block")))
  
  (setq Printer1 (nth Printer dsmayin))
  (setq Size1 (nth Size (PaperList)))
  (setq Style1 (nth Style dsStyle))
  (setq TenLayout (get_tile "LO_name"))
  
  (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000))
  (setq Block1 (nth Block dsBlock))
)
(defun C:CLO (/ os)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "TILEMODE" 1)
  (setq dsblock(cons "" (tablelist "Block")))
  (if (= File nil) (setq dsFile (list "")))
  (setq tieptuc 0)
  (Make_dcl)
  (setq ddiag 3)
  (while (= ddiag 3)
    (hopthoai)
    (if	(= ddiag 5) (Chon))
    (if	(= ddiag 9) (TaoBlock))
  )
  (vl-file-delete fl)
  (if (= tieptuc 1)
    (progn
      (Sapxepkhung)
      (Make_Layout)
      (DeleteLayouts)
      )
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun Sapxepkhung(/ index khung S1 S2 D1 D2)
  (setq index 0)
  (setq lst_Khung(list))
  (setq S1 0 S2 0)
  (while (< index (sslength taphop))
    (setq khung (ssname taphop index))
    (setq lst_Khung(append lst_Khung (list(list khung S1 S2))))
    (setq index (1+ index))
    )
  (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2))))))))
  )
(defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2)
  (setq disp(getenv "CreateViewports"))
  (setenv "CreateViewports" "0")
  (setq index 1)
  (foreach khung1 lst_Khung
    (setq khung (car khung1))
    (setq lst (acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0 (nth 0 lst) pt3 (nth 3 lst))
    (if	(> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1	(nth 1 lst) pt2	(nth 2 lst))
      (setq pt1	(nth 2 lst) pt2	(nth 1 lst)))
    (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index))))
    (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index))))
    (command "ERASE" "ALL" "")
    (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" ""))
    (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" ""))
    (command "ZOOM" "E")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1)))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1)))
      )
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) ""))
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "ZOOM" "E")
    (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N")
    (command "MODEL")
    (setq index (+ index 1))
  )
  (setenv "CreateViewports" disp)
  (princ)
)
(princ "\n           Type CLO to run prog

thank bạn

<<

Download lisp

Filename: 412514_clo.lsp

http://www.cadviet.com/upfiles/6/111575_cong_text.lsp

>>

http://www.cadviet.com/upfiles/6/111575_cong_text.lsp

 

+Nhờ các bác trong diễn đàn giúp em cái lisp cộng (trừ) tất cả giá trị text cho một số, rồi ghi kết quả ra luôn text cũ. Em muốn quét 1 lần tất cả các giá trị số của text rồi trừ luôn với 1 số có sẵn nhập từ vào, rồi ghi kết quả luôn trên nền text cũ.

+Trường hợp của em là do bên thi công yêu cầu điều chỉnh cao độ khảo sát, em cũng sưu tầm trên diễn đàn lisp cộng ( trừ ) text với 1 số, nhưng lisp này chỉ cộng trừ từng số 1, làm như vậy rất thủ công với trường hợp của em. Rất mong các bác giúp đỡ. em xin cảm ơn ạ. 

+ Đây là lisp cộng text của em: 

(defun c:a1()
(setvar "CMDECHO" 0)
;Lay gia tri cua text thu nhat:
(setq s (entget (car (entsel "\n Select Text number: "))))
(setq otext (assoc 1 s))
(setq ot (cdr otext))
(setq ot (read (substr ot 1)))


;Lay gia tri cua text thu hai:
(command "luprec" pre)
(if ot1 (setq ot2 (getreal (strcat "\n nhap so cong them: <" (rtos ot1) ">:")))
(setq ot1 (getreal "\nValue Add :" )))


(if ot2 (setq ot1 ot2))






(setq giatri (entget (car (entsel "\n Select Text to results: "))))
(command "luprec" "2")
(setq gia (assoc 1 giatri))
;(setq gia (rtos gia 0 0))
(setq nt1 (cons 1 (rtos (+ ot ot1) 2 2)))
(setq giatri (subst nt1 gia giatri))
(entmod giatri)
(princ)
) 

 

+Nhờ các bác trong diễn đàn giúp em cái lisp cộng (trừ) tất cả giá trị text cho một số, rồi ghi kết quả ra luôn text cũ. Em muốn quét 1 lần tất cả các giá trị số của text rồi trừ luôn với 1 số có sẵn nhập từ vào, rồi ghi kết quả luôn trên nền text cũ.

+Trường hợp của em là do bên thi công yêu cầu điều chỉnh cao độ khảo sát, em cũng sưu tầm trên diễn đàn lisp cộng ( trừ ) text với 1 số, nhưng lisp này chỉ cộng trừ từng số 1, làm như vậy rất thủ công với trường hợp của em. Rất mong các bác giúp đỡ. em xin cảm ơn ạ. 

+ Đây là lisp cộng text của em: 

(defun c:a1()
(setvar "CMDECHO" 0)
;Lay gia tri cua text thu nhat:
(setq s (entget (car (entsel "\n Select Text number: "))))
(setq otext (assoc 1 s))
(setq ot (cdr otext))
(setq ot (read (substr ot 1)))


;Lay gia tri cua text thu hai:
(command "luprec" pre)
(if ot1 (setq ot2 (getreal (strcat "\n nhap so cong them: <" (rtos ot1) ">:")))
(setq ot1 (getreal "\nValue Add :" )))


(if ot2 (setq ot1 ot2))






(setq giatri (entget (car (entsel "\n Select Text to results: "))))
(command "luprec" "2")
(setq gia (assoc 1 giatri))
;(setq gia (rtos gia 0 0))
(setq nt1 (cons 1 (rtos (+ ot ot1) 2 2)))
(setq giatri (subst nt1 gia giatri))
(entmod giatri)
(princ)
) 

27 phút trước, khongban231 đã nói:

sao mình làm mãi không được...

>>

27 phút trước, khongban231 đã nói:

sao mình làm mãi không được nhỉ? mình chạy trên nền cad 2007 với cad 2018 đều không được b Bee ? :((

Mình gửi lại, copy paste và load chạy lệnh xem được chưa nhé.! ^_^

 

(defun c:test  (/ vl-pline-centroid n pt ss ent)
  (load "extrim.lsp")
  (defun vl-pline-centroid  (pl / acdoc space obj reg cen)
    (vl-load-com)
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          space (if (= (getvar "CVPORT") 1)
                  (vla-get-paperspace acdoc)
                  (vla-get-modelspace acdoc)
                  )
          )
    (or (= (type pl) 'vla-object)
        (setq obj (vlax-ename->vla-object pl))
        )
    (setq reg (vlax-invoke space 'addregion (list obj))
          cen (vlax-get (car reg) 'centroid)
          )
    (vla-delete (car reg))
    (trans cen 1 (vlax-get obj 'normal))
    )
  (if (setq ss (ssget))
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq pt (vl-pline-centroid (ssname ss n)))

        (setq ent (entmake
                    (list '(0 . "POINT") (cons 10 pt))
                    )
              )
        (command "_.Zoom" "obj" (ssname ss n) "")
        (etrim (ssname ss n) pt)
  
        (setq n (1+ n))
        ) ;repeat
      ) ;progn
    ) ;if
  (command "zoom" "all")
  )

 

<<

Laogia : sử dụng Code này Tue_NV mới viết thử xem

(defun c:inte(/ ss p1 p2 e p)
(prompt "\n Chon cac Line :")
(setq ss (ssget '((0 . "LINE"))))
(setq p1 (getpoint "\n Chon...
>>

Laogia : sử dụng Code này Tue_NV mới viết thử xem

(defun c:inte(/ ss p1 p2 e p)
(prompt "\n Chon cac Line :")
(setq ss (ssget '((0 . "LINE"))))
(setq p1 (getpoint "\n Chon diem dau Polyline A : "))
(setq p2 (getpoint "\n Chon diem cuoi Polyline F : "))

(command "line" p1 p2 "")
(setq e (entlast))
(setq p (getpoint "\n Pick 1 diem vao mien trong da tuyen : "))
(command "boundary" "A" "O" "P" "" p "")
(entdel e)
(command "erase" ss "")
(Command "break" "L" p1 p2)
(princ)
)

cám ơn bác Tuệ nhiều. nhờ lisp này của bác mà giúp em được rất nhiều

<<

Sau này bạn vui lòng :

1- Post đúng vị trí bạn đã thấy lisp nếu yêu cầu không khác quá xa yêu cầu gốc

2- Nếu post code ra ngoài...

>>

Sau này bạn vui lòng :

1- Post đúng vị trí bạn đã thấy lisp nếu yêu cầu không khác quá xa yêu cầu gốc

2- Nếu post code ra ngoài vui lòng cho code vào thẻ code (hình <>)

 

 

(defun C:HA( / y0 y1 ent s)
(command "ucs" "w")
(setq y0 (cadr (cdr (assoc 10 (entget (car (entsel "\nChon Line de lam duong chuan: ")))))))
(or *tl* (setq *tl* 1))
(setq *tl* (cond ((getreal (strcat "\nTi le < " (rtos *tl*) "> :")))(*tl*)))
(while
  (and
   (setq y1 (cadr (getpoint "\nPick diem de lay cao do: ")) s (* *tl* (- y1 y0)))
   (not (while (not (setq ent (car (entsel "\nChon Text de sua cao do: "))))))
   (entmod (subst (cons 1 (strcat (if (> s 0.0) "+" "") (rtos s 2 2))) (assoc 1 (entget ent)) (entget ent)))))
(princ))

 

Cảm ơn anh. Nhưng a có thể xem lại dùm em sao dùng được nhưng ko thấy nó nhảy cao độ :(

<<

Điều này là đúng nhưng có rất nhiều donut thì điều này khi làm thì rất mất thời gian . Do đó nên có sự trợ giúp của Auto Lisp

Bạn 790312 sử dụng Lisp này Tue_nv Mới...

>>

Điều này là đúng nhưng có rất nhiều donut thì điều này khi làm thì rất mất thời gian . Do đó nên có sự trợ giúp của Auto Lisp

Bạn 790312 sử dụng Lisp này Tue_nv Mới viết xem sao :

(defun c:scdo()
(vl-load-com)
(setq ss (ssget '((0 . "*POLYLINE"))) i 0)
(setq tle (getdist "\n Nhap he so ti le : "))

(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ddau (vlax-curve-getStartPoint ent))
(setq diem (vlax-curve-getPointAtParam ent 2))
(setq po (list (/ (+ (car ddau) (car diem)) 2) (/ (+ (cadr ddau) (cadr diem)) 2) 0))
(command "scale" ent "" po tle)
(setq i (1+ i))
)
(princ)
)

Cảm ơn bạn nhưng khi scale lai thi tâm các đường donut lại không còn tại vị trí ban đầu.Bạn ktra lại xem có thể sửa làm sao sau khi scale tâm nó vẫn giữ nguyên.Thanks

<<

-Lisp trên chỉ thay đổi màu của layer chứa đối tượng bạn chọn chứ ko phải "hết tất cả layer về cùng một màu".

-Bạn...

>>

-Lisp trên chỉ thay đổi màu của layer chứa đối tượng bạn chọn chứ ko phải "hết tất cả layer về cùng một màu".

-Bạn muốn "những đối tượng mình chọn mới thay đổi thành màu khác" nghĩa là thay màu của đối tượng ko còn là bylayer nửa phải ko?

*Nếu vậy thì dùng này:

(defun c:dm (/ m ss)
(command "undo" "be")
 (princ "\nChon doi tuong muon doi mau:")
 (setq ss (ssget))
 (princ "\nChon mau muon doi :")(setq m (acad_colordlg 7))
(command "change" ss "" "P" "c" m "")
(command "undo" "end")
(setvar "MODEMACRO" "**KTS_DUY**")
(princ)
)

 

Tôi đã xoá các bài của kexu và thanhdatkts đề nghị tập trung vào chuyên môn.

@thanhdatkts: đề nghị chồng cho tôi 1 dấu + nếu không tôi chồng cho bạn 1 dấu trừ đấy!

bác ơi cái lisp của bác là chọn đối tượng nao thì đối tượng đó được chuyển màu chứ không đổi cả màu layer đối tượng đó với lại những đối tượng trong block thì không chuyển được ....bác xem có cai lisp nào khác không cho e xin với ...thank

<<

Chào bạn thanhduan2407,

Trong lúc bác Giabach đang bận, mình viết thử cái này để bạn dùng thử xem có đạt yêu cầu không nhé. Lisp mình viết dựa trên cái file...

>>

Chào bạn thanhduan2407,

Trong lúc bác Giabach đang bận, mình viết thử cái này để bạn dùng thử xem có đạt yêu cầu không nhé. Lisp mình viết dựa trên cái file chứa các text mẫu mà bạn đã gửi và đã tess thử trên đó thấy OK. Bạn dùng thử nếu thấy có gì chưa hợp ý hãy pót lên vì có thể mình chưa hiểu đúng ý bạn.Bạn thông cảm nhé vì mình không phải có cùng chuyên môn với bạn.

Khi lisp yêu cầu bạn nhập tên file lưu số liệu bạn nhớ nhập cái tên bạn muốn và lưu ý nó để mở lại sau này. Lisp này chỉ lưu lại các giá trị X,Y,Z chứ chưa có STT như bạn đã post.

Chúc bạn vui.

(defun c:xtxt (/ p1 p2 ss n i plist polst en els pt ss1 m j en1 els1 pt1 txtail txtint txtz
                     txtlst tmp fil pos z )
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
       p2 (getpoint p1 "\n Chon diem thu hai"))
(setq ss (ssget "w" p1 p2 '((0 . "Point")))
       n (sslength ss)
       i 0
       plist (list)
       polst (list)
)
(while (< i n)
      (setq en (ssname ss i)
              els (entget en)
              pt (cdr (assoc 10 els))
              ss1 (ssget "w" p1 p2 '((0 . "text")))
              m (sslength ss1)
              j 0
              plist (append plist (list pt))
      )
      (While (< j m)
             (setq en1 (ssname ss1 j)
                     els1 (entget en1)
                     pt1 (cdr (assoc 11 els1))
             )
             (if (and (= (cdr (assoc 72 els1)) 0) (= (cdr (assoc 73 els1)) 3) (equal pt pt1))
                (setq txtail (cdr (assoc 1 els1))))
              (if (and (= (cdr (assoc 72 els1)) 2) (= (cdr (assoc 73 els1)) 1) (equal pt pt1))
                 (progn
                       (setq txtint (cdr (assoc 1 els1)))
                       (if (= (substr txtint 1 3) "%%U")
                          (setq txtint (substr txtint 4))
                          (setq txtint (strcat "-" txtint ))
                       )
                 )
              )
             (setq j (1+ j))
       )
       (setq txtz (strcat txtint "." txtail)
               txtlst (list txtz)
               plist (append plist txtlst)
       )
       (setq polst (append polst (list plist))
                plist (list))
       (setq i (1+ i))
)
(if (setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
  (progn
        (setq fil (open tmp "w") )
        (foreach pos polst
                  (setq z (cadr pos))
                  (write-line (strcat (rtos (car (car pos))) (chr 44) (rtos (cadr (car pos))) (chr 44) z) fil)
        )
        (close fil) ))

(command "undo" "e")
(princ)
)

Dạ vâng.

Em cảm ơn bác phamthanhbinh nhiều.

Em đã thử nghiệm và cho kết quả rất chính xác. Nhưng em hỏi bác chút là tại sao ta không thực hiện quét chọn đối tượng theo cửa sổ window mà phải kích chọn hai điểm. Bác có thể chỉnh sửa lại được không ạ? Cảm ơn bác rất rất nhiều.

<<