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

790312

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    229

  • Đã tham gia

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

  • Ngày trúng

    1

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

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

    Cả 2 cách sửa trên của Tue_NV và ketxu đều can thiệp vào file Lisp, tức là phải mở file Lisp lên và sửa

    Tue_NV nghĩ rằng nên gán các giá trị mặc định cho Hatch và tiến hành Hatch theo giá trị này.

    1. Lisp của bạn ketxu Hatch các mẫu theo 1 giá trị mặc định ở trong Lisp, muốn thay đổi giá trị lại vào trong Lisp mà sửa lại. Hơi phiền nhỉ?

     

    Cách gán giá trị mặc định của Tue_NV là cách như sau

    1. Thiết lập các biến hệ thống bằng cách gõ tên biến hệ thống ở dòng Command và thiết lập giá trị cho nó.

    Trường hợp bạn không nhớ tên biến hệ thống thì bạn có thể làm như sau :

    Bật hộp thoại hatch lên bằng cách sử dụng lệnh H

    -> Thiết lập các giá trị Associate, Gap Tolerance....

    Trỏ vào Scale, Angle, thiết lập giá trị cho Hatch (làm cuối cùng)

    Thiết lập xong rồi, Không làm gì cả -> Enter kết thúc lệnh

     

    Bây giờ thì các giá trị quy định về Scale, Angle,.. của Hatch đã được thiết lập mặc định rồi đấy. Bạn có thể bật hộp thoại Hatch lên lại để kiểm tra. (hoặc xem lại giá trị của biến hệ thống quy định các giá trị của Hatch

    Bạn chỉ việc Hatch mà thôi và đương nhiên Lisp của bạn ketxu cũng sẽ được sửa lại 1 chút:

     

    (defun c:h1()	
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK[0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK] "))
	(cond
	  ((= "0" (strcase s1)) (SetHvar "ansi37" hScale hAng hAssoc hGap ))
	  ((= "WC" (strcase s1)) (SetHvar "ansi31" hScale hAng hAssoc hGap))
	  ((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1)))(SetHvar "GRASS" hScale hAng hAssoc hGap))								   
	  ((or (= "S" (strcase s1)) (= "SAND" (strcase s1)))(SetHvar "AR-CONC" hScale hAng hAssoc hGap))			
	  ((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (SetHvar "AR-CONC" hScale hAng hAssoc hGap))
	  ((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (SetHvar "AR-CONC" hScale hAng hAssoc hGap))
	  ((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (SetHvar "AR-CONC" hScale hAng hAssoc hGap))
	  ((or (= "W" (strcase s1)) (= "WALL" (strcase s1)))(SetHvar "AR-CONC" hScale hAng hAssoc hGap))
	);end cond
 	(command "-hatch")
(while (< 0 (getvar "CMDACTIVE"))	(command pause))
(acet-sysvar-restore)
);END C:
(defun SetHvar ( hName hScale hAng hAssoc hGap) ;hLayer)
(acet-sysvar-set (list "hpname" hname "hpscale" hScale "hpang" hAng "hpassoc" hAssoc "hpgaptol" hgap "clayer" "00-08Hatch" "HPSEPARATE" 1))
)

     

    Như vậy các biến hệ thống có thể được thiết lập mặc định thông qua hộp thoại Hatch.

    Sử dụng Lisp trên sẽ Hatch theo giá trị được thiết lập mặc định thông qua hộp thoại Hatch

    Các Bạn thử xem nhé.

    Bác nhắc giùm e 1 vài tên của biến hệ thông với.Thanks.

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

    Bạn edit cho phù hợp nhu cầu nhé. Nhớ là trong bản vẽ phải có layer 00-08Hatch rồi đó, vì mình k để code tạo layer vào

    (defun c:h1()	
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK[0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK] "))
	(cond
	  ((= "0" (strcase s1)) (SetHvar "ansi37" 1 0 1 20 ))
	  ((= "WC" (strcase s1)) (SetHvar "ansi31" 1 0 1 20))
	  ((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1)))(SetHvar "GRASS" 1 0 1 20))								   
	  ((or (= "S" (strcase s1)) (= "SAND" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))			
	  ((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (SetHvar "AR-CONC" 1 0 1 20))
	  ((or (= "W" (strcase s1)) (= "WALL" (strcase s1)))(SetHvar "AR-CONC" 1 0 1 20))
	);end cond
 	(command "-hatch")
(while (< 0 (getvar "CMDACTIVE"))	(command pause))
(acet-sysvar-restore)
);END C:
(defun SetHvar ( hName hScale hAng hAssoc hGap) ;hLayer)
(acet-sysvar-set (list "hpname" hname "hpscale" hScale "hpang" hAng "hpassoc" hAssoc "hpgaptol" hgap "clayer" "00-08Hatch" "HPSEPARATE" 1))
)

    Bạn có thể thêm vào chức năng cho SCALE mặc định là 50 được không?Thanks

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

    Mình nghĩ vấn đề không phải do ai khóa cả.Bạn thử copy 1 đường Line thôi xem có được không? Tạm thời mình chỉ nghĩ phần bạn copy quá khổ của Memory thơi, chưa nghĩ ra tại sao ^^

    Cho mình hỏi thêm là vấn đề này chỉ xảy ra với 1 bản vẽ đó hay tất cả? bạn test kỹ càng chưa?

    Nó chỉ xảy ra với bản vẽ đó thôi.mình đã thử với 1 đường line độc lập cũng báo lỗi như vậy.Mình gửi file đính kèm nhờ bạn xem hộ.Thanks.

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

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

    1.Để người khác bắt bệnh, bạn nên chụp lại hiện trường để người ta khám chứ :D Bạn thao tác lại,đến lúc gặp lỗi thì ấn F2 để bật màn hình command lên, rồi chụp lại thông báo post lên diễn đàn

    2.Đành xem qua code,mình dùng vẫn bình thường, chỉ khấp khiểng chỗ lệnh bhatch thôi,n vẫn k sao cả :D Bạn thử lại cái này xem sao.Cái này là chữa kiểu mù mờ này ^^

    (defun c:Is ()
(setq h (getreal "\n Nhap chieu cao mat cat : ")
b (getreal "\n Nhap chieu rong mat cat : ")
d (getreal "\n Nhap chieu day ban canh : ")
db (getreal "\n Nhap chieu day ban bung : ")
p0 (getpoint "\n Nhap diem khoi tao"))
(command "rectang" p0 (list (+ b (car p0)) (- (cadr p0) d)))
(setq a0 (entlast))
(command "rectang" (list (car p0) (- (cadr p0) h)) (list (+ (car p0) b ) (- (cadr p0) (- h d))))
(setq a1 (entlast))
(setq p1 (list (+ (car p0) (/ (- b db) 2)) (- (cadr p0) d))
p2 (polar p1 0 db)
p3 (polar p1 (- (/ pi 2)) (- h d d))
p4 (polar p3 0 db))
(command "pline" p1 p3 "")
(setq a2 (entlast))
(command "pline" p2 p4 "")
(setq a3 (entlast))
(command "break" a0 p1 p2)
(command "break" a1 p3 p4)
(command "bhatch" "s" a0 a1 a2 a3 "" "p" "ansi31" 50 0 "")
(princ)
)

    Khi thực hiện xong nhấn F2 thì nó không báo lỗi,nhưng khi vẽ bản bụng nó chỉ vẽ 1 đường thẳng.E gửi file đính kèm mong bác xem giúp e

    http://www.cadviet.com/upfiles/3/drawing1_7.rar

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

    E thấy trên diễn đàn có 1 lisp vẽ thép hình I,khi vẽ lần đầu thì rất tốt nhưng khi vẽ lần 2 thì bị lỗi.Mong các bác xem và sửa lại giùm.Thanks.

    (defun c:Is ()
(setq h (getreal "\n Nhap chieu cao mat cat : ")
b (getreal "\n Nhap chieu rong mat cat : ")
d (getreal "\n Nhap chieu day ban canh : ")
db (getreal "\n Nhap chieu day ban bung : ")
p0 (getpoint "\n Nhap diem khoi tao"))
(command "rectang" p0 (list (+ b (car p0)) (- (cadr p0) d)))
(setq a0 (entlast))
(command "rectang" (list (car p0) (- (cadr p0) h)) (list (+ (car p0) b ) (- (cadr p0) (- h d))))
(setq a1 (entlast))
(setq p1 (list (+ (car p0) (/ (- b db) 2)) (- (cadr p0) d))
p2 (polar p1 0 db)
p3 (polar p1 (- (/ pi 2)) (- h d d))
p4 (polar p3 0 db))
(command "pline" p1 p3 "")
(setq a2 (entlast))
(command "pline" p2 p4 "")
(setq a3 (entlast))
(command "break" a0 p1 p2)
(command "break" a1 p3 p4)
(command "bhatch" "s" a0 a1 a2 a3 "" "p" "ansi31" 50 0 "" "")
(princ)
)

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

    Bác Tue_nv có viết 1 lisp vẽ thép dưới sàn rất tiện mong các bác thêm giùm e dòng lệnh trước câu " đường kính móc tròn" một lựa chọn: "Có móc hay không móc" nếu Có thì "câu đường kính móc tròn" nếu Không thì hỏi "chiều dài đoạn xéo" khi nhập rồi sẽ vẽ nhưng đoạn đầu không phải móc mà cắt thép gồm 1 đoạn thẳng có chiều dài nhập vào và xéo 1 góc 30độ.Mong các bác sửa giúp.

    (DEFUN C:SD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
			PTD PTC)
(SETQ OLDERR *error*
  *error* myerror)
(command "layer" "m" "thep" "c" "6" """")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
(PROGN
 (SETQ STR "1")
 (SETVAR "USERR3" 100)
)	
(SETQ STR (RTOS DK))
)
(SETQ PRPT (STRCAT "Duong kinh moc tron <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
(SETQ DK (GETVAR "USERR3"))
(SETVAR "USERR3" DK)
)
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(SETQ PT1 (POLAR PTD GOCX (/ (* 100 DK) 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ (* 100 DK) 2)))
(SETQ PT3 (POLAR PT1 GOCY (* 100 DK)))
(SETQ PT4 (POLAR PT2 GOCY (* 100 DK)))
(SETQ PT5 (POLAR PT3 GOCX (* 100 DK)))
(SETQ PT6 (POLAR PT4 (+ GOCX PI) (* 100 DK)))
(COMMAND "PLINE" PT5 PT3 "A" PT1 "L" PT2 "A" PT4 "L" PT6 "")
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

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

    Hề hề hề, cái này có nhẽ là do cái block có sẵn của bạn có điểm gốc insert không đúng như cái block của bác ấy tạo ra. Bạn chỉ cần xem kỹ cái block ấy và hiệu chỉnh lại cái điểm chèn trong líp là OK mà.

    Hề hề hề.

    Việc chỉnh lísp cho bạn không khó, nhưng không biết bạn có bao nhiêu cái block sẵn có ấy mà hiệu chỉnh cho vừa bạn ạ. Được với anh cu này ắt lại chệch với anh cu khác, chúng nó kiện nhau thì bỏ u. Cách tốt nhất là bạn hãy chịu khó tìm hiểu một chút về cái lisp của bác ấy để có thể tùy chỉnh theo ý bạn là tốt nhất. Chấp luôn cả mấy anh bạn trái khoáy như vầy.

    Hề hề hề....

    Bác có thể chỉ cho e biết 2 block này khác nhau điểm nào với.Nếu được bác sửa giùm e đoạn lisp cho nó trùng với block có sẵn giùm e.E chân thành cảm ơn trước.

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

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

    Mình sửa và bổ xung cho bạn rồi này. Chúc bạn như ý.

    ;; free lisp from cadviet.com

(DEFUN C:gct ()
(SETQ DK1 (GETVAR "USERR3"))
(IF (= DK1 0)
    (PROGN
     (SETQ STR "1")
     (SETVAR "USERR3" 1)
    )    
    (SETQ STR (RTOS DK1))
)
(SETQ PRPT (STRCAT "\nSize <" STR ">:"))
(SETQ DK1 (GETREAL PRPT))
(IF (= DK1 NIL)
    (SETQ DK1 (GETVAR "USERR3"))
    (SETVAR "USERR3" DK1)
)
(setq dk (* DK1 50))
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(setq v (rtos dk))
(setq t (distance ptd ptc))
(setq r (/ t 2))
(SETQ PT1 (POLAR  PTc  0   (* 33 DK)))
(SETQ o (POLAR  PT1  0   (* 5.2 DK)))
(setq h (substr v 1 1))
(setq y (substr v 2 3))
(setq l (distance ptc pt1))
(setq pt3 (polar ptc 0 (/ l 1.85)))
(setq pt4 (polar pt3 (/ pi 2) (* 4 DK)))
(setq pt5 (polar ptd (- gocx (/ pi 2)) r))
(setq pt6 (polar ptd (+ gocx (/ pi 2)) r))
(setq pt7 (polar ptd (+ gocx  pi) r))
(setq pt8 (polar ptd  gocx   100))
(command "osnap"  "")
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "84" "")
(COMMAND "STYLE" "T_THEP"  "romans.shx,vn1.shx" "" "" "" "" "" "" )
(command "text" "j" "m" pt4 (* 5 DK) 0)
(command "%%c10a150" )
(setq sua (entlast))
(if (= (tblsearch "block" "ghithep_t") nil)
(progn
(COMMAND "STYLE" "VnAvant"  ".VnAvant" "" "" "" "" "")
(command "attdef" "" 1 1 1 "j" "m" o (* 5 50) 0)
(setq ss (ssadd))
(setq ss (ssadd (entlast) ss))
(COMMAND "COLOR" "4" "")
(command "circle" o (* 5.2 50)"")
(setq ss (ssadd (entlast) ss))
(command "block" "ghithep_t" o ss "")
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(initget 1 "TR T C")
(setq w (getkword "\nBan muon dung: [TRong/duong Tron/duong Cheo]: "))
(if (= (strcase w) "T") 
(progn
(COMMAND "COLOR" "150" "")
(setvar "plinewid" 0)
(COMMAND "PLINE" pt8 ptc pt1 "")
(command "circle" ptd 100 "")
)
)
(if (= (strcase w) "C")
(progn
(COMMAND "COLOR" "150" "")
(setvar "plinewid" 0)
(COMMAND "PLINE" PTD ptc pt1 "")
(setq pg1 (polar PTD (- pi (/ pi 4)) 100))
(setq pg2 (polar PTD (- (* pi 2) (/ pi 4)) 100))
(setvar "plinewid" 20)
(command "pline" pg1 pg2 "")
)
)
(if (= (strcase w) "TR")
(progn
(COMMAND "COLOR" "150" "")
(setvar "plinewid" 0)
(COMMAND "PLINE" PTD ptc pt1 "")
)
)
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par"  )
(command "ddedit" sua pause)
)

    Bác cho e hỏi nếu 1 bản vẽ chưa có block GHITHEP_T thì lisp thực hiện rất tốt nhưng nếu trong bản vẽ có block GHITHEP_T rồi thì khi vẽ block GHITHEP_T sẽ

    không nằm đúng vị trí cuối của đường polyline.Mong bác xem lại giúp.Thanks.

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

    Của bạn đây:

    (DEFUN C:gct ()
(SETQ DK1 (GETVAR "USERR3"))
(IF (= DK1 0)
    (PROGN
     (SETQ STR "1")
     (SETVAR "USERR3" 1)
    )    
    (SETQ STR (RTOS DK1))
)
(SETQ PRPT (STRCAT "\nSize <" STR ">:"))
(SETQ DK1 (GETREAL PRPT))
(IF (= DK1 NIL)
    (SETQ DK1 (GETVAR "USERR3"))
    (SETVAR "USERR3" DK1)
)
(setq dk (* DK1 50))
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(setq v (rtos dk))
(setq t (distance ptd ptc))
(setq r (/ t 2))
(SETQ PT1 (POLAR  PTc  0   (* 33 DK)))
(SETQ o (POLAR  PT1  0   (* 5.2 DK)))
(setq h (substr v 1 1))
(setq y (substr v 2 3))
(setq l (distance ptc pt1))
(setq pt3 (polar ptc 0 (/ l 1.85)))
(setq pt4 (polar pt3 (/ pi 2) (* 4 DK)))
(setq pt5 (polar ptd (- gocx (/ pi 2)) r))
(setq pt6 (polar ptd (+ gocx (/ pi 2)) r))
(setq pt7 (polar ptd (+ gocx  pi) r))
(setq pt8 (polar ptd  gocx   100))
(command "osnap"  "")
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "84" "")
(COMMAND "STYLE" "T_THEP"  "romans.shx,vn1.shx" "" "" "" "" "" "" )
(command "text" "j" "m" pt4 (* 5 DK) 0)
(command "%%c10a150" )
 (setq sua (entlast))
(if (= (tblsearch "block" "ghithep_t") nil)
(progn
(COMMAND "STYLE" "VnAvant"  ".VnAvant" "" "" "" "" "")
(command "attdef" "" 1 1 1 "j" "m" o (* 5 50) 0)
(setq ss (ssadd))
(setq ss (ssadd (entlast) ss))
(COMMAND "COLOR" "4" "")
(command "circle" o (* 5.2 50)"")
(setq ss (ssadd (entlast) ss))
(command "block" "ghithep_t" o ss "")
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(initget 1 "T G")
(setq w (getkword "\nBan muon dung: [hinh Tron/Gach cheo]: "))
(if (= (strcase w) "T") 
(progn
(COMMAND "COLOR" "150" "")
(COMMAND "PLINE" pt8 ptc pt1 "")
(command "circle" ptd 100 "")
)
(progn
(COMMAND "COLOR" "150" "")
(COMMAND "PLINE" PTD "w" 0 0 ptc pt1 "")
(setq pg1 (polar PTD (- pi (/ pi 4)) 100))
(setq pg2 (polar PTD (- (* pi 2) (/ pi 4)) 100))
(command "pline" pg1 "w" 20 20 pg2 "")
)
)
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par"  )
(command "ddedit" sua pause)
)

    Chân thành cảm ơn bạn nhưng lisp vẫn còn lỗi,nếu đầu tiên mình vẽ chọn hình tròn,xong mình vẽ tiếp chọn đường xéo thì ok nhưng tiếp vẽ nữa chọ đường tròn thì đoạn polyline sẽ có độ dày 20.Mong bạn kiểm tra lại giùm mình tiện thể bạn thêm giùm mình 1 lựac chọn nửa là TRỐNG nếu lựa chọn này thì ngay đầu polyline sẽ không có chấm tròn và đưòng xéo.Lúc này sẽ có 3 lựa chọn TRỐNG,ĐƯỜNG TRÒN,ĐƯỜNG XÉO.

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

    Chào bạn hugo75!

    Xin lỗi bạn tại mình chưa test thử nhiều lần nên mới bị vậy. Mình sửa cho bạn đây. Bạn muốn cái đường tròn liền với cái pline thì quả thực rất khó. Có lẽ chỉ có thể dùng qleader để mình nghiên cứu tiếp cho bạn. trong khi chờ đợi bạn dùng tạm cái này mình đã sửa lỗi trên rồi.

    ;; free lisp from cadviet.com

;; free lisp from cadviet.com

(DEFUN C:gct ()
(SETQ DK1 (GETVAR "USERR3"))
(IF (= DK1 0)
    (PROGN
     (SETQ STR "1")
     (SETVAR "USERR3" 1)
    )    
    (SETQ STR (RTOS DK1))
)
(SETQ PRPT (STRCAT "\nSize <" STR ">:"))
(SETQ DK1 (GETREAL PRPT))
(IF (= DK1 NIL)
    (SETQ DK1 (GETVAR "USERR3"))
    (SETVAR "USERR3" DK1)
)
(setq dk (* DK1 50))
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(setq v (rtos dk))
(setq t (distance ptd ptc))
(setq r (/ t 2))
(SETQ PT1 (POLAR  PTc  0   (* 33 DK)))
(SETQ o (POLAR  PT1  0   (* 5.2 DK)))
(setq h (substr v 1 1))
(setq y (substr v 2 3))
(setq l (distance ptc pt1))
(setq pt3 (polar ptc 0 (/ l 1.85)))
(setq pt4 (polar pt3 (/ pi 2) (* 4 DK)))
(setq pt5 (polar ptd (- gocx (/ pi 2)) r))
(setq pt6 (polar ptd (+ gocx (/ pi 2)) r))
(setq pt7 (polar ptd (+ gocx  pi) r))
(setq pt8 (polar ptd  gocx   100))
(command "osnap"  "")
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "84" "")
(COMMAND "STYLE" "T_THEP"  "romans.shx,vn1.shx" "" "" "" "" "" "" )
(command "text" "j" "m" pt4 (* 5 DK) 0)
(command "%%c10a150" )
 (setq sua (entlast))
(if (= (tblsearch "block" "ghithep_t") nil)
(progn
(COMMAND "STYLE" "VnAvant"  ".VnAvant" "" "" "" "" "")
(command "attdef" "" 1 1 1 "j" "m" o (* 5 50) 0)
(setq ss (ssadd))
(setq ss (ssadd (entlast) ss))
(COMMAND "COLOR" "4" "")
(command "circle" o (* 5.2 50)"")
(setq ss (ssadd (entlast) ss))
(command "block" "ghithep_t" o ss "")
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(command "insert" "ghithep_t" o DK1 DK1 "" "1")
)
(COMMAND "COLOR" "150" "")
(COMMAND "PLINE" pt8 ptc pt1 "")
(command "circle" ptd 100 "")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par"  )
(command "ddedit" sua pause)
)

    Chào bác Tú,lisp này bác có thể thêm dòng chọn đường tròn hay đường xiên không?Đường xiên nghêng 1 góc 45 độ và dài 200.Thanks.

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

    Muốn có layer như của bạn sửa như sau:

    (if (= (tblsearch "layer" "thep") nil) (command "layer" "n" "thep" "lw" "0.5" "thep" "c" "1" "thep" "L" "Continuous" ""))

    Mình làm giống như bạn nhưng nó báo như sau:

    Enter an option

    [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Fre

    eze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: *Cancel*

    Mong bạn chỉ giúp.Thanks.

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

    Trong khi chờ mình tim cái mặt cắt dọc dầm bạn dùng thừ cái Mặt cắt sàn này nhé.

    ;VE MAT CAT SAN
(defun c:Mcs (/ A1 A2 A3 A4 A5 A6 A7 AA AA1 AM4 B2 B3 B4 B5 B6 B66 B67 B7 BB
BB11 BB12 BX BX1 C1 C2 C3 C4 C5 C6 CC CL1 DD1 DDAM DDT DY DY1 G1
G10 G11 G12 G2 G7 G8 G9 GG7 GG8 J1 J10 J11 J12 J13 J14 J2 J3 J4
J5 J6 J7 J8 J9 JJ1 JJ2 K12 K19 KC KC1 LX LX1 LXY1 LY LY1 MM MM1
MM2 N10 N11 N12 N13 N14 N15 N16 N17 N18 N19 N7 N8 N9 NBC OD OU OV
P1 P10 P67 P9 Q1 Q2 Q3 TDD TDD1 TIEP TONG TT1 TTR1 TTR2 TTR3 U1 U2 U3 V1 XG YG)
(taolayer)
(SETQ NBC (GETVAR "CLAYER"))
(setvar "osmode" 1)
(setq tiep "C")
(setq tong 0)
(setq ddam 350)
(setq dy1 (getreal (strcat "Chieu cao dam < " (itoa ddam) " >: ")))
(if (null dy1) (setq dy1 ddam))
(setq ou 20)
(setq od 100)
(setq ov 200)
(initget 6)
(setq kc1 (getreal (strcat "\nkhoang bao ve (mm) <" (itoa ou) ">: ")))
(if (null kc1) (setq kc1 ou))
(setq dy (* dy1 5))
(setq kc (* kc1 4))
(while (= tiep "C")
(setvar "cmdecho" 0)
(setvar "osmode" 15359)
(setq BB (getpoint "Diem chen :"))
(setvar "osmode" 0)
(setq xg (car BB))
(setq yg (cadr BB))
(initget 6)
(setq Ly1 (getreal (strcat "\nChieu day ban (mm) <" (itoa od) ">: ")))
(if (null Ly1) (setq Ly1 od)) 
(setq Lxy1 (getreal "Chieu dai nhip(m) :"))
(setq Lx1 (* Lxy1 1000))
(setq Bx1 (getreal "Chieu dai thep am (mm):"))
(setq tdd1 (getreal (strcat "\nKhoang cach cac thanh thep (mm) <" (itoa ov) ">: ")))
(if (null tdd1) (setq tdd1 ov)) 
(SETQ TTR1 200)
(setq TTR2 (RTOS TTR1 2 0))
(setq Tt1 (RTOS TDD1 2 0))
(setq dd1 (STRCAT "a"TT1""))
(setq ddT (STRCAT "a"TTR2""))
(setq Lx (* Lx1 4))
(setq tong (+ tong Lx)) 
(setq Ly (* Ly1 5))
(setq Bx (* Bx1 4))
(setq tdd (* tdd1 4))
(setq TTR3 (* TTR1 4))
(setq B2 (list xg (+ yg Ly)))
(setq B3 (list xg (+ (- yg dy) Ly)))
(setq B4 (polar B3 0 880))
(setq B5 (polar BB 0 880))
(setq B6 (polar BB 0 Lx))
(setq B66 (polar B6 (* Pi 1.5) (- dy Ly)))
(setq B67 (polar B66 0 440))
(setq B7 (polar B2 0 (+ Lx 440)))
(setq p1 (/ Bx TTR3))
(setq g1 (fix p1))
(setq g2 (- g1 1))
(setq v1 (/ (- Lx 880) tdd))
(setq u1 (fix v1))
(setq u2 (+ u1 1))
(setq u3 (- (/ (- Lx (* u1 tdd)) 2) 440)) 
(setq A1 (list (+ xg 440) (+ yg kc)))
(setq A2 (list (+ xg 440) (- (cadr B2) kc)))
(setq A3 (polar A2 0 Bx))
(setq A4 (polar A1 0 Bx))
(setq Am4 (polar A4 (* Pi 1.5) kc))
(setq A5 (list (- (car A3) 50) (- (cadr A3) 50)))
(setq J5 A5)
(setq A7 (list (+ (+ (car A1) 440) u3) (+ (cadr A1) 50)))
(setq N7 (polar A7 0 tdd))
(setq N8 (polar N7 0 tdd))
(setq N9 (list (+ (car N7) (* 0.5 tdd)) (- (cadr n7) (+ 900 (* 1.5 KC)))))
(setq N10 (polar N9 0 900))
(setq N11 (polar N10 0 250))
(setq N12 (list (+ (car N9) 450) (+ (cadr N9) 220)))
(setq K12 (polar N12 (* Pi 1.5) 440))
(setq N13 (list (+ (car a7) (* tdd 6.5)) (cadr a1)))
(setq N14 (polar N13 (* Pi 1.25) kc))
(setq N15 (polar N13 (* Pi 0.25) kc))
(setq N16 (polar N13 (* Pi 1.5) (+ 900 kc)))
(setq N17 (polar N16 0 900))
(setq N18 (polar N17 0 250))
(setq N19 (list (+ (car N16) 450) (+ (cadr N16) 220)))
(setq K19 (polar N19 (* Pi 1.5) 440))
(command "osmode" 0 "")
(setvar "CLAYER" "8")
(command ".line" N7 N9 N8 "")
(command ".line" N10 N9 "")
(command ".line" N14 N15 "")
(command ".line" N13 N16 N17 "")
(setvar "CLAYER" "3")
(command ".text" "mc" N12 "250" "0" "/G10" "")
(command ".text" "mc" N19 "250" "0" "/g10" "")
(command ".text" "mc" K12 "250" "0" DD1 "")
(command ".text" "mc" K19 "250" "0" DD1 "")
(setq A6 (polar A1 0 Lx))
(setq AA1 (polar A3 (* 1.5 Pi) Ly))
(setq AA (polar A2 (* 0.5 Pi) 1500))
(setq C1 (polar B3 0 440))
(setq C3 (polar C1 0 Lx))
(setq C5 (polar C1 (* 1.5 Pi) 800))
(setq C2 (polar C5 0 (/ Lx 2)))
(setq C6 (polar C5 (* 1.5 Pi) 100))
(setq C4 (polar C6 (* 1.5 Pi) 350))
(setq CC (polar C2 (* 0.5 Pi) 250))
(command "osmode" 0 "")
(setvar "CLAYER" "3")
(command "donut" "0" kc A5 A7"")
(repeat g2
(setq A5 (polar A5 Pi TTR3))
(command "donut" "0" kc A5 "")
)
(setq mm (ssget "W" A2 AA1))
(setq J6 (polar J5 Pi TTR3))
(setq J4 (polar A3 Pi (* TTR3 1.5)))
(setq jj1 (polar j4 (* Pi 1.25) kc))
(setq jj2 (polar j4 (* Pi 0.25) kc))
(setvar "CLAYER" "8")
(command ".line" JJ1 JJ2 "")
(setq J7 (polar J6 0 (* TTR3 0.5)))
(setq J8 (polar J7 (* 0.5 Pi) 800))
(setq J3 (polar J4 (* 0.5 Pi) 800))
(setq J2 (polar J3 Pi 900))
(setq J9 (polar J8 0 900))
(setq J10 (polar J9 0 250))
(setq J1 (polar J2 Pi 250))
(command ".line" J5 J8 J6 "")
(command ".line" J8 J9 "")
(command ".line" J4 J3 J2 "")
(command ".circle" J1 "d" 500)
(setq cl1 (entlast))
(setq J11 (list (+ (car J2) 450) (+ (cadr J2) 220)))
(setq J12 (polar J11 (* Pi 1.5) 440))
(setq J13 (list (+ (car J8) 450) (+ (cadr J8) 220)))
(setq J14 (polar J13 (* Pi 1.5) 440))
(setvar "CLAYER" "3") 
(command ".text" "mc" J11 "250" "0" "/G10" "")
(command ".text" "mc" J13 "250" "0" "%%c6" "")
(command ".text" "mc" J12 "250" "0" DDT "")
(command ".text" "mc" J14 "250" "0" "a200" "")
(command "-ATTDEF" "" "+" "1" "1" "j" "mc" J1 "250" "")
(if (= (tblsearch "block" "ghithep") nil)
(command "block" "ghithep" J1 (entlast) cl1 "")
)
(if (/= (tblsearch "block" "ghithep") nil)
(command "block" "ghithep" "y" J1 (entlast) cl1 "")
)
(repeat u1
(setq A7 (polar A7 0 tdd))
(command "donut" "0" kc A7 "")
)
(setvar "CLAYER" "7")
(command ".line" BB B3 B4 B5 B6 "")
(command ".line" B2 B7 "")
(command ".line" B6 B66 B67 "")
(command ".line" C5 C6 "")
(setvar "CLAYER" "4")
(command ".pline" A2 A3 Am4 "")
(setq mm1 (ssget "L")) 
(command ".line" A1 A6 "")
(setvar "CLAYER" "100")
(command ".DIMLINEAR" C1 C3 C2)
(setq BB11 (polar BB (* 1 Pi) 500))
(setq BB12 (polar BB11 (* 1 Pi) 700)) 
(setvar "CLAYER" "20")
(command ".DIMLINEAR" BB B2 BB11)
(command ".DIMLINEAR" B3 B2 BB12)
(setvar "CLAYER" "100")
(command ".DIMLINEAR" A2 A3 AA)
(setq mm2 (ssget "L"))
(chenblock N11 1 1)
(chenblock N18 1 1)
(chenblock J1 "1" "1")
(chenblock J10 "1" "1")
(chenblock C4 "1.4" "1.4")
(command ".select" mm mm1 mm2 "")
(command ".mirror" "p" "" C2 CC "")
(initget 1 "C K")
(setq tiep (strcase (getkword "Lam tiep cau kien khac [1©/2(K)] :")))
)
(setq g7 (polar B67 (* Pi 0) 440))
(setq g8 (polar g7 (* Pi 0.5) dy))
(setq g9 (polar g8 (* Pi 1) 440))
(setq g10 (polar g9 (* Pi 1.5) kc))
(setq j10 (polar g9 (* Pi 1.5) (- Ly kc)))
(setq g11 (polar g10 (* Pi 0) 360))
(setq g12 (polar g11 (* Pi 1.5) (- Ly kc)))
(setq p67 (polar b67 (* 1.5 Pi) 800))
(setq p9 (polar p67 (* 1.5 Pi) 100))
(setq p10 (polar p9 (* 1.5 Pi) 350))
(setq j11 (polar j10 0 300))
(setq j12 (polar j11 (* 0.5 Pi) 100))
(setq j13 (polar j12 Pi 90))
(chenblock p10 "1.4" "1.4")
(setvar "CLAYER" "4")
(command "pline" j13 j12 "a" "a" -180 j11 "l" j10 "")
(setq Q1 (ssget "L")) 
(command "pline" g10 g11 g12 "")
(setq Q2 (ssget "L")) 
(setvar "CLAYER" "7")
(command ".line" B67 g7 "")
(command ".line" g8 g9 "")
(command ".line" g8 g7 "")
(setq gG7 (polar G7 Pi (/ (+ tong 880) 2)))
(setq gG8 (polar G8 Pi (/ (+ tong 880) 2)))
(setq Q3 (ssget "L")) 
(command ".line" p9 p67 "")
(command ".select" Q1 Q2 Q3 "")
(command ".mirror" "p" "" GG7 GG8 "")
(setvar "osmode" 691)
(SETVAR "CLAYER" NBC)
)
(defun taolayer ()
(if (= (tblsearch "layer" "3") nil) (command "layer" "n" "3" ""))
(if (= (tblsearch "layer" "4") nil) (command "layer" "n" "4" ""))
(if (= (tblsearch "layer" "7") nil) (command "layer" "n" "7" ""))
(if (= (tblsearch "layer" "8") nil) (command "layer" "n" "8" ""))
(if (= (tblsearch "layer" "20") nil) (command "layer" "n" "20" ""))
(if (= (tblsearch "layer" "100") nil) (command "layer" "n" "100" ""))
)
(defun chenblock ( dcb x y /)
(command "-insert" "ghithep" dcb x y "" "")
)

    Bạn có thể chỉ giùm mình đoạn nào trong code này để vẽ ký hiệu trục là vòng tròn lớn trong lisp này không?Cảm ơn bạn trước.

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

    http://www.cadviet.com/upfiles/2/udt.lsp

    Đây là lisp của bác Tue viết,lúc xuất ra kết quả thì yêu cầu chọn text để cho ra kết quả,mình thì muốn hiện ra bảng(bảng như thế nào cũng được) kết quả diện tích của từng pick chọn(hoặc đối tượng chọn) và chu vi của vùng pick chọn (hoặc đối tượng chọn)thôi.Xin lỗi vì diễn đạt không hết ý và cảm ơn sự góp ý của bạn.Thanks

    • Vote tăng 1

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

    Lisp này Tue_NV đã hoàn thành lại theo ý bạn PhuongAnh.

    Có 2 lựa chọn cho bạn tính diện tích

    1. Tính diện tích theo cách chọn đối tượng

    2. Tính diện tích theo cách Pick điểm vào miền kín

    Các bạn test lại xem nhé :

     

    Command: udt : gõ lệnh udt

    Kich thuoc cua chuong trinh tinh theo don vi mm

    Nhap ti le chuyen doi don vi <0.001> :1/1000

     

    Nhap So chu so thap phan <4> :2

     

    Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem

    Select objects: -> Nếu ở dòng này bạn chọn đối tượng -> sẽ Tính diện tích theo cách chọn đối tượng

    -> Nếu ở dòng này bạn nhấn Enter -> sẽ Tính diện tích theo cách Pick điểm vào miền kín

     

    Code đây : http://www.cadviet.com/upfiles/2/udt.lsp

    Lisp này rất hay,nhờ bác Tue sửa giùm bỏ chức năng chọn text kết quả mà nó sẽ tự hiện lên bảng kết quả diện tích và có luôn chu vi.Chân thành cảm ơn bác trước.

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

    Bạn dùng thử lisp này. Ssg đã post lên diễn đàn lâu lắm rồi. Riêng phần Att mới bổ sung theo gợi ý của bạn:

     

    ;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh OCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************
;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point : "))
   (wtxt cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(princ)
)
;;;============================
(defun C:OCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
   e0 (car (entsel "\nSelect attribute block:"))
   e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
   (command "copy" e0 "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entnext (entlast)))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)
   (command "regen")
)
(princ)
)
;;;============================

    Sao khi mình sử dụng lệnh OD thì đôi khi bị báo lỗi :Base point : ; error: too few arguments Mong bạn xe lại giúp.Thanks

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

    Cảm ơn bạn đã phát hiện ra lỗi này. Tue_NV đã nhầm trong quá trình tính toán.

    Xin gửi lại bạn Lisp offset liên tục về 1 bên, offset liên tục về 2 bên hoàn chỉnh

    .....

    Sao sau khi nhập số lần offset thì lisp báp lỗi :; error: bad argument type: numberp: nil.Mong bác xem lại giúp.Thanks

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

    Của bạn đây dùng với text hoặc mtext lệnh là tdt. Dùng với block ATT lệnh là tdb

    ;; free lisp from cadviet.com

(defun c:tdt ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(if (= tp "t")
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
(if (= tp "p")
(entmod (subst (cons 1 (strcat txt sym)) (assoc 1 (entget n)) (entget n)))
)
)
)

(defun c:tdb ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "INSERT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq name (nth i sslist))
(if (= (cdr (assoc 66 (entget name))) 1)
(progn
(setq ent (entget (entnext name)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(entupd name)
)
(alert "doi tuong duoc chon khong phai la block attribute")
)
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addb sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addb (ssb sym /)
(setq ssb (acet-list-to-ss ssb))
(setq j 0)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(while (< j (sslength ssb))
(setq ent (entget (ssname ssb j))
att (cdr (assoc 66 ent)))
(setq ent1 (entget (entnext (ssname ssb j))))
(setq txt (cdr (assoc 1 ent1)))
(if (= tp "t")
(progn
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(if (= tp "p")
(progn
(entmod (subst (cons 1 (strcat txt sym )) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(setq j (1+ j))
)
)

    Rất cảm ơn bạn.Nhưng nhờ bạn sửa lại giúp:Mình chỉ cần nó chèn vào text và text bloc ATT thôi còn giá trị của text và text block ATT vẫn giữ nguyên,không tăng theo cấp số cộng.

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

    Của bạn đây. Mình làm theo đúng nội dung trong file bạn gửi lên.

    (defun c:tdt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No:  : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
)

    Bạn có thể thêm lựa chọn cho chọn vào trước hay sau của text và thêm vào text block thuộc tính luôn được khôn?Cảm ơn bạn trước.

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

    Chào bạn 843824,

    Bạn dùng thử cái này xem đúng ý chưa nhé. Nếu chưa thì hãy post lên để mình xem lại.

    Trước khi dùng lisp, bạn phải tạo các text như bạn đã mô tả. Lisp sẽ tự động sắp xếp lại các text của bạn theo thứ tự tăng hay giảm dần của tọa độ x của điểm đặt text. Bạn sẽ phải lựa chon chiều đặt các text theo tọa độ x này khi lisp hỏi bằng các nhập vào bàn phím các ký tự P hay T bạn nhé.

    Lisp đây:

    (defun c:cgxt ( )
(setq sst (ssget (list (cons 0 "TEXT")))
       n (sslength sst)
       i 0
       enlst (list)
       plst (list)
)
(while (< i n)
(setq en (ssname sst i)
       enlst (append enlst (list en))
)
(setq i (1+ i))
)
(setq enlst (vl-sort enlst '(lambda (e1 e2)
                                  (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))  )
                                  )
                )
)
(setq i 0
       a (getreal "/n Nhap gia tri bat dau: ")
       b (getreal "/n Nhap gia tri cong sai: ")
)
(setq ans (strcase (getstring t "/n Chon chieu tang cua Text ( P hay T ): ")))
(if (= ans "T")
  (setq enlst (reverse enlst))
)
(foreach en enlst
        (setq els (entget en)
                els (subst (cons 1 (rtos (+ a (* i b )) 2 1)) (assoc 1 els) els)
                i (1+ i)
        )
        (entmod els)
        (entupd en)
)

)

    Mong rằng bạn sẽ hài lòng.

    Lisp này khi mình chọn chiều tăng của text là phải thì nó đánh từ trên xuống dưới,bạn có thể sửa lại khi chọn chiều tăng là phải thì nó cũng đánh từ dưới lên trên giống như chiều tăng trái được không .Chân thành cảm ơn trước.

×