(Xin lisp) Dim ghi số lượng nhân với khoảng cách

[TKTXVD 1]

Mình hay phải Dim trên Dim thể hiện khoảng cách nhân với số lượng, ai có lisp khi đánh lệnh nhập khoảng cách VD: 250  rồi Dim sẽ được 250 x số lượng = Khoảng cách (hình vẽ)

[Danh Cong 422]

Nếu ko ai viết thì tối về mình gửi cho bạn :))

[thanhtvgt 1]

defun c:BT(/ ss i ename bthep)
(setq bthep (getreal "\nNhap buoc thep :"))
 (princ "\n Chon DIMENSION :")
 (if (setq ss (ssget '((0 . "DIMENSION"))))
   (progn (setq i -1) 
   (while (setq ename (ssname ss (setq i (1+ i))))
     (command "dimedit"  "n" (strcat (itoa (fix (/ (atoi (rtos (cdr(assoc 42 (entget ename))) 2 0)) bthep)) )
    "x" (rtos bthep 2 0) "=<>") ename "" )
   )
 )))

[Danh Cong 422]

Code cho bạn, lisp này có thể đếm số lượng thép theo:

1 : Theo khoảng cách

2 ; Theo số lượng;

3 : Theo khoảng cách, số lượng  với Dim đã bị sửa số;

	(defun c:DEM ( / #DEM-KHOANG-CACH #DEM-SO-LUONG #DEMTHEP-NAME E1 E42 EDXF ENAME ENEW OBJECT)



	  (command "undo" "begin")



	  (or #DEMTHEP-NAME (setq #DEMTHEP-NAME "KHOANG-CACH-1"))



	  (initget "KHOANG-CACH-1 KHOANG-CACH-2 SO-LUONG-1 SO-LUONG-2 SUA-KHOANG-CACH SUA-SO-LUONG")



	  (setq #DEMTHEP-NAME (cond ((getkword (strcat "\nSelect Program: [KHOANG-CACH-1/KHOANG-CACH-2/SO-LUONG-1/SO-LUONG-2/SUA-KHOANG-CACH/SUA-SO-LUONG] <"#DEMTHEP-NAME">")))(#DEMTHEP-NAME)))



	 



	  (cond ((or (= #DEMTHEP-NAME "KHOANG-CACH-1") (= #DEMTHEP-NAME "KHOANG-CACH-2") (= #DEMTHEP-NAME "SUA-KHOANG-CACH"))



	(or #DEM-KHOANG-CACH (setq #DEM-KHOANG-CACH 150.0))



	  (setq #DEM-KHOANG-CACH (cond ((getreal (strcat "\nNhap khoang cach buoc thep: < " (rtos #DEM-KHOANG-CACH 2 0) " >:")))(#DEM-KHOANG-CACH))))



	      ((or (= #DEMTHEP-NAME "SO-LUONG-1") (= #DEMTHEP-NAME "SO-LUONG-2") (= #DEMTHEP-NAME "SUA-SO-LUONG"))



	(or #DEM-SO-LUONG (setq #DEM-SO-LUONG 10))



	  (setq #DEM-SO-LUONG (cond ((getreal (strcat "\nNhap so luong thanh thep: < " (rtos #DEM-SO-LUONG 2 0) " >:")))(#DEM-SO-LUONG))))



	      ); End Cond



	(setq Object (ssget'((0 . "DIMENSION"))))



	(repeat  (sslength Object)



	(setq Ename (ssname Object 0)



	       Edxf (entget Ename)



	       E42 (cdr (assoc 42 Edxf)))



	 (cond ((or (= #DEMTHEP-NAME "KHOANG-CACH-1") (= #DEMTHEP-NAME "KHOANG-CACH-2")) (setq E1 (/ E42 #DEM-KHOANG-CACH)))



	       ((or (= #DEMTHEP-NAME "SO-LUONG-1")    (= #DEMTHEP-NAME "SO-LUONG-2"))    (setq E1 (/ E42 #DEM-SO-LUONG)))



	       ((= #DEMTHEP-NAME "SUA-KHOANG-CACH")   (setq E1 (/ (atof (cdr (assoc 1 Edxf))) #DEM-KHOANG-CACH)))



	       ((= #DEMTHEP-NAME "SUA-SO-LUONG")      (setq E1 (/ (atof (cdr (assoc 1 Edxf))) #DEM-SO-LUONG))))



	 



	  (cond ((= #DEMTHEP-NAME "KHOANG-CACH-1") (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0) "=<>")) (assoc 1 Edxf) Edxf)))



	((= #DEMTHEP-NAME "KHOANG-CACH-2") (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0))) (assoc 1 Edxf) Edxf)))



	((= #DEMTHEP-NAME "SO-LUONG-1")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 1) "=<>")) (assoc 1 Edxf) Edxf)))



	((= #DEMTHEP-NAME "SO-LUONG-2")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 0))) (assoc 1 Edxf) Edxf)))



	((= #DEMTHEP-NAME "SUA-KHOANG-CACH")    (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0) "=" (cdr (assoc 1 Edxf)))) (assoc 1 Edxf) Edxf)))



	((= #DEMTHEP-NAME "SUA-SO-LUONG")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 1) "=" (cdr (assoc 1 Edxf)))) (assoc 1 Edxf) Edxf))))



	  (entmod Enew)



	  (if (and (> (abs (- (* (atof (rtos E1 2 0)) #DEM-KHOANG-CACH) E42)) 0.1) (or (= #DEMTHEP-NAME "KHOANG-CACH-1")



	       (= #DEMTHEP-NAME "KHOANG-CACH-2")))



	    (vla-put-Textcolor (vlax-ename->vla-object Ename) 1)



	    (vla-put-Textcolor (vlax-ename->vla-object Ename) 3))



	  (ssdel Ename Object)



	  ); end repeat



	(command "undo" "end")



	(princ))

[TKTXVD 1]

Bác Danh Cong & thanhtvgt ơi, lisp của 2 bác đánh lệnh cad nó không hiểu (CAD2007 & 2020) các bác có thể sửa đc ko

[Danh Cong 422]

21 giờ trước, TKTXVD đã nói:

Bác Danh Cong & thanhtvgt ơi, lisp của 2 bác đánh lệnh cad nó không hiểu (CAD2007 & 2020) các bác có thể sửa đc ko

Bạn copy các dòng code về dán vào file txt, rồi tự tạo file lisp ( Không nhấn nút dowload trên diễn đàn, diễn đàn đang bị lỗi ).

Ngoài ra, để ý xem lisp có load được hay chưa, hoặc lisp không dùng được thì màn hình thông báo lỗi gì.

 

[TKTXVD 1]

Vào lúc 5/5/2020 tại 07:33, Danh Cong đã nói:

Bạn copy các dòng code về dán vào file txt, rồi tự tạo file lisp ( Không nhấn nút dowload trên diễn đàn, diễn đàn đang bị lỗi ).

Ngoài ra, để ý xem lisp có load được hay chưa, hoặc lisp không dùng được thì màn hình thông báo lỗi gì.

 

lisp okie rồi bác...thank bác nhiều