Nhờ sửa lisp cộng tăng dần với số bất kỳ

[friendship293a 10]

Em đang cần cái lisp cộng tăng dần cụ thể thế này.

Chọn số bắt đầu (trên màn hình)

nhập số cộng thêm (số có thể là số thập phân vd 1.25 hay 0.25 ...)

sau đó copy cộng thêm nó giống lệnh OC trong lisp này nhưng ở lisp này không cho số cộng thêm là giá trị thập phân chỉ cho số nguyên. ai giúp e sửa lại với ạ

;;;------------------------------------------------------------------------------------
(defun getTw();;;Get textstyle
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th);;;Get textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p);;;Entmake text S at p
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
(cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun incN (n dn / n2 i n1);;;Increase number n
(setq
n2 (itoa (+ dn (atoi n)))
i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;------------------------------------------------------------------------------------
(defun incC (c / i c1 c2);;;Increase character c
(setq
i (strlen c)
c1 (substr c 1 (- i 1))
c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
(progn (command "erase" (entlast) "") (alert "Over character!") (exit))
(strcat c1 c2)
)
)
;;;==============================================
(defun C:OD( / cn dn c n p);;;Make OrDinal number with any format
(setq
cn (getstring "\nBegin at <1>: " T)
dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point : "))
(emkT cn p)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
)
(princ)
)
;;;==============================================
(defun C:OC( / e dn p1 cn c n p2 dat);;;Make Ordinal number. Copy from template
(setq
e (car (entsel "\nSelect template text:"))
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point : "))
(command "copy" e "" p1 p2)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
(setq
dat (entget (entlast))
dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
)
(princ)
)
;;;==============================================

[master_worse 88]

Em đang cần cái lisp cộng tăng dần cụ thể thế này.

Chọn số bắt đầu (trên màn hình)

nhập số cộng thêm (số có thể là số thập phân vd 1.25 hay 0.25 ...)

sau đó copy cộng thêm nó giống lệnh OC trong lisp này nhưng ở lisp này không cho số cộng thêm là giá trị thập phân chỉ cho số nguyên. ai giúp e sửa lại với ạ

Tạm thời làm thế này:

(defun c:+c (/ b p1 p2 cong value dimzin)
(defun *error* (msg) (and dimzin (setvar "dimzin" dimzin)) (setq *error* nil) (princ))
(while (null (setq b (ssget ":S" '((0 . "TEXT") (1 . "~*[~0-9]*,~*[~0-9`.0-9]*")))))
 (princ "\nKhong phai so. Chon lai.")
);_ end while
(setq dimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(setq b	 (ssname b 0)
   value (cdr (assoc 1 (entget b)))
);_ end setq
(or *cong* (setq *cong* 1.0))
(or (setq cong (getreal (strcat "\nNhap so cong them: <" (rtos *cong* 2 2) ">")))
 (setq cong *cong*)
);_ end or
(setq *cong* cong)
(setq p1 (getpoint "\nDiem moc: "))
(while (setq p2 (getpoint p1 "\nDiem tiep theo: "))
 (command "copy" b "" p1 p2)
 (setq value (rtos (+ cong (atof value)) 2 2))
 (entmod (subst (cons 1 value) (assoc 1 (entget (entlast))) (entget (entlast))))
);_ end while
(setvar "dimzin" dimzin)
(setq *error* nil)
(princ)
);_ end defun

Chỉnh sửa Tháng 10 22, 2010 theo master_worse

[ro88 2]

Tạm thời làm thế này:

(defun c:+c (/ b p1 p2 cong value dimzin)
(defun *error* (msg) (and dimzin (setvar "dimzin" dimzin)) (setq *error* nil) (princ))
(while (null (setq b (ssget ":S" '((0 . "TEXT") (1 . "~*[~0-9]*,~*[~0-9`.0-9]*")))))
 (princ "\nKhong phai so. Chon lai.")
);_ end while
(setq dimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(setq b     (ssname b 0)
      value (cdr (assoc 1 (entget B)))
);_ end setq
(or *cong* (setq *cong* 1.0))
(or (setq cong (getreal (strcat "\nNhap so cong them: <" (rtos *cong* 2 2) ">")))
    (setq cong *cong*)
);_ end or
(setq *cong* cong)
(setq p1 (getpoint "\nDiem moc: "))
(while (setq p2 (getpoint p1 "\nDiem tiep theo: "))
 (command "copy" b "" p1 p2)
 (setq value (rtos (+ cong (atof value)) 2 2))
 (entmod (subst (cons 1 value) (assoc 1 (entget (entlast))) (entget (entlast))))
);_ end while
(setvar "dimzin" dimzin)
(setq *error* nil)
(princ)
);_ end defun

 

Bạn ơi có thể cho kết quả xuất ra đè lên text cũ được ko vậy?

[quansla 259]

Bạn ơi có thể cho kết quả xuất ra đè lên text cũ được ko vậy?

Cũng cho mình hỏi bạn sửa lisp này có cùng mục đích như chủ pic không, mình thấy chủ pic trong lisp đăng lên có yêu cầu về điểm mốc( mình không biết điểm mốc này dùng để làm gì?) còn bạn bạn có cần điểm mốc nữa không, có giữ lại lựa chọn : chọn điểm tiếp theo nữa không( tức là có hai lựa chọn :1 chọn tiếp điểm tiếp theo như lisp chủ pic đăng, 2 là theo ý bạn chọn Text và chèn luôn vô Text đó

Không rõ mình hiểu đúng và hỏi đúng không? bạn trả lời lại rồi mình giúp cho

[ro88 2]

Mình ko cần điểm mốc bạn à.Vẫn giũ lại điểm tiếp theo rồi chọn text và đè lên text đó.

[quansla 259]

Mình ko cần điểm mốc bạn à.Vẫn giũ lại điểm tiếp theo rồi chọn text và đè lên text đó.

Bạn có thể thử thế này

(defun c:Test(/ )
 (defun *error* (msg)
(and dimzin (setvar "dimzin" dimzin))
(setq *error* nil)
(princ))
 (or #cong (setq #cong 1.00))

 (while (null (setq ss (ssget ":S" '((0 . "TEXT") (1 . "~*[~0-9]*,~*[~0-9`.0-9]*")))))
(princ "\nKhong phai so. Chon lai.")
)
 (setq dimzin (getvar "dimzin"))
 (setq b (ssname ss 0)
value (cdr(assoc 1 (entget B))))
 (setq
#cong (cond ((getreal (strcat "\nNhap so cong them: <" (rtos #cong 2 3) "> :")))(#cong)))
 (while (setq Text (entsel "\nChon Text chen"))   
(setq Text (entget(car Text)))
(setq value (rtos (+ #cong (atof value)) 2 3))
(entmod(subst (cons 1 value) (assoc 1 TEXT) TEXT))
)
 (setvar "dimzin" dimzin)
 (setq *error* nil)
 (princ)
 )

Khả năng của mình thì chỉ giúp được bạn đến thế này thôi, mình đang tìm hiểu xem cách lấy bao nhiêu số sau dấu phẩy ở kết quả dựa vào số chữ só sau dấu phẩy của biến cộng thêm do người dùng nhập nhưng chưa biết đếm nó để mình thử sửa dần xem sao. Hiện tại là chính xác đến 0.001 Nếu chưa có hy vọng diễn đàn có người giúp bạn thêm

[quansla 259]

Mình ko cần điểm mốc bạn à.Vẫn giũ lại điểm tiếp theo rồi chọn text và đè lên text đó.

 

Sao đã có dòng màu đỏ lại có dòng màu xanh hả bạn. Hay ý bạn là có đồng thời hai lựa

cách 1 dùng chuột để xác định vị trí chèn text

cách 2 dùng Text có sẵn để sửa lại giá trị

???

[ro88 2]

Đúng roi quansla a

Sử dụng đồng thời 2 lựa chọn lun

mà mình chỉ cần lấy kết quả la số chẵn thôi.

VD:1300+50=1350, lisp xuất ra là 1350,00 mình ko cần lấy 2 số sau dấu phẩy

Thanks bạn đã quan tâm

[quansla 259]

Đúng roi quansla a

Sử dụng đồng thời 2 lựa chọn lun

mà mình chỉ cần lấy kết quả la số chẵn thôi.

VD:1300+50=1350, lisp xuất ra là 1350,00 mình ko cần lấy 2 số sau dấu phẩy

Thanks bạn đã quan tâm

Bạn có thể thử

;;HD su dung
;;1   Ten lenh: cong
;;2   Neu hay dung chon Text chen thi giu nguyen lisp nhu cu
;;;;;;Neu hay dung chon diem viet Text hon thi doi lai thu tu 2 vong Progn
;;chieu cao chu trong lisp duoc xac dinh bang Tich cua DIMScale va DIMtxt
;;sua lai bang cach thay
;;;;;;;;;;;;;;(cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
;;;;;;;;;;boi (cons 40 250) chang han se co chieu cao la 250
;;;Lisp khong kiem tra tinh dung dan cua viec nguoi dung cho data dau (chon dau dung doi tuong chua
;;;;doi tuong da la Text chua, Text da bao gom chi la so chua
;;Vi nhan thay khong can thiet, nguoi dung tu kiem tra tinh dung dan khi su dung, neu can minh se sua sau
(defun c:cong ( / value #k Text xText p) 
 (or #cong (setq #cong 1))
 (setq #cong (cond ((getreal (strcat "Gia tri cong: <" (rtos #cong 2 2) "> :")))(#cong)))
 (setq value (entsel "\nChon Text dau")
value (cdr(assoc 1 (entget(car value)))))
 (setq text nil p nil)
 (while (or (setq Text (entsel "\nNhap Text sua or [Diem chen] "))  
 	(setq p (getpoint "\nNhap vi tri chen Text")))   
(If Text
 	(progn  ;;Chen len Text
(setq xText (cdr(assoc 1 (entget(car Text))))
  	value (rtos(+ (atof value) #cong )))
(entmod (subst (cons 1 value) (assoc 1 (entget(car Text))) (entget(car Text))))
)
 	(progn ;;;chon diem chen Text
(setq value (rtos(+ (atof value) #cong )))
(entmake
  (list
	'(0 . "TEXT")
	'(100 . "AcDbEntity")
	'(100 . "AcDbText")
	(cons 1 value)
	(cons 7 (getvar "textstyle"))
	(cons 8 (getvar "clayer"))
	(cons 62 256)
	(cons 10 p)
	(cons 11 p)
	(cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
	(cons 41 1.0)
	(cons 50 0.0)
	(cons 51 0.0)
	'(71 . 0)
	'(72 . 0)
	'(73 . 0)
	))
);end_progn2
 	);end_IF
) ;end_While
 (princ)
 )

[ro88 2]

Thanks quansla

ok rồi

[ro88 2]

quansla ơi.Sửa lại giúp mình cao text với

VD:khi chọn text đầu A cao text=1.25 thì khi +vào 50 thì text kết quả có cao text bằng A cũng là 1.25

P/s: có nghĩa là cao text của điểm đầu bao nhiêu thì kết quả ra cao text cũng như vậy

Mình ko rành về lisp bạn sửa lại dùm nhé

Thanks nhiều.

[quansla 259]

quansla ơi.Sửa lại giúp mình cao text với

VD:khi chọn text đầu A cao text=1.25 thì khi +vào 50 thì text kết quả có cao text bằng A cũng là 1.25

P/s: có nghĩa là cao text của điểm đầu bao nhiêu thì kết quả ra cao text cũng như vậy

Mình ko rành về lisp bạn sửa lại dùm nhé

Thanks nhiều.

Được mà, có điều bạn toàn thanks mà không ấn like gì, Hix

(defun c:cong ( / laD TextD value #k hText Text xText p)
 (or #cong (setq #cong 1))
 (setq #cong (cond ((getreal (strcat "Gia tri cong: <" (rtos #cong 2 2) "> :")))(#cong)))
 (setq TextD (entsel "\nChon Text dau")
value (cdr(assoc 1 (entget(car TextD))))
hText (cdr(assoc 40 (entget(car TextD))))
laD   (cdr(assoc 8 (entget(car TextD)))))
 (setq text nil p nil)
 (while (or (setq Text (entsel "\nNhap Text sua or [Diem chen] "))
 	(setq p (getpoint "\nNhap vi tri chen Text")))
(If Text
 	(progn  ;;Chen len Text
(setq xText (cdr(assoc 1 (entget(car Text))))
  	value (rtos(+ (atof value) #cong )))      
(entmod (subst (cons 1 value) (assoc 1 (entget(car Text))) (entget(car Text))))
(entmod (subst (cons 40 htext) (assoc 40 (entget(car Text))) (entget(car Text))))
(entmod (subst (cons 8 laD) (assoc 40 (entget(car Text))) (entget(car Text))))
)
 	(progn ;;;chon diem chen Text
(setq value (rtos(+ (atof value) #cong )))
(entmake
  (list
	'(0 . "TEXT")
	'(100 . "AcDbEntity")
	'(100 . "AcDbText")
	(cons 1 value)
	(cons 7 (getvar "textstyle"))
	(cons 8 laD)
	(cons 62 256)
	(cons 10 p)
	(cons 11 p)
	(cons 40 hText)
	(cons 41 1.0)
	(cons 50 0.0)
	(cons 51 0.0)
	'(71 . 0)
	'(72 . 0)
	'(73 . 0)
	))
);end_progn2
  );end_IF
) ;end_While
 (princ)
 )

[ketxu 2.984]

@quansla : 1 lisper triển vọng đây :)

[ro88 2]

like rồi nhé

vô ý quá.bây giờ lisp này đã hoàn thành rồi rất tốt có thể up lên cho mọi người dùng.

Thanks lần nữa nhé :))

Mình có lisp này thấy cũng hay up lên có bạn nào cần thì dùng ko biết tác giả là ai

 

Lisp copy text từ Cad sang Excel(có luôn hướng dẫn)

Mình có dùng nhưng có lúc được lúc không vd: có 2 cột tọa độ X và Y thì chỉ copy được 1 cột (có lúc được cả 2) :) hên xui

 

Nó đây lệnh là (b2e);

 

 

http://www.mediafire...q8vh4cea2vgq25q

 

 

 

ko biết up ở đây có bị la hay ko nữa.