Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
13 replies to this topic

#1 friendship293a

friendship293a

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 22 October 2010 - 11:25 AM

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

  • 0

#2 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 22 October 2010 - 12:37 PM

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

Bài viết đã được chỉnh sửa nội dung bởi master_worse: 22 October 2010 - 01:35 PM

  • 1

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#3 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 30 September 2012 - 10:12 PM

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?
  • 0

#4 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 30 September 2012 - 11:17 PM

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

#5 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 30 September 2012 - 11:31 PM

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 đó.
  • 0

#6 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 01 October 2012 - 12:50 PM

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

#7 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 01 October 2012 - 12:54 PM

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ị
???
  • 0

#8 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 01 October 2012 - 09:16 PM

Đú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
  • 0

#9 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 01 October 2012 - 11:10 PM

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

  • 0

#10 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 01 October 2012 - 11:47 PM

Thanks quansla
ok rồi
  • 0

#11 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 02 October 2012 - 05:58 PM

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.
  • 0

#12 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 02 October 2012 - 10:05 PM

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

  • 4

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 02 October 2012 - 10:28 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 02 October 2012 - 10:40 PM

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.
  • 0