Jump to content
InfoFile
Tác giả: Danh Cong
Bài viết gốc: 442825
Tên lệnh: sxt
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

@ngokiet : Bạn có thể tham khảo code tôi viết sắp xếp Text :   :))



(defun c:SXT ( / #HUONG_XEP_TEXT #TEXT_ALIGHT DXF DXF10_Y DXF11_X DXF11_Y OBJECT PT DXF10_ DXF10_X...

>>

@ngokiet : Bạn có thể tham khảo code tôi viết sắp xếp Text :   :))



(defun c:SXT ( / #HUONG_XEP_TEXT #TEXT_ALIGHT DXF DXF10_Y DXF11_X DXF11_Y OBJECT PT DXF10_ DXF10_X OBJECT-SELECT)
  (setq #HUONG_XEP_TEXT "Ver")
  (initget "Ver Hor")
  (setq #HUONG_XEP_TEXT (cond ((getkword (strcat "\nText Align : <" #HUONG_XEP_TEXT ">"))) (#HUONG_XEP_TEXT)))

  (setq #TEXT_ALIGHT "L")
  (initget "L C R A M F TL TC TR ML MC MR BL BC BR")
  (setq #TEXT_ALIGHT (cond ((getkword (strcat "\nJustify Text : <" #TEXT_ALIGHT ">"))) (#TEXT_ALIGHT)))
  
  (setq object (acet-ss-to-list (ssget '((0 . "*TEXT"))))
    object-select (ACET-LIST-TO-SS object)
    pt (getpoint "\nPick Point"))

  (cond ((= #TEXT_ALIGHT "L") (command "JUSTIFYTEXT" object-select ""  "Left"))
    ((= #TEXT_ALIGHT "C") (command "JUSTIFYTEXT" object-select ""  "Center"))
    ((= #TEXT_ALIGHT "R") (command "JUSTIFYTEXT" object-select ""  "Right"))
    ((= #TEXT_ALIGHT "A") (command "JUSTIFYTEXT" object-select ""  "Aligned"))
    ((= #TEXT_ALIGHT "M") (command "JUSTIFYTEXT" object-select ""  "Middle"))
    ((= #TEXT_ALIGHT "F") (command "JUSTIFYTEXT" object-select ""  "Fit"))
    ((= #TEXT_ALIGHT "TL") (command "JUSTIFYTEXT" object-select "" "TL"))
    ((= #TEXT_ALIGHT "TC") (command "JUSTIFYTEXT" object-select "" "TC"))
    ((= #TEXT_ALIGHT "TR") (command "JUSTIFYTEXT" object-select "" "TR"))
    ((= #TEXT_ALIGHT "ML") (command "JUSTIFYTEXT" object-select "" "ML"))
    ((= #TEXT_ALIGHT "MC") (command "JUSTIFYTEXT" object-select "" "MC"))
    ((= #TEXT_ALIGHT "MR") (command "JUSTIFYTEXT" object-select "" "MR"))
    ((= #TEXT_ALIGHT "BL") (command "JUSTIFYTEXT" object-select "" "BL"))
    ((= #TEXT_ALIGHT "BC") (command "JUSTIFYTEXT" object-select "" "BC"))
    ((= #TEXT_ALIGHT "BR") (command "JUSTIFYTEXT" object-select "" "BR"))
    )
    
  (cond ((and (= #HUONG_XEP_TEXT "Ver") (= #TEXT_ALIGHT "L"))
       (foreach ss object
            (progn
            (setq dxf (entget ss)
              dxf10_y (caddr (assoc 10 dxf)))
            (setq dxf (subst (cons 10 (list (car pt) dxf10_y )) (assoc 10 dxf) dxf))
            (entmod dxf)
            ); end progn
            ); end foreach
     )
    ((= #HUONG_XEP_TEXT "Ver")
       (foreach ss object
            (progn
            (setq dxf (entget ss)
              dxf11_y (caddr (assoc 11 dxf)))
            (setq dxf (subst (cons 11 (list (car pt) dxf11_y )) (assoc 11 dxf) dxf))
            (entmod dxf)
            ); end progn
            ); end foreach
     )

      ((and (= #HUONG_XEP_TEXT "Hor")(= #TEXT_ALIGHT "L"))
       (foreach ss object
            (progn
            (setq dxf (entget ss)
              dxf10_x (cadr (assoc 10 dxf)))
            (setq dxf (subst (cons 10 (list dxf10_x (cadr pt) )) (assoc 10 dxf) dxf))
            (entmod dxf)
            ); end progn
            ); end foreach
     )
    ((= #HUONG_XEP_TEXT "Hor")
       (foreach ss object
            (progn
            (setq dxf (entget ss)
              dxf11_x (cadr (assoc 11 dxf)))
            (setq dxf (subst (cons 11 (list dxf11_x (cadr pt) )) (assoc 11 dxf) dxf))
            (entmod dxf)
            ); end progn
            ); end foreach
     )
    ); end cond
  (princ))
 


<<

Filename: 442825_sxt.lsp
Tác giả: ngokiet
Bài viết gốc: 442830
Tên lệnh: sxt
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

3 giờ trước, Danh Cong đã nói:
3 giờ trước, Danh Cong đã nói:

@ngokiet : Bạn có thể tham khảo code tôi viết sắp xếp Text :   :))

 

  • sxt.lsp
    lisp help
  •  




	(defun c:SXT ( / #HUONG_XEP_TEXT #TEXT_ALIGHT DXF DXF10_Y DXF11_X DXF11_Y OBJECT PT DXF10_ DXF10_X OBJECT-SELECT)
	  (setq #HUONG_XEP_TEXT "Ver")
	  (initget "Ver Hor")
	  (setq #HUONG_XEP_TEXT (cond ((getkword (strcat "\nText Align :  <" #HUONG_XEP_TEXT ">"))) (#HUONG_XEP_TEXT)))



	  (setq #TEXT_ALIGHT "L")
	  (initget "L C R A M F TL TC TR ML MC MR BL BC BR")
	  (setq #TEXT_ALIGHT (cond ((getkword (strcat "\nJustify Text :  <" #TEXT_ALIGHT ">"))) (#TEXT_ALIGHT)))
	  
	  (setq object (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	    object-select (ACET-LIST-TO-SS object)
	    pt (getpoint "\nPick Point"))



	  (cond ((= #TEXT_ALIGHT "L") (command "JUSTIFYTEXT" object-select ""  "Left"))
	    ((= #TEXT_ALIGHT "C") (command "JUSTIFYTEXT" object-select ""  "Center"))
	    ((= #TEXT_ALIGHT "R") (command "JUSTIFYTEXT" object-select ""  "Right"))
	    ((= #TEXT_ALIGHT "A") (command "JUSTIFYTEXT" object-select ""  "Aligned"))
	    ((= #TEXT_ALIGHT "M") (command "JUSTIFYTEXT" object-select ""  "Middle"))
	    ((= #TEXT_ALIGHT "F") (command "JUSTIFYTEXT" object-select ""  "Fit"))
	    ((= #TEXT_ALIGHT "TL") (command "JUSTIFYTEXT" object-select "" "TL"))
	    ((= #TEXT_ALIGHT "TC") (command "JUSTIFYTEXT" object-select "" "TC"))
	    ((= #TEXT_ALIGHT "TR") (command "JUSTIFYTEXT" object-select "" "TR"))
	    ((= #TEXT_ALIGHT "ML") (command "JUSTIFYTEXT" object-select "" "ML"))
	    ((= #TEXT_ALIGHT "MC") (command "JUSTIFYTEXT" object-select "" "MC"))
	    ((= #TEXT_ALIGHT "MR") (command "JUSTIFYTEXT" object-select "" "MR"))
	    ((= #TEXT_ALIGHT "BL") (command "JUSTIFYTEXT" object-select "" "BL"))
	    ((= #TEXT_ALIGHT "BC") (command "JUSTIFYTEXT" object-select "" "BC"))
	    ((= #TEXT_ALIGHT "BR") (command "JUSTIFYTEXT" object-select "" "BR"))
	    )
	    
	  (cond ((and (= #HUONG_XEP_TEXT "Ver") (= #TEXT_ALIGHT "L"))
	       (foreach ss object
	            (progn
	            (setq dxf (entget ss)
	              dxf10_y (caddr (assoc 10 dxf)))
	            (setq dxf (subst (cons 10 (list (car pt) dxf10_y )) (assoc 10 dxf) dxf))
	            (entmod dxf)
	            ); end progn
	            ); end foreach
	     )
	    ((= #HUONG_XEP_TEXT "Ver")
	       (foreach ss object
	            (progn
	            (setq dxf (entget ss)
	              dxf11_y (caddr (assoc 11 dxf)))
	            (setq dxf (subst (cons 11 (list (car pt) dxf11_y )) (assoc 11 dxf) dxf))
	            (entmod dxf)
	            ); end progn
	            ); end foreach
	     )



	      ((and (= #HUONG_XEP_TEXT "Hor")(= #TEXT_ALIGHT "L"))
	       (foreach ss object
	            (progn
	            (setq dxf (entget ss)
	              dxf10_x (cadr (assoc 10 dxf)))
	            (setq dxf (subst (cons 10 (list dxf10_x (cadr pt) )) (assoc 10 dxf) dxf))
	            (entmod dxf)
	            ); end progn
	            ); end foreach
	     )
	    ((= #HUONG_XEP_TEXT "Hor")
	       (foreach ss object
	            (progn
	            (setq dxf (entget ss)
	              dxf11_x (cadr (assoc 11 dxf)))
	            (setq dxf (subst (cons 11 (list dxf11_x (cadr pt) )) (assoc 11 dxf) dxf))
	            (entmod dxf)
	            ); end progn
	            ); end foreach
	     )
	    ); end cond
	  (princ))
	 

Bác viết bình thường theo sài command justifytext chứ đâu phải entmod

- Trong lệnh cond của bác để xét #TEXT_ALIGHT thì bác có thể dùng 

(command "JUSTIFYTEXT" object-select ""  #TEXT_ALIGHT))

cho nó gọn và tránh phài so sánh nhiều lần.

- Về lệnh entmod Thì ngoài giá trị đầu chỉ ent cần sửa thì các giá trị sau cần sủa giá trị dxf nào thì sửa cái đó thôi.

Ví dụ như lisp bas mình sửa lại như sau

(defun c:SXT ( / #HUONG_XEP_TEXT #TEXT_ALIGHT DXF DXF10_Y DXF11_X DXF11_Y OBJECT PT DXF10_ DXF10_X OBJECT-SELECT n)
	  (setq #HUONG_XEP_TEXT "Ver")
	  (initget "Ver Hor")
	  (setq #HUONG_XEP_TEXT (cond ((getkword (strcat "\nText Align :  <" #HUONG_XEP_TEXT ">"))) (#HUONG_XEP_TEXT)))



	  (setq #TEXT_ALIGHT "L")
	  (initget "L C R A M F TL TC TR ML MC MR BL BC BR")
	  (setq #TEXT_ALIGHT (cond ((getkword (strcat "\nJustify Text :  <" #TEXT_ALIGHT ">"))) (#TEXT_ALIGHT)))
	  
	  (setq object (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	    object-select (ACET-LIST-TO-SS object)
	    pt (getpoint "\nPick Point"))


	  (command "JUSTIFYTEXT" object-select ""  #TEXT_ALIGHT)
	  
	  
	  (setq n (if (= #TEXT_ALIGHT "L") 10 11))

	  
	  (if (= #HUONG_XEP_TEXT "Ver")
	      (foreach ss object
	            (setq dxf (entget ss)
	              dxf10_y (caddr (assoc n dxf)))
		    (entmod (list (car dxf) (list n (car pt) dxf10_y)))   
	            )
	      (foreach ss object
	            (setq dxf (entget ss)
	              dxf10_x (cadr (assoc n dxf)))
		    (entmod (list (car dxf) (list n dxf10_y (cadr pt))))   
	            )
	    );end if
	  (princ))

Mình không thích sài command trong lisp cho lắm. Nếu mình viết thường sửa thẳng 1 lần trong entmod luôn.

Mình chỉ sửa lisp của bạn để chạy giống y lisp cũ thôi.

Chứ lisp đó khi xắp xép text khi gặp mtext thì có thể lỗi vì dxf mtext khác text.

Với trường hợp justify là fit, align thì text có thể bị kéo giãn hay thay đỗi chiếu cao. 2 trường hợp này phải thay đổi cả dxf 10 và 11.


<<

Filename: 442830_sxt.lsp
Tác giả: w1nDream
Bài viết gốc: 73211
Tên lệnh: brt
Hỏi về lệnh Break

Lỗi tại bạn không nói rõ.

Khi chạy Lisp hỏi sẽ chọn pick điểm 1 và điểm 2. Điểm 1 và điểm 2 tạo thành 1 cửa sổ (W). Cửa sổ (W) là một hình chữ nhật tạo bởi 2...

>>
Lỗi tại bạn không nói rõ.

Khi chạy Lisp hỏi sẽ chọn pick điểm 1 và điểm 2. Điểm 1 và điểm 2 tạo thành 1 cửa sổ (W). Cửa sổ (W) là một hình chữ nhật tạo bởi 2 điểm 1 và điểm 2. Đoạn thẳng nối điểm 1 và điểm 2 chính là đường chéo của hình chữ nhật (W)

Chọn đối tượng là Line, Polyline thẳng.

Lisp sẽ break đối tượng.

Các đối tượng nằm trong vùng cửa sổ (W) bị break. còn đối tượng nằm ngoài cửa sổ được giữ nguyên

Nếu điểm 1 và điểm 2 cùng nằm trên 1 đường thẳng thì Lisp sẽ Break tại 1 điểm.

Bạn chạy thử xem nhé.

(Defun c:brt(/ aL bL cL dL eL fL gL sL hL ss n)
(vl-load-com) 
(prompt "\n Chon duong cat bang cach chon diem thu nhat va diem thu hai :")
(setq aL (getpoint "\n Chon diem thu nhat :"))
(setq bL (getcorner aL "\n Chon diem thu hai :"))
(setq fL (list (car aL) (cadr bL) 0))
(setq gL (list (car bL) (cadr aL) 0))

(grdraw aL gL 1 1)
(grdraw gL bL 1 1)
(grdraw bL fL 1 1)
(grdraw fL aL 1 1)
(Prompt "\n Chon doi tuong Line can break tai 1 diem :")
(Setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
(Setq n (sslength ss) 
i 0)
(while (< i n)
(setq sL (ssname ss i))
(setq cL (vlax-curve-getStartPoint sL))
(setq dL (vlax-curve-getEndPoint sL))

(setq eL (inters aL fL cL dL T))
(setq hL (inters bL gL cL dL T))

(if (= eL nil) (setq i (1+ i)))
(if (/= eL nil) 
(progn
(Command "_Break" sL eL hL)
(setq i (1+ i))
)
)
)

(Princ)
)

Hy vọng bạn hài lòng.

Chúc thành công :s_big:

 

Pác Tuệ ơi!Júp em với.Em đã down lisp này về dùng nhưng :

1.Nó chỉ break line.

2.Nó chỉ break các line nằm ngang, em thử với line thẳng đứng(or các line không nằm ngang)thì không được.

Pác có thể hoàn thiện nó để break theo 1 đường path được không.


<<

Filename: 73211_brt.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 225630
Tên lệnh: tinhtong
Lisp đo tổng khoảng cách AB + CD nằm trên 2 đường Pline khác nhau

(defun c:tinhtong (/ L p1 p2 ll s1 olay)
 (vl-load-com)
 (setq olay (getvar "clayer"))
 (setvar "clayer" "defpoints")
 (setvar "cmdecho" 0)
...
>>

(defun c:tinhtong (/ L p1 p2 ll s1 olay)
 (vl-load-com)
 (setq olay (getvar "clayer"))
 (setvar "clayer" "defpoints")
 (setvar "cmdecho" 0)
 (setq p1 (getpoint "chon diem")
L 0
ll (list p1))
 (while (setq p2 (getpoint p1 "chon diem"))
(setq L ( + L (distance p1 p2)))
(setq ll (append ll (list p2)))
(setq p1 p2))
 (acet-pline-make (list ll))
L
 (entmod(subst (cons 1 (rtos L 2 2)) (assoc 1 (setq dt(entget(car(entsel "chontext"))))) dt))
 (initget 1 "Y N")
 (setq s1 (strcase(getkword "Co Xoa bo PL vua tao")))
 (if (or (= s1 "")(= s1 "Y")) (entdel (entlast)))
 (setvar "clayer" olay)
 (setvar "cmdecho" 1)
 )

Bạn có thể thử

Hề hề hề,

Ngoài lỗi trên lisp của bạn quansla dùng tính tổng khoảng cách chứ không phải độ dài tính theo pline như yêu cầu. Độ dài tinh theo pline không phải lúc nào cũng đúng là khoảng cách giữa hai điểm pick.


<<

Filename: 225630_tinhtong.lsp
Tác giả: pphung183
Bài viết gốc: 394043
Tên lệnh: mc
Chuyển Dtext Thành Mtext Và Setp Justify Cho Mtext Vừa Chuyển

 

(defun c:mc()
	(setq ss (ssget '((0 . "*TEXT"))))
	(foreach en (acet-ss-to-list ss)
		(command "_txt2mtxt" en...
>>

 

(defun c:mc()
	(setq ss (ssget '((0 . "*TEXT"))))
	(foreach en (acet-ss-to-list ss)
		(command "_txt2mtxt" en "")
		(acet-tjust en "MC"); set justify cho Mtext vua moi chuyen thanh
		)
)

Em tìm thấy code chuyển Dtext thành Mtext, nhưng em không tìm thấy nút để trả lời bên topic đó nên mạo mụi tạo topic này.

Tình hình là em muốn setup justify cho Mtext vừa được tạo ra nhưng làm hoài không được. Nhờ mọi người sửa giúp!

Cảm ơn!

(defun c:mc()

    (setq ss (ssget '((0 . "*TEXT"))))

    (foreach en (acet-ss-to-list ss)

        (command "_txt2mtxt" en "")

        (acet-tjust en "MC"); set justify cho Mtext vua moi chuyen thanh

        )

)

 

Cấu trúc hàm  (acet-tjust ss A) trong đó : ss là tập selection set.

Do đó code của bạn chỉnh lại :) :

(defun c:mc(/ ss s)

    (setq ss (ssget '((0 . "TEXT"))) s (ssadd))

    (foreach en (acet-ss-to-list ss)

        (command "_txt2mtxt" en "") (setq s (ssadd (entlast) s)) )

        (acet-tjust s "MC"); set justify cho Mtext vua moi chuyen thanh

       )


<<

Filename: 394043_mc.lsp
Tác giả: Tue_NV
Bài viết gốc: 207020
Tên lệnh: test
gộp giúp em lisp lệnh bật, tắt Layer với

Khi ấn Esc thì bạn khỏi bảo nó cũng thoát lệnh rồi ^^

(defun c:test ()
(mapcar '(lambda(x)(eval (read (strcat "(c:" x...
>>

Khi ấn Esc thì bạn khỏi bảo nó cũng thoát lệnh rồi ^^

(defun c:test ()
(mapcar '(lambda(x)(eval (read (strcat "(c:" x ")")))
(getstring (strcat "\nDone to " x ", space to continue, esc to stop"))
 ) '("n1" "n2" "n3"))
(alert "Done! Good luck!")
(princ)
)

Khi thực hiện xong lệnh n3 thì chưa "Good luck" được. "Chúc may mắn" phải thông qua "press any key".

Chưa đạt yêu cầu vì : (nếu thực hiện đến n3 thì lisp tự động kết thúc lệnh hiện lên bảng thông báo "good luck"). Phải thêm code nữa Ket mới đạt được yêu cầu

 

Cái của Tue_NV tuy dài hơn ketxu 1 tí nhưng "Good luck" ngay khi kết thúc lệnh cuối cùng, chẳng phải thông qua "press any key" nào cả.


<<

Filename: 207020_test.lsp
Tác giả: khaosat2009
Bài viết gốc: 95789
Tên lệnh: lb2
Viết lisp theo yêu cầu [phần 2]
Đây bạn dùng thử.

(defun c:lb2 (/ en ob i li1 h k y pb)
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n...
>>
Đây bạn dùng thử.

(defun c:lb2 (/ en ob i li1 h k y pb)
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))
(while (<= i n)
(setq p (vlax-curve-getPointAtParam ob i)
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(command "-insert" "Moc Hanh" p "1" "1" "0" (strcat "D" (rtos (1+ i) 2 0)))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (strcat "D" (rtos (1+ i) 2 0))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
(princ)
)

PS: chỉ đúng với gốc toạ độ WORLD còn khi xoay gốc toạ độ không còn đúng nữa.

Kèm theo block này nữa nhé. (copy block trong file dưới vào bản vẽ của bạn) Chúc bạn thành công.

http://www.cadviet.com/upfiles/2/moc_hanh.dwg

Cám ơn , nhưng sao mình chạy lisp không thể hiện gì cả.

Mong được bạn giúp


<<

Filename: 95789_lb2.lsp
Tác giả: Tue_NV
Bài viết gốc: 82951
Tên lệnh: deh
Nhờ Fix 2 Lisp đánh cao độ tự động và Lisp cộng thêm vào cao độ một giá trị
Chào bạn thanhlamct,

Mình đã sửa cái lisp deltalh để bạn sử dụng với cái lisp đánh cốt sử dụng block dc50, tuy nhiên bạn phải lưu ý rằng lisp deltalh bây giờ...

>>
Chào bạn thanhlamct,

Mình đã sửa cái lisp deltalh để bạn sử dụng với cái lisp đánh cốt sử dụng block dc50, tuy nhiên bạn phải lưu ý rằng lisp deltalh bây giờ sẽ không dùng được với các bản vẽ mà trước đây bạn đã sử dụng lisp deltalh để điều chỉnh cao độ cốt.

Vậy nên mình khuyên bạn nên lưu lisp này với tên khác lisp deltalh cũ chẳng hạn deltalh-1.lsp để bạn có thể tùy cơ mà ứng biến.

Do mình không có chuyên môn về ngành xây dựng, cầu đường, trắc đạc,...... nên không dám sửa giúp bạn cái block dc50 (vì sợ nó ảnh hưởng đến công việc của bạn) mà đành sửa cái lisp deltalh để bạn xài vậy.

Tuy nhiên mình nghĩ rằng cách tốt nhất vẫn là bạn hãy tạo lại cái block dc50 này sao cho nó có thuộc tính thứ nhất là giá trị của cốt, như vậy sẽ thuận lợi hơn cho công việc của bạn.

Chúc bạn thành công.

Đây là lisp deltalh đã sửa:

(defun c:deh ()
 (defun sudung	(ham ss / sodt index entdt soapp)
   (setq sodt	(cond
	  (ss (sslength ss))
	  (t 0)
	)
  soapp	0
  index	0
   )
   (repeat sodt
     (setq entdt (ssname ss index)
    index (1+ index)
     )
     (if (ham entdt)
(setq soapp (1+ soapp))
     )
   )
   soapp
 )
 (defun addstring (str so)
   (rtos (+ (atof str) so) 2 2)
 )
 (defun addone	(ent / tt)
   (setq ent (entnext (entnext ent)))
   (setq tt  (entget ent)
  old (assoc 1 tt)
  new (cons 1 (addstring (cdr old) deltah))
  tt  (subst new old tt)
   )
   (entmod tt)
   (entupd ent)
 )
 (setq	ss     (ssget '((0 . "INSERT") (66 . 1)))
deltah (getreal "\nVao gia tri chenh: ")
 )
 (sudung addone ss)
 (princ)
)

Chào bác PhamthanhBinh cùng bạn thanhlam

Lisp deh phải sử dụng đúng cho cả 2 trường hợp. Trong Lisp của bác PhamthanhBinh chỉ sđúng cho 1 trường hợp mà thôi, Để sử dụng lisp deh đúng cho cả 2 trường hợp thì theo ý kiến của Tue_NV như thế này :

1. Ta biết rằng giá trị thuộc tính gồm 1 Tagname và 1 Tagval. Ta hãy để ý đến TagName. Khi TagName của cao độ giống nhau của 2 trường hợp giống nhau sẽ áp đụng đúng cho cả 2 trường hợp. Ở tại Tagame này lấy ra Tagval và sử dụng phép tính của nó.

Bác PhamthanhBinh hoàn thành code này theo cách của Tue_NV thử xem.

 

Vài lời góp ý. Hy vọng Code được xây dựng thành công.


<<

Filename: 82951_deh.lsp
Tác giả: quansla
Bài viết gốc: 443098
Tên lệnh: ve vai dia
Nhờ các cao nhân viết dùm lisp vẽ vải địa kỹ thuật

Quick code nhé

 

cơ mà vẫn không biết chiều cao của chủ topic dùng để làm gì, tự kiểm tra nhé

 

(defun c:ve_vai_dia (/ chieu_day_net_ve ent list_point n p1 p2)
  (setq chieu_day_net_ve 0.15)
  (or (setq delta (getdist (strcat "\nChon chieu dai doan gap<" (rtos delta 2 2)">"))) (setq delta 2.0))
  
  (foreach dt (acet-ss-to-list (ssget '((0 ....
>>

Quick code nhé

 

cơ mà vẫn không biết chiều cao của chủ topic dùng để làm gì, tự kiểm tra nhé

 

(defun c:ve_vai_dia (/ chieu_day_net_ve ent list_point n p1 p2)
  (setq chieu_day_net_ve 0.15)
  (or (setq delta (getdist (strcat "\nChon chieu dai doan gap<" (rtos delta 2 2)">"))) (setq delta 2.0))
  
  (foreach dt (acet-ss-to-list (ssget '((0 . "*LINE")(8 . "VolUnsoil"))))
    (setq ent (entget dt)
	  list_point (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
	  N (length list_point))
    (if (< (cadr (car list_point)) (cadr (last list_point)))
      (setq p1 (cons 10 (polar (cdr(car  list_point)) 0.0 delta))
	    p2 (cons 10 (polar (cdr(last list_point)) pi  delta))
	    list_point (append (list p1) list_point (list p2)))

      (setq p1 (cons 10 (polar (cdr(car  list_point)) pi delta))
	    p2 (cons 10 (polar (cdr(last list_point)) 0.0  delta))
	    list_point (append (list p1) list_point (list p2)))

      )
    (entmakex
      (append (list
		'(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		(cons 8 "VAI DKT2")
		(cons 6 "bylayer")
		(cons 48 1)
		(cons 62 256)

		;Do rong LWPoly
		(cons 43 chieu_day_net_ve)

		'(100 . "AcDbPolyline")
		(cons 90 (length list_point))
		(cons 70 0)
	      )
	      (apply 'append
		     (mapcar '(lambda (x)
				(append	(list x)
					(list (cons 40  chieu_day_net_ve) (cons 41  chieu_day_net_ve))
				)
			      )
			     list_point
		     )
	      )
      )
    ))
  )

 


<<

Filename: 443098_ve_vai_dia.lsp
Tác giả: quansla
Bài viết gốc: 443100
Tên lệnh: ttd trudim
Nhờ mọi người trợ giúp Lisp tính tổng Dimension

Nói bán kính thì mình chỉ xử lý bán kính nhé ^T^ 

;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>

Nói bán kính thì mình chỉ xử lý bán kính nhé ^T^ 

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/205-vi%E1%BA%BFt-lisp-theo-y%C3%AAu-c%E1%BA%A7u/?page=84&tab=comments#comment-62720
(defun c:TTD(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)


(alert (rtos S 2 0))

(princ)
)
(defun c:Trudim(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim lam so bi tru :")
(setq ss (ssget '((0 . "DIMENSION"))))

(prompt "\n Chon cac Dim lam so tru :")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)
(setq nt (sslength sst) j 0 St 0 duyett 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)

(while (< j nt)
(setq entt (entget(ssname sst j)))

(if (= (cdr(assoc 1 entt)) "")
(setq duyett (cdr(assoc 42 entt)))
(setq duyett (atof(cdr(assoc 1 entt))))
)
(setq St (+ St duyett))
(setq j (1+ j))
)

(setq Skq (- S St))

(alert (rtos Skq 2 0))

(princ)
)

 


<<

Filename: 443100_ttd_trudim.lsp
Tác giả: duy782006
Bài viết gốc: 443119
Tên lệnh: abc
Nhờ mọi người phát triển lisp !
(defun c:abc(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION"))))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)
(Luachon S)
(princ)
)
(defun Luachon(tbinh)
 (setq...
>>
(defun c:abc(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION"))))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)
(Luachon S)
(princ)
)
(defun Luachon(tbinh)
 (setq elst (entget (car (entsel "\n Thay cho so: "))))
 (setq ndc (cdr (assoc 1 elst)))
 (setq elst (subst (cons 1 (strcat ndc ", L=" (rtos tbinh 2 0))) (assoc 1 elst) elst))
(if (assoc 62 elst)
(setq elst (subst (cons 62 80) (assoc 62 elst) elst))
(setq elst (append elst (list (cons 62 80))))
)
(entmod elst)
(princ)
)

Chỉ sửa chút chổ xuất kết quả thôi nghen. các phần khác mình ko chịu trách nhiệm nhé.


<<

Filename: 443119_abc.lsp
Tác giả: duy782006
Bài viết gốc: 443121
Tên lệnh: abc
Nhờ mọi người phát triển lisp !
(defun c:abc(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION"))))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)
(Luachon S)
(princ)
)
(defun Luachon(tbinh)
 (setq...
>>
(defun c:abc(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION"))))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)
(Luachon S)
(princ)
)
(defun Luachon(tbinh)
 (setq elst (entget (car (entsel "\n Thay cho so: "))))
 (setq ndc (cdr (assoc 1 elst)))
 (setq ndc (duy:xd_chuoitruoc<kytu ndc "="))
 (setq elst (subst (cons 1 (strcat ndc "=" (rtos tbinh 2 0))) (assoc 1 elst) elst))
(if (assoc 62 elst)
(setq elst (subst (cons 62 80) (assoc 62 elst) elst))
(setq elst (append elst (list (cons 62 80))))
)
(entmod elst)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh vi tri ky tu kytu trong chuoi tinh tai vi tri xuat hien cuoi cung
;;;Cu phap su dung (duy:xd_vitri<kytu chuoi kytu)
;;;Gia tri tra ve la vi tri cua kytu trong chuoi 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:xd_vitri<kytu (chuoi kytu / chuoi kytu a b l v)  
(setq b 1)
(setq l (fix (strlen chuoi)))
(repeat l
(setq a (substr chuoi b 1))
(cond
((= a kytu) (setq v b))
)
(setq b (+ b 1))
)
v)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh chuoi nam phia truoc kytu
;;;Cu phap su dung (duy:xd_chuoitruoc<kytu chuoi kytu)
;;;Gia tri tra ve la chuoi ckq
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:xd_chuoitruoc<kytu (chuoi kytu / chuoi kytu ckq)  
(setq ckqt (substr chuoi 1 (- (duy:xd_vitri<kytu chuoi kytu) 1)))
ckqt)


Đây.


<<

Filename: 443121_abc.lsp
Tác giả: laivanyen
Bài viết gốc: 122243
Tên lệnh: slblt
Chon đối tượng theo dang đường linetype !
Hề hề hề,

Không biết cái này bạn có xài được không hỉ???

(defun c:slblt ()
(setq ss (ssget (list (cons 0 "*LINE,CIRCLE,ELLIPSE")))
       i...
>>
Hề hề hề,

Không biết cái này bạn có xài được không hỉ???

(defun c:slblt ()
(setq ss (ssget (list (cons 0 "*LINE,CIRCLE,ELLIPSE")))
       i 0
       n (sslength ss)
       sslt (ssadd)
       lt (getstring t "\n Nhap ten linetype can chon: ")
)
(while (< i n)
      (setq en (ssname ss i)
              els (entget en)
              la (cdr (assoc 8 els))
      )
      (if (/= (cdr (assoc 6 els)) nil)
          (if (= (cdr (assoc 6 els)) lt)
              (setq sslt (ssadd en sslt))
          )
          (if (= (cdr (assoc 6 (tblsearch "layer" la))) lt)
              (setq sslt (ssadd en sslt))
          )
       )
       (setq i (1+ i))
)
sslt
(sssetfirst nil sslt)
(princ)
)

Chúc bạn vui.

 

Không phải rùi Bác ơi ! ý em là chọn đường hidden, center..(theo linetype ạ !) mà không phân biệt LINE,CIRCLE,ELLIPSE


<<

Filename: 122243_slblt.lsp
Tác giả: quansla
Bài viết gốc: 443112
Tên lệnh: ve vai dia
Nhờ các cao nhân viết dùm lisp vẽ vải địa kỹ thuật

Mình về rồi, máy này không có Cad, mình quên mất

bạn download lại nhé

Chắc do chưa khởi tạo giá trị ban đầu của biến delta

(defun c:ve_vai_dia (/ chieu_day_net_ve ent list_point n p1 p2)
  (setq chieu_day_net_ve 0.15)
(vl-load-com)
(or delta (setq delta 2.0))
  (or (setq delta (getdist (strcat "\nChon chieu dai doan gap<" (rtos delta 2 2)">")))...
>>

Mình về rồi, máy này không có Cad, mình quên mất

bạn download lại nhé

Chắc do chưa khởi tạo giá trị ban đầu của biến delta

(defun c:ve_vai_dia (/ chieu_day_net_ve ent list_point n p1 p2)
  (setq chieu_day_net_ve 0.15)
(vl-load-com)
(or delta (setq delta 2.0))
  (or (setq delta (getdist (strcat "\nChon chieu dai doan gap<" (rtos delta 2 2)">"))) (setq delta 2.0))
  
  (foreach dt (acet-ss-to-list (ssget '((0 . "*LINE")(8 . "VolUnsoil"))))
    (setq ent (entget dt)
	  list_point (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
	  N (length list_point))
    (if (< (cadr (car list_point)) (cadr (last list_point)))
      (setq p1 (cons 10 (polar (cdr(car  list_point)) 0.0 delta))
	    p2 (cons 10 (polar (cdr(last list_point)) pi  delta))
	    list_point (append (list p1) list_point (list p2)))

      (setq p1 (cons 10 (polar (cdr(car  list_point)) pi delta))
	    p2 (cons 10 (polar (cdr(last list_point)) 0.0  delta))
	    list_point (append (list p1) list_point (list p2)))

      )
    (entmakex
      (append (list
		'(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		(cons 8 "VAI DKT2")
		(cons 6 "bylayer")
		(cons 48 1)
		(cons 62 256)

;Do rong LWPoly
		(cons 43 chieu_day_net_ve)

		'(100 . "AcDbPolyline")
		(cons 90 (length list_point))
		(cons 70 0)
	      )
	      (apply 'append
		     (mapcar '(lambda (x)
				(append	(list x)
					(list (cons 40  chieu_day_net_ve) (cons 41  chieu_day_net_ve))
				)
			      )
			     list_point
		     )
	      )
      )
    ))
  )

 


<<

Filename: 443112_ve_vai_dia.lsp
Tác giả: hanh.phuc
Bài viết gốc: 443128
Tên lệnh: tt
lisp đẩy các đối tượng cách nhau 1 khoảng cách đều nhau?
(defun c:tt (/ *error* foo ss fn f a b l ls l1 lst); 

 
  (defun *error* (msg) 
    (if (and f (= (type f) 'FILE)) 
      (close f) 
      (setq f nil)
      ) 
    ) 
  
  (and (setq foo '((a b) (cdr (assoc a (entget b))))  
             ss (ssget' ((0 . "TEXT"))) 
             )) 
       (setq l (vl-remove-if 'listp) (mapcar 'cadr (ssnamex ss)))); (acet-ss-to-list ss) 
       (setq fuzz (* 0.25 (foo 40 (car l))) 
         ...
>>
(defun c:tt (/ *error* foo ss fn f a b l ls l1 lst); 

 
  (defun *error* (msg) 
    (if (and f (= (type f) 'FILE)) 
      (close f) 
      (setq f nil)
      ) 
    ) 
  
  (and (setq foo '((a b) (cdr (assoc a (entget b))))  
             ss (ssget' ((0 . "TEXT"))) 
             )) 
       (setq l (vl-remove-if 'listp) (mapcar 'cadr (ssnamex ss)))); (acet-ss-to-list ss) 
       (setq fuzz (* 0.25 (foo 40 (car l))) 
             ls (mapcar '(lambda (x) (cons (foo 1 x) (foo 10 x))) l) 
             ) 
       (setq fn (strcat (getvar 'tempprefix ) "copytext.txt" ))
       (setq f (open fn "w"))) 
       (setq l nil 
             sl (vl-sort ls 
                         '(lambda ( a  b ) 
                            ( if 
                             (equal (caddr a) (caddr b) fuzz) 
                             (<(cadr a) (cadr b))
                             (<(caddr a) (caddr b)) 
                             ) 
                            ) 
                         )

             a (caddar sl) 
             )

       (foreach x sl 
         (if (equal a (setq b (caddr x)) fuzz) 
           (setq l1 (cons x l1) 
                 a b 
                 ) 
           (setq l1 ( vl-list*  x nil l1)) 
           ) 
         (setq a b) 
         ); _ end of foreach 
       (foreach x (progn (foreach x l1 
                           (if x 
                             (setq l (cons xl))) 
                             (setq lst (cons l lst) 
                                   l nil 
                                   ) 
                             ) 
                           )) 
                         (setq lst (cons l lst))
                         (reverse (vl-remove nil lst)) 
                         ); progn 
         (write-line (apply 'strcat (mapcar '(lambda (x) (strcat x "\t"))) (mapcar 'car x))) f) 
         ) 
       (progn (if f 
                (close f) 
                ) 
              (vl-cmdf "_erase" ss "") 
       (startapp "notepad" fn) 
;;; (vl-cmdf "_.SHELL" (strcat "CLIP <" fn)) 
;;; (alert " Try  or paste clipboard in the dwg! ") 
              ) 
       ); 
  (princ)
  ) 



mt2.gif.f557a5573a283d2d2cd6579b8443597d.gif

 

1.notepad copy  

2.Acad paste 

3.Edit Mtext 


<<

Filename: 443128_tt.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 443151
Tên lệnh: te
NHỜ VIẾT LISP XÓA CÁC ĐỐI TƯỢNG ĐÈN LÊN 1 ĐƯỜNG
25 phút trước, hoành đã nói:
25 phút trước, hoành đã nói:

bo tri inverter quang duc.dwg
BẢN VẼ ĐÂY BÁC, NHỜ BÁC LÀM GIÚP. EM CẢM ƠN.

Đây nhé bạn: 

(defun c:te (/ ent ss)
  (while (setq ent (car (entsel "\nPick Ranh Gioi")))
    (acet-ss-zoom-extents (acet-list-to-ss (list ent)))
    (if (not (setq ss (ssget "_CP" (acet-geom-vertex-list ent))))
      (setq ss (ssget "_F" (acet-geom-vertex-list ent))))
    (command "ERASE" (ssdel ent ss ) "")
    (vlax-invoke (vlax-get-acad-object) 'zoomprevious)
    )
  )

 


<<

Filename: 443151_te.lsp
Tác giả: Mọt Sách
Bài viết gốc: 225337
Tên lệnh: hh
Lisp thống kê tọa độ địa chính

Vừa ngó qua topic của bác này cũng có cái lisp nhờ các bác sửa giúp em ạ:

+ Khi gõ lệnh lisp nó yêu cầu tạo layer 100 trước khi thực hiện thao tác của lisp ===> Xóa phần này đi được không ạ?

+ Có dòng lệnh cho phép hỏi chọn độ chính xác thập phân tọa độ , độ chính xác thập phân khoảng cách ạ.

+ Đổi font tiêu đề khi tạo ra về font .vni

>>

Vừa ngó qua topic của bác này cũng có cái lisp nhờ các bác sửa giúp em ạ:

+ Khi gõ lệnh lisp nó yêu cầu tạo layer 100 trước khi thực hiện thao tác của lisp ===> Xóa phần này đi được không ạ?

+ Có dòng lệnh cho phép hỏi chọn độ chính xác thập phân tọa độ , độ chính xác thập phân khoảng cách ạ.

+ Đổi font tiêu đề khi tạo ra về font .vni

(defun *error* (msg)
 (princ "error: ")
 (princ msg)
 (princ)
)
(defun Wdis (p1 p2 / dis ang point)
 (setq dis (distance p1 p2))
 (setq ang (angle p1 p2))
 (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
(progn
 	(setq ang (+ Ang Pi))
 	(setq Point (polar p2 ang (/ dis 2.0)))
)
(setq Point (polar p1 ang (/ dis 2.0)))
 )
 (command "Text" "S" "vaptimn" "c" point (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2) )
)
(defun ssgetLayer( La1 La2 / ss)
 (setq ss (ssget "X" (list
                    	(cons -4  "<OR") 
                      	(cons -4  "<AND") 
                        	(cons 8 La1) 
                        	(cons 0  "LWPOLYLINE")
                      	(cons -4  "AND>") 
                      	(cons -4  "<AND") 
                        	(cons 8 La1) 
                        	(cons 0  "LINE")
                      	(cons -4  "AND>") 
                      	(cons -4  "<AND") 
                        	(cons 8 La2) 
                        	(cons 0  "LWPOLYLINE")
                      	(cons -4  "AND>") 
                      	(cons -4  "<AND") 
                        	(cons 8 La2) 
                        	(cons 0  "LINE")
                      	(cons -4  "AND>") 
                    	(cons -4  "OR>") 
                  	)
 ))
 ss
)
(defun pointpl (name tM k / namem i bien t1 p1 diem)
(setq namem name)
(setq i 1)
(while (<= i k)
(progn
 (setq bien (assoc tM namem))
 (setq t1 (member bien namem))
 (setq p1 (car t1))
 (setq namem (cdr t1))
 (setq diem (cdr p1))
 (setq i (+ 1 i))
)
)
diem
)
(defun c:hh( / i k luuxy st p xoa)
(setvar "cmdecho" 0)
(setq st (ssgetLayer "100" "thua") )
(if (/= st  nil)
(progn
(if (null (tblsearch "style" "vaptimn"))
 (command "_style" "vaptimn" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "style" "vhelveb"))
 (command "_style" "vhelveb" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "layer" "sohieu_diem"))
 (command "_layer" "n" "sohieu_diem" ""))
(command "_layer" "c" "2" "sohieu_diem" "")
(if (null (tblsearch "layer" "bang_toado"))
 (command "_layer" "n" "bang_toado" ""))
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "6" "thua" "")
(command "_layer" "c" "6" "100" "")
(setq r1 (getvar "USERI1"))
(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
(if (= TileBdHT nil)
 (setq TileBdHT r1))
(setvar "USERR1" TileBdHT)
(setvar "blipmode" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Pick"))
(if (/= p nil)
 (command "-Boundary" "a" "b" "n" st "" "" p "" )
)
(setq luuxy (entget (entlast)))
(setq p (getpoint "\n Diem dat bang toa do :"))
(entdel (entlast))
(setq k (cdr (assoc 90 luuxy)))
(if (/= p nil)
 (progn
  (setq p01 p)
  (setq p02 (mapcar '+ p '(10.0  0.0 0.0)))
  (setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))
  (setq p04 (mapcar '+ p '(35.0  0.0 0.0)))
  (setq p05 (mapcar '+ p '(45.0  0.0 0.0)))
  (setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))
  (setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))
  (setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))
  (setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))
  (if (<= k 10)  
(progn
	(setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))
	(setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))
	(setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))
	(setq p13 (mapcar '+ p '(35.0 -40.0 0.0)))
	(setq p14 (mapcar '+ p '(45.0 -40.0 0.0)))
)
(progn
	(setq ty (* -1 (+ 10.0 (* k 3))))
	(setq t0 (list 0.0 ty 0.0))
	(setq t1 (list 10.0 ty 0.0))
	(setq t2 (list 22.5 ty 0.0))
	(setq t3 (list 35.0 ty 0.0))
	(setq t4 (list 45.0 ty 0.0))
	(setq p10 (mapcar '+ p t0))
	(setq p11 (mapcar '+ p t1))
	(setq p12 (mapcar '+ p t2))
	(setq p13 (mapcar '+ p t3))
	(setq p14 (mapcar '+ p t4))
)
  )
  (command "layer" "s" "bang_toado" "")
  (command "Line" p01 p05 "")
  (command "Line" p01 p10 "")
  (command "Line" p02 p11 "")
  (command "Line" p03 p12 "")
  (command "Line" p04 p13 "")
  (command "Line" p05 p14 "")
  (command "Line" p07 p08 "")
  (command "Line" p06 p09 "")
  (command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 2.0 0.0)) 1.25 0 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "Soá hieäu")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "ñieåm")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "Toïa ñoä")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.25 0 "Caïnh")
 )
)
(setq i 1)
(while (<= i k)
 (progn
  (setq toado (pointpl luuxy 10 i))
  (setq x (rtos (car toado) 2 2))
  (setq y (rtos (cadr toado) 2 2))
  (command "layer" "s" "sohieu_diem" "")
  (setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
  (command "Text" "S" "vaptimn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
  (command "donut" "0.0" (* 0.25 (/ TileBdHT 500)) toado "")  
  (setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
  (setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
  (setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
  (setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
  (setq psh (mapcar '+ p tsh))
  (setq pxx (mapcar '+ p txx))
  (setq pyy (mapcar '+ p tyy))
  (setq pgc (mapcar '+ p tgc))
  (if (= i 1)
(progn
	(setq toado1 toado)
	(setq x1 (rtos (car toado1) 2 2))
	(setq y1 (rtos (cadr toado1) 2 2))
)
  )
  (if (>= i 2)
(progn
(setq canh (distance toado0 toado))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
(command "layer" "s" "sohieu_diem" "")
(wdis toado0 toado)
)
  )
  (command "layer" "s" "bang_toado" "")
  (command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 i)
  (command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y)
  (command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x)
  (setq toado0 toado)
  (setq i (+ i 1))
 )
)
(command "layer" "s" "sohieu_diem" "")
(wdis toado toado1)
(setq canh (distance toado toado1))
  (setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
  (setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
  (setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
  (setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
  (setq psh (mapcar '+ p tsh))
  (setq pxx (mapcar '+ p txx))
  (setq pyy (mapcar '+ p tyy))
  (setq pgc (mapcar '+ p tgc))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 "1")
(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y1)
(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x1)
(setvar "osmode" old)
) ;(end progn)
) ;(end if)
(if (= st nil)
(progn
 (setvar "cmdecho" 1)
 (princ "Khong co layer 100")
)
)
)

<<

Filename: 225337_hh.lsp
Tác giả: thanhduan2407
Bài viết gốc: 102019
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD
Bạn cần sửa hàm SPLIT để đổi giá trị Code thành kiểu String.

(defun c:RFT(/ data ten f h line str Code Stt X Y Z ELE Code Code1 Pnt);;;;;Read...
>>
Bạn cần sửa hàm SPLIT để đổi giá trị Code thành kiểu String.

(defun c:RFT(/ data ten f h line str Code Stt X Y Z ELE Code Code1 Pnt);;;;;Read File Txt
(vl-load-com)
(defun Split (Str Char / Lst str pos)
 (while (setq pos (vl-string-search Char Str))
   (if (null Lst)
     (setq Lst (list (substr Str 1 pos)))
     (setq Lst (append Lst (list (read (substr Str 1 pos))))))
   (setq Str (substr Str (+ pos 2)) ))
 (setq Lst (append Lst (list Str)))  )  

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (setq f (open (findfile ten) "r"))
     (while
(setq Line (read-line f))	
(if (vl-string-search "\t" Line)
  (progn
    (setq data (split Line "\t" ))
    (setq Stt (nth 0 data))
    (setq X (nth 1 data))
    (setq Y (nth 2 data))
    (setq Z (nth 3 data))
    (setq Code (nth 4 data))	    
    (setq ELE (rtos z 2 2))
    (setq Pnt (list X Y Z))	    
    (command "insert"  "D_chitiet"  Pnt  1 1 0  Stt  ELE Code)	    ) ) ) ) )
 (command "zoom" "extents")
 (princ)
 )

Đã kiểm tra với dữ liệu :

1 4.376 5.577 12.000 123

2 3.576 3.777 10.000 abc

0 4.176 5.577 13.000 444

a 3.876 3.977 10.000 ddd

Chú ý : thêm dòng (setvar "AttReq" 1) vào Lisp nếu cần thiết.

Không biết phải nói như thế nào

Cảm ơn bác gia_bach rất nhiều


<<

Filename: 102019_rft.lsp
Tác giả: quansla
Bài viết gốc: 443197
Tên lệnh: tinh tong dim
Nhờ mọi người trợ giúp Lisp tính tổng Dimension

Oa hôm nay xem tin nhắn bạn nhắn riêng mới để ý lại, đúng rồi lisp không thể hoạt động được mình quên mất DXF70 của Dim

 

(defun c:tinh_tong_dim( / ent S dt lst_loc)
    (vl-load-com)
    (defun tinh_bit(N / kq r)
    (setq r '() kq 0)
    (while (and (/= N 0)
		(/= 0 (setq kq (fix (/ (log N ) (log 2 ))))))
      (setq r (append r (list kq))
	    N (rem N...
>>

Oa hôm nay xem tin nhắn bạn nhắn riêng mới để ý lại, đúng rồi lisp không thể hoạt động được mình quên mất DXF70 của Dim

 

(defun c:tinh_tong_dim( / ent S dt lst_loc)
    (vl-load-com)
    (defun tinh_bit(N / kq r)
    (setq r '() kq 0)
    (while (and (/= N 0)
		(/= 0 (setq kq (fix (/ (log N ) (log 2 ))))))
      (setq r (append r (list kq))
	    N (rem N (expt 2 kq)))
      )
    (if (= N 0)
      (setq r r)
      (setq r (append r (list 0))))
    (mapcar '(lambda (x) (expt 2 x)) r)
    )





  
  (setq S 0)

  ;Muon bo loai gi thi de ten no vao day
  (setq lst_loc '(4 3 2))
  ;Vi du o day la bo 4=ban kinh    3 = duong kinh   2=doc goc
  
;;;0 = Rotated, horizontal, or vertical
;;;1 = Aligned Dim Align
;;;2 = Angular Dim Goc
;;;3 = Diameter Dim duong kinh
;;;4 = Radius   Dim ban kinh
;;;5 = Angular 3-point Dim Cung tron ???
;;;6 = Ordinate Thuong ????

  
  (foreach dt (acet-ss-to-list (ssget '(( 0 . "*DIM*"))))
    (setq ent (entget dt))
    (if (not (member (apply '+ (vl-remove-if '(lambda (x) (member x '(32 64 128))) (tinh_bit (cdr (assoc 70 ent))))) lst_loc))
      (setq S (+ S (if (/= "" (cdr (assoc 1 ent))) (atof(cdr (assoc 1 ent))) (cdr (assoc 42 ent))))))
    )
  (princ (rtos S 2 4))
  (alert (strcat "L=" (rtos S 2 4)))
  (if (setq ss (ssget ":S" '((0 . "*TEXT"))))
    (progn
      (setq ent (entget (ssname ss 0))
	    txt (cdr(assoc 1 ent)))
      (if (setq pos (vl-string-search "=" txt))
	(setq txt (strcat (substr txt 1 (1+ pos)) (rtos S 2 4)))
	(setq txt (strcat "L=" (rtos S 2 4))))
    (entmod (subst (cons 1 txt) (assoc 1 ent) ent)))
    )
  (princ)
  )

Trong đoạn lisp trên mình đã để đoạn để bạn có thể sửa

(setq lst_loc '(4 3 2 5))

 

 

Tương ứng các số mình đã gi trong lisp, nếu bạn để số nào thì Dim tương ứng với số đó sẽ không được tính tổng

 

P/S phần tính Dim trừ khá dễ nhưng mình chưa ưng code trên lắm; Làm phiền mọi người trên diễn đàn góp ý giúp về Code được không ạ, cứ thấy có gì đó chưa ổn và cách để chọn đối tượng ban đầu nữa, giá mà nó lọc ngay từ lúc quét chọn thì tốt, ai có cách nào hay không ạ, Xin cảm ơn

 

 

Ghi chú cách sử dụng LISP

B1. Gõ lệnh Tinh_tong_dim

B2. Quét chọn tất cả các dim cần tính (LISP sẽ tự động loại bỏ không tính số liệu của "Bán kính" "đường kính" và "đo góc"

B3. LISP sẽ hiện kết quả dạng hộp thoại 

B4. Chọn Text/Mtext cần thay kết quả

Kết thúc lisp


<<

Filename: 443197_tinh_tong_dim.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 443142
Tên lệnh: te
Cộng trừ nhân chia các số trong block att
12 giờ trước, đặng phụng đã nói:

Trước tiên cảm ơn...

>>
12 giờ trước, đặng phụng đã nói:

Trước tiên cảm ơn anh Doan nguyen Van đã giúp đỡ chúc anh nhiều sức khõe. Nhưng sao chạy lisp trên gstarcad 2019 báo lỗi này bác ạ. Trên cad 2007 thì ok bác có thể chỉnh giúp e chạy trên gstarcad 2019 đc ko ạ.

Command:  TE Pick tag cong suat P:
Error:no function definition: ACET-DXF

Mình không dùng cad đó, bạn test lại hàm này xem, nếu cũng không được nốt thì mình thua

(defun c:te (/ ent tag lst tong ss)
  (setq ent  (car (nentsel "Pick tag cong suat P:")))
  (setq tag (cdr (assoc 2 (entget ent))) tong 0.0)
  (princ "\nQuet chon cac block")
  (setq ss (ssget (list (cons 0 "INSERT"))))
  (while (setq ent (ssname ss 0))
    (setq ss (ssdel ent ss))
    (if (setq lst (assoc  tag (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))
	    (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
	    ))) 
	  (setq tong (+ tong (distof (cdr lst) ))))
    )
(alert (rtos tong 2 2))
)

 


<<

Filename: 443142_te.lsp

Trang 305/330

305