Đến nội dung


Hình ảnh
- - - - -

Sửa lisp công độ cao


  • Please log in to reply
22 replies to this topic

#1 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 12:22 PM

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.c.../123341_cdc.lsp


  • 0

#2 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 01:19 PM

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!


  • 0

#3 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 29 July 2014 - 02:35 PM

Ko down được lisp của bạn gửi


  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#4 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 03:07 PM

Mình đưa lại đây

Cảm ơn bạn đã quan tâm

http://www.cadviet.c...23341_cdc_1.lsp


  • 0

#5 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 29 July 2014 - 04:20 PM

Vẫn ko đc bạn ạ. Bạn thử up lên chỗ khác xem


  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#6 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 04:30 PM

Đâ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)
)
 


  • 0

#7 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 29 July 2014 - 06:20 PM

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)
)

  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#8 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 07:35 PM

Bái phục bạn  nguyentuyen6

Cảm ơn bạn rất nhiều!

Chúc bạn luôn gặp nhiều may mắn và thành công trong cuộc sống!


  • 0

#9 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 07:42 PM

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


  • 0

#10 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 29 July 2014 - 08:18 PM

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.


  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#11 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 08:29 PM

CẢM ƠN BẠN Ý MÌNH CŨNG LÀ CẦN "evnew_" tenlayer

CẢM ƠN BẠN RẤT NHIỀU!


  • 0

#12 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 08:38 PM

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 ạ


  • 0

#13 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 July 2014 - 08:54 PM

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
)

  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#14 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 08:55 PM

Cảm ơn chú nhé!


  • 0

#15 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 08:58 PM

Duân ới chạy CDC sau khi vào số cộng đánh enter nó báo: Select objects:  ; error: bad argument type: stringp nil


  • 0

#16 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 July 2014 - 08:59 PM

Anh chạy thử xem nào.

Chưa hiểu í anh lắm. :D


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#17 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 July 2014 - 09:01 PM

Em chạy ngon anh ạ

http://www.cadviet.c...ru_voi_1_so.lsp


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#18 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 09:02 PM

Tức là anh load xong chạy nó báo thế mà (không chạy được)!


  • 0

#19 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 July 2014 - 09:05 PM

Sao rồi anh? 


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#20 DanKhaosat

DanKhaosat

    biết lệnh scale

  • Members
  • PipPipPip
  • 149 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 29 July 2014 - 09:11 PM

Chay lại được nhưng thé nào lúc được lúc không nhỉ!

Và chú cho 2 số sau đáu phảy thôi; giữ nguyên layer cũ đừng xóa đi nhé!


  • 0