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

Nhờ sửa lip tính cốt đai và ghi vào trong dim

Bởi CASAUBAOCHUA , trong AutoLisp

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

CASAUBAOCHUA    2

CASAUBAOCHUA
Đã đăng

Em có cái lip cad như này tải trên mạng về có bác nào chỉ em với em muốn tính số lượng đai theo các cách tính như (L-200)/a+1 mọi người chỉ em cách sửa lip với

;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------

(defun C:gt(/ ctc ss)
  (or *ctc* (setq *ctc* 200))
  (initget 6)
  (setq ctc (getint (strcat"\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < " (itoa *ctc*) ">:")) )
  (if ctc (setq *ctc* ctc))
  (if (setq ss (ssget"_:L" (list (cons 0 "DIMENSION")) ))
    (progn
      (command "_.undo" "_begin")    
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextOverride (vlax-ename->vla-object ent)
   (strcat "<>\\X" (itoa (+ (fix(/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
    "%%c10A" (itoa *ctc*)))    )
      (command "_.undo" "_end") (princ)  )))
(defun C:cl(/ num ss)
  (if (setq ss (ssget"_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat"\nNhap color <" (itoa *num*) ">:")) )
      (while (not (if num (<= num 256)T) )
(princ "\nGia tri <=256.")
(setq num (getint (strcat"\nNhap color <" (itoa *num*) ">:")) ))
      (if num (setq *num* num))
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-Color (vlax-ename->vla-object ent)*num* )    )
      (command "_.undo" "_end") (princ)  )))
 

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

tien2005    259

tien2005
Đã đăng

Đây nè Bạn, theo đúng yêu cầu. Hết 

;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------

(defun C:gt (/ ctc ss)
  (or *ctc* (setq *ctc* 200))
  (initget 6)
  (setq	ctc (getint
	      (strcat "\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < "
		      (itoa *ctc*)
		      ">:"
	      ) ;_ end of strcat
	    ) ;_ end of getint
  ) ;_ end of setq
  (if ctc
    (setq *ctc* ctc)
  ) ;_ end of if
  (if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION"))))
    (progn
      (command "_.undo" "_begin")
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-TextOverride
	  (vlax-ename->vla-object ent)
	  (strcat
	    "<>\\X"
;;;	    (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
	    (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
	    "%%c10A"
	    (itoa *ctc*)
	  ) ;_ end of strcat
	) ;_ end of vla-put-TextOverride
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:cl (/ num ss)
  (if (setq ss (ssget "_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      (while (not (if num
		    (<= num 256)
		    T
		  ) ;_ end of if
	     ) ;_ end of not
	(princ "\nGia tri <=256.")
	(setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      ) ;_ end of while
      (if num
	(setq *num* num)
      ) ;_ end of if
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-Color (vlax-ename->vla-object ent) *num*)
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

 

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

laivanyen    2

laivanyen
Đã đăng
Vào lúc 21/4/2019 tại 20:07, tien2005 đã nói:

Đây nè Bạn, theo đúng yêu cầu. Hết 


;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------

(defun C:gt (/ ctc ss)
  (or *ctc* (setq *ctc* 200))
  (initget 6)
  (setq	ctc (getint
	      (strcat "\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < "
		      (itoa *ctc*)
		      ">:"
	      ) ;_ end of strcat
	    ) ;_ end of getint
  ) ;_ end of setq
  (if ctc
    (setq *ctc* ctc)
  ) ;_ end of if
  (if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION"))))
    (progn
      (command "_.undo" "_begin")
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-TextOverride
	  (vlax-ename->vla-object ent)
	  (strcat
	    "<>\\X"
;;;	    (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
	    (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
	    "%%c10A"
	    (itoa *ctc*)
	  ) ;_ end of strcat
	) ;_ end of vla-put-TextOverride
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:cl (/ num ss)
  (if (setq ss (ssget "_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      (while (not (if num
		    (<= num 256)
		    T
		  ) ;_ end of if
	     ) ;_ end of not
	(princ "\nGia tri <=256.")
	(setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      ) ;_ end of while
      (if num
	(setq *num* num)
      ) ;_ end of if
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-Color (vlax-ename->vla-object ent) *num*)
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

 

Em không muốn xuống dòng mà để ngang ở trên và sửa lại  ví dụ 8000=40x200  hoặc 40x200=8000 thì sửa như nào anh giúp em với

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

tien2005    259

tien2005
Đã đăng
1 giờ} trướ}c, laivanyen đã nói:

Em không muốn xuống dòng mà để ngang ở trên và sửa lại  ví dụ 8000=40x200  hoặc 40x200=8000 thì sửa như nào anh giúp em với

 

tìm các dòng 

(strcat
	    "<>\\X"
;;;	    (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
	    (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
	    "%%c10A"
	    (itoa *ctc*)
	  ) ;_ end of strcat

 

rồi sửa lại: 

(strcat
;;;	    (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
	    (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
	    "%%c10A"
	    (itoa *ctc*)
		" - <>"
	  ) ;_ end of strcat

 

  • Like 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

anhGeodesy    2

anhGeodesy
Đã đăng
16 giờ trước, laivanyen đã nói:

Em không muốn xuống dòng mà để ngang ở trên và sửa lại  ví dụ 8000=40x200  hoặc 40x200=8000 thì sửa như nào anh giúp em với

Xin phép @tien2005 sửa thế này không biết có đúng ý của chủ thớt không? 

; https://www.cadviet.com/forum/topic/175922-nhờ-sửa-lip-tính-cốt-đai-và-ghi-vào-trong-dim/

;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------

(defun C:gt (/ ctc ss)
  (or *ctc* (setq *ctc* 200))
  (or *d* (setq *d* 10))
  (initget 6)
  (setq    ctc (getint
          (strcat "\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < "
              (itoa *ctc*)
              ">:"
          ) ;_ end of strcat
        ) ;_ end of getint
  ) ;_ end of setq
  (if ctc
    (setq *ctc* ctc)
  ) ;_ end of if
  (setq    d (getstring
          (strcat "\nNh\U+1EADp \U+0110\U+01B0\U+1EDDng k\U+00EDnh th\U+00E9p (Phi) < "
               *d*
              ">:"
          ) ;_ end of strcat
        ) ;_ end of getint
  )
  (if d
    (setq *d* d)
  )
  (if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION"))))
    (progn
      (command "_.undo" "_begin")
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (vla-put-TextOverride
      (vlax-ename->vla-object ent)
;;;      (strcat
;;;        "<>\\X"
;;;;;;        (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
;;;        (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
;;;        ;"%%c10A"
;;;        (strcat "%%c" d "a")
;;;        (itoa *ctc*)
;;;      ) ;_ end of strcat

(strcat
;;;        (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
  "<> ="
        (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
        ;"%%c10A"
            (strcat "%%c" d "a")
        (itoa *ctc*)
;;;" - <>"
      ) ;_ end of strcat?

      
    ) ;_ end of vla-put-TextOverride
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:cl (/ num ss)
  (if (setq ss (ssget "_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      (while (not (if num
            (<= num 256)
            T
          ) ;_ end of if
         ) ;_ end of not
    (princ "\nGia tri <=256.")
    (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      ) ;_ end of while
      (if num
    (setq *num* num)
      ) ;_ end of if
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (vla-put-Color (vlax-ename->vla-object ent) *num*)
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

 

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
Về Đầu Trang AutoLisp
×