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

Sửa lisp công độ cao

Các bài được khuyến nghị

Sửa lisp công độ cao

Kính chào các bạn!

Mình có Lisp: Đã làm được cộng độ cao-> đánh cdc enter vào giá trị công, trừ lisp công trừ đi giá trị mình vào vào cho giá trị đó vào 1 layer khác

Nay mình muốn nâng cấp lên như sau:

                 1. Trong tập hợp số thực chọn để nâng, hạ giá trị có các số thực ở các Layer khác nhau

                 2. Nay vẫn làm tính toán nhưng bổ sung thêm các layer khac nhau thì cho giá trị phép tính vào các layer khac nhau. Ví dụ

       layer1-> công, trừ -> cho kết quả evnew_1

       a2-> công, trừ -> cho kết quả evnew_2

.

.

.

       layer1N-> công, trừ -> cho kết quả evnew_N

Rất mong các bạn giúp đỡ.

Trân trong cảm ơn!

Đây là file nguồn của mình:

http://www.cadviet.com/upfiles/3/123341_cdc.lsp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nhờ các cao thủ chỉ giúp; nếu nhiều layer khó thì có thể 2, 3 layer cũng được mình đang cần quá

Nhườ bác Đoàn văn Hà, Phạm thanh Bình, KaKung, ThanhDuan- Thiên đường và các các cao thủ khác!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Đây bạn

(Defun Init()
 (setvar "BLIPMODE" 0)
 (setvar "CMDECHO" 0)
)
(Defun Reinit()
 (setvar "BLIPMODE" 1)
 (setvar "CMDECHO" 1)
 (setvar "LUPREC" 4)
 (princ)
)

(defun sai()
 (setq pt (cdr (assoc 10 lEi)))
 (setq hi (cdr (assoc 40 lEi)))
 (makeC pt hi)
)

(Defun MakeC( pt h / edt)
   (setvar "LUPREC" 2)
   (setq edt (list (cons 0 "CIRCLE")
                   (cons 8 "tron")
                   (cons 62 2)
                   (cons 10 pt)
                   (cons 40 (* hi 10))
             )
    )
    (entmake edt)
)
(Defun Makedocao( pt h stl hi wi / edt)
   (setvar "LUPREC" 2)
 

  (setq edt (list (cons 0 "text")
                   (cons 8 "Newelv")
                   (cons 62 5)
                   (cons 10 pt)
                   (cons 1 (rtos h 2))
                   (cons 7 stl)
                   (cons 40 hi)
                   (cons 41 (* wi 0.8))
                   (cons 71 1)
             )
    )
    (entmake edt)
)

(defun chelv( / stl pt hi wi)
 (setq stl (cdr (assoc 7 lEi)))
 (setq pt (cdr (assoc 10 lEi)))
 (setq hi (cdr (assoc 40 lEi)))
 (setq wi (cdr (assoc 41 lEi)))
 (makedocao pt (+ dc osdc) stl hi wi)
 (print i)
)

(defun c:cdc(/ osdc ss noet i ei dc)
 (Init)
 (setq la (getstring "\n Layer nao ? : "))
 (setq osdc (getdist "\n Cong them bao nhieu ? : "))
 (setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 la))))
 (setq NoET (sslength ss))
 (princ (strcat "\n" (itoa NoET) " Doi tuong se bi thay doi"))
 (getint)
 (setq i 0)
      (Repeat NoET
          (setq Ei (ssname ss i))
          (setq i (+ 1 i))
          (setq lEi (entget Ei))
          (if (null (read (cdr (assoc 1 lEi))))
              (progn
                    (sai)
              )
              (progn
                    (setq dc (read (cdr (assoc 1 lEi))))
                    (if (numberp dc) (chelv))
              )
          );if
      );Repeat
 (Reinit)
)
 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn thử cái này xem

 

(vl-load-com)
(Defun Init()
 (setvar "BLIPMODE" 0)
 (setvar "CMDECHO" 0)
)
(Defun Reinit()
 (setvar "BLIPMODE" 1)
 (setvar "CMDECHO" 1)
 (setvar "LUPREC" 4)
 (princ)
)

(defun sai()
 (setq pt (cdr (assoc 10 lEi)))
 (setq hi (cdr (assoc 40 lEi)))
 (makeC pt hi)
)

(Defun MakeC( pt h / edt)
   (setvar "LUPREC" 2)
   (setq edt (list (cons 0 "CIRCLE")
                   (cons 8 "tron")
                   (cons 62 2)
                   (cons 10 pt)
                   (cons 40 (* hi 10))
             )
    )
    (entmake edt)
)
(Defun Makedocao( pt h stl hi wi layer / edt)
   (setvar "LUPREC" 2)
 

  (setq edt (list (cons 0 "text")
                   (cons 8 layer)
                   (cons 62 5)
                   (cons 10 pt)
                   (cons 1 (rtos h 2))
                   (cons 7 stl)
                   (cons 40 hi)
                   (cons 41 (* wi 0.8))
                   (cons 71 1)
             )
    )
    (entmake edt)
)

(defun chelv( layer / stl pt hi wi)
 (setq stl (cdr (assoc 7 lEi)))
 (setq pt (cdr (assoc 10 lEi)))
 (setq hi (cdr (assoc 40 lEi)))
 (setq wi (cdr (assoc 41 lEi)))
 (makedocao pt (+ dc osdc) stl hi wi layer)
 (print i)
)

(defun c:cdc(/ osdc ss noet i ei dc list_layer ii EN LAYER_NAME LEI SS_LAYER TENLAYER)
 (Init)
 (setq list_layer (list))
 ;(setq la (getstring "\n Layer nao ? : "))
 (princ "\nChon doi tuong layer mau:");;;princ
 (setq ss_layer (ssget))
 (setq i 0 );;;setq 
 (while (< i (sslength ss_layer))
    (setq en (ssname ss_layer i))
	(setq layer_name  (cdr (assoc 8 (entget en))));;;setq
	;(princ layer_name)
    (setq list_layer (append list_layer (list layer_name)))
    (setq i (1+ i))
  )
(setq list_layer (LM:Unique list_layer))
(setq ii 0 );;;setq 
(setq osdc (getdist "\n Cong them bao nhieu ? : "))
(while (< ii (length list_layer))
 (setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 (nth ii list_layer)))))
 (setq NoET (sslength ss))
 (setq tenlayer (nth ii list_layer))
 ;(princ (strcat "\n" (itoa NoET) " Doi tuong se bi thay doi"))
 ;(getint)
 (setq i 0)
      (Repeat NoET
          (setq Ei (ssname ss i))
          (setq i (+ 1 i))
          (setq lEi (entget Ei))
          (if (null (read (cdr (assoc 1 lEi))))
              (progn
                    (sai)
              )
              (progn
                    (setq dc (read (cdr (assoc 1 lEi))))
                    (if (numberp dc) (chelv  (strcat "evnew_" (itoa (1+ ii)))))
              )
          );if
      );Repeat
(setq ii (1+ ii))
)
 (Reinit)
)
(defun LM:Unique ( l / x r )
    (while l
        (setq x (car l)
              l (vl-remove x (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn có thể giúp mình thêm thế này được không:

Lúc công trừ trên 1 bản vẽ có thể làm nhiều lần nhưng mỗi lần tự tìm các layer cùng tên thì cho vào các layer cùng tên tương ứng (vì mình vừa xem chương trình của bạn nếu chạy lại lần nữa thì các layer đích bị thay đổi:

LẦN 1:

    layer1-> công, trừ -> cho kết quả evnew_1

       a2-> công, trừ -> cho kết quả evnew_2

.

       layer1N-> công, trừ -> cho kết quả evnew_N

LẦN 2:

    layer1-> công, trừ -> cho kết quả evnew_1

       a2-> công, trừ -> cho kết quả evnew_2

.

       layer1N-> công, trừ -> cho kết quả evnew_N

...

CẢM ƠN BẠN NHIỀU

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nếu ko quan trọng tên layer đích thì bạn thay đoạn:

(chelv (strcat "evnew_" (itoa (1+ ii))))

bằng

 ( chelv   ( strcat   "evnew_" tenlayer  ))

 

Nếu vẫn muốn phải là evnew_1,evnew_2...evnew_N. thì sửa sẽ phức tạp lên nhiều.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nếu ko quan trọng tên layer đích thì bạn thay đoạn:

(chelv (strcat "evnew_" (itoa (1+ ii))))

bằng

 ( chelv   ( strcat   "evnew_" tenlayer  ))

 

Nếu vẫn muốn phải là evnew_1,evnew_2...evnew_N. thì sửa sẽ phức tạp lên nhiều

 

Mình chuyển như bạn nói chương trình chạy ngay là: nó chọn tên lớp và trong lớp vừa chon đấy có đối tượng nào là nó tính công, trừ hết luôn nên không đúng ý

Ý mình là làm nhiều lần và mỗi lần thì layer đích là:

layer1 -> evnew_layer1

và ... Bạn ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Anh Phước thử dùng LISP này em vừa viết xem sao.

(defun c:cdc(/ osdc ss noet i ei dc list_layer ii EN LAYER_NAME LEI SS_LAYER TENLAYER)
(setq Delta (getreal "\n Nhap gia tri cong them: "))
(setq i 0)
(setq ssChon  (ssget))
(setq ss_So  (ChonTextSo ssChon))
(setq Lts_so (acet-ss-to-list ss_So))
(while (< i   (length Lts_so))
  (progn
	(setq E_Text (nth  i Lts_so))
  	(setq Item (entget E_Text))
  	(setq Caodo  (atof (cdr (assoc 1 Item))))
	(setq Layer_Text  (cdr (assoc 8 Item)))
    	(setq Color_Text  (cdr (assoc 62 Item)))
  	(setq Tenphu (Tachtenchinhphu Layer_Text))
  	(setq Layer_Text_moi (strcat "Evnew_"  Tenphu))
	(setq Caodo_moi (+ Caodo Delta))
    	(setq Item (subst (cons 1 (rtos Caodo_moi)) (assoc 1 Item) Item )) 
	(entmod Item)
    	(setq Item (subst (cons 8 Layer_Text_moi) (assoc 8 Item) Item ))
    	(entmod Item)
        (setq Item (subst (cons 62 Color_Text) (assoc 62 Item) Item ))
    	(entmod Item)
   )
   (setq i (1+ i))
)
(princ)
)
(defun ChonTextSo (ss / i ent str ss1) 
    (progn
      (setq i	0
	    ss1	(ssadd)
      )
      (repeat (sslength ss)
	(setq ent (ssname ss i)
	      str (cdr(assoc 1 (entget ent)))
	      i	  (+ 1 i)
	)
	(if (distof str 2)
	  (ssadd ent ss1)
	)
      )
      (if (> (sslength ss1) 0)
	ss1
      )      
    )
)

(defun Tachtenchinhphu(Name /)
	(setq tm_i 1 so nil Tenchinh "" Tenphu "")
	(repeat (strlen Name)
		(setq ch (substr Name tm_i 1))
		(if (= tm_i 1)
		   (progn
			(setq Tenchinh ch)
			(if (and (<= (ascii ch) 57)(>= (ascii ch) 48))
				(setq so T)
				(setq so nil)
			)
		   )
		   (progn
			(if so 
				(if (and (<= (ascii ch) 57)(>= (ascii ch) 48))
					(setq Tenchinh (strcat Tenchinh ch))
					(setq Tenphu (strcat Tenphu ch))
				)
				(if (and (<= (ascii ch) 57)(>= (ascii ch) 48))
					(setq Tenphu (strcat Tenphu ch))
					(setq Tenchinh (strcat Tenchinh ch))
				)
			)
		   )
		)
		(setq tm_i (+ tm_i 1))
	);
  Tenphu
)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Mình chuyển như bạn nói chương trình chạy ngay là: nó chọn tên lớp và trong lớp vừa chon đấy có đối tượng nào là nó tính công, trừ hết luôn nên không đúng ý

Ý mình là làm nhiều lần và mỗi lần thì layer đích là:

layer1 -> evnew_layer1

và ... Bạn ạ

Mình ko hiểu ý bạn lắm. Ở lisp của mình thì bước đầu tiên là chọn chọn đối tượng để lấy tên layer của nó. Nếu bạn muốn tính cho toàn bộ các TEXT thuộc layer nào thì trong bước chọn đầu tiên chọn đối tượng có tên layer muốn tính.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×