Đến nội dung


Hình ảnh
- - - - -

[yêu cầu] viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo


  • Please log in to reply
41 replies to this topic

#1 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 October 2011 - 08:17 AM

http://www.mediafire...2vp108b2v1rbshr
  • 0
^_^0905-0988.782004^_^

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 October 2011 - 08:21 AM

Mình góp ý chút : Bạn đừng bắt mọi người phải down file về mới biết bạn cần gì :)
  • 0

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


#3 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 October 2011 - 08:31 AM

Mình góp ý chút : Bạn đừng bắt mọi người phải down file về mới biết bạn cần gì :)


Thế làm sao hả ketxu vì hình vẽ rất trực quan dể hiểu.
Yêu cầu của mình là: có cao độ 3.600 khi mình copy lên 1 đoạn 3.600 thì cao độ đó tự động nhảy 7.200 không cần phải kích vào để sửa
Và hình vẽ như hình kèm theo
  • 0
^_^0905-0988.782004^_^

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 October 2011 - 08:36 AM


Thế làm sao hả ketxu vì hình vẽ rất trực quan dể hiểu.
Yêu cầu của mình là: có cao độ 3.600 khi mình copy lên 1 đoạn 3.600 thì cao độ đó tự động nhảy 7.200 không cần phải kích vào để sửa
Và hình vẽ như hình kèm theo

Phép lịch sự thôi. Mình dốt bền thì không tính, nhưng mọi người ai cũng phải làm việc (đang giờ hành chính nè), bạn còn gửi vỏn vẹn mỗi cái link file bắt mọi người down về mới biết bạn cần gì, tiết kiếm mấy câu mô tả yêu cầu để làm gì ?
Hơn nữa yêu cầu đánh cos CĐ của bạn ở diễn đàn có không biết cơ man là lisp rồi
Hi vọng mọi người sẽ giúp bạn sớm hoặc bạn tìm kiếm ra!
  • 0

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


#5 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 October 2011 - 08:38 AM

Phép lịch sự thôi. Mình dốt bền thì không tính, nhưng mọi người ai cũng phải làm việc (đang giờ hành chính nè), bạn còn gửi vỏn vẹn mỗi cái link file bắt mọi người down về mới biết bạn cần gì, tiết kiếm mấy câu mô tả yêu cầu để làm gì ?
Hơn nữa yêu cầu đánh cos CĐ của bạn ở diễn đàn có không biết cơ man là lisp rồi
Hi vọng mọi người sẽ giúp bạn sớm hoặc bạn tìm kiếm ra!

Ở diễn đàn cũng có nhưng mình thích cái coste cao độ như hình mình vẽ cho nó đồng bộ với bản vẽ của mình, mà copy cái kia về mình không biết sửa nên nhờ bạn. thanks
  • 0
^_^0905-0988.782004^_^

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 07 October 2011 - 10:33 AM

Ở diễn đàn cũng có nhưng mình thích cái coste cao độ như hình mình vẽ cho nó đồng bộ với bản vẽ của mình, mà copy cái kia về mình không biết sửa nên nhờ bạn. thanks

Thực tình thì copy theo kiểu của bạn chắc chắn trên Cadviet đã có. Tuy nhiên vì bạn có thể tìm chưa ra hoặc không ưng ý, nếu vậy thì dùng thử cái này vậy.

; Doan Van Ha CADViet.com
; Copy-Array, rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
(defun C:HA (/ dsdt dt dt1 dt2 p1 p2 sl x strt strp num sym ds daup giaso)
(command "undo" "be")
(princ "\nChon cac doi tuong can Copy-Array...")
(setq dsdt (acet-ss-to-list (setq dt (ssget)))
dt1 dt
p1 (getpoint "\nDiem goc: ")
p2 (getpoint p1 "\nDiem den: ")
sl (getint "\nSo lan: ")
x 1 giaso (/ (- (cadr p2) (cadr p1)) 1000))
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(foreach n dsdt
(if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
(if (KT_NUM (cdr (assoc 1 (entget n))))
(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt)))
(if dt2
(progn
(setq x 1)
(repeat sl
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
(entmod (subst (cons 1 (strcat (car ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
(entupd (entlast))
(setq x (1+ x)))))
(if dt1
(progn
(setq x 1)
(repeat sl
(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(setq x (1+ x)))))
(command "undo" "e")
(acet-sysvar-restore)
(princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
(cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
(T (setq lstt nil))))
(while lstn
(cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
(foreach n (vl-string->list str)
(if (and (>= n 48) (<= n 57)) (setq kt T)))
kt)

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 October 2011 - 11:08 PM

thank Ha nhé đúng như cái mình cần nhưng còn 1 chỗ nhờ bạn sửa giúp thêm 1 tí. Ban đầu cos +-0.000 nếu copy lên thì sẽ +3.600 nếu copy xuống thì -3.600. thanks. Nếu có thêm chứ năng copy của att block nữa thì ok. Hình kèm theo
Hình đã gửi
  • 0
^_^0905-0988.782004^_^

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 07 October 2011 - 11:27 PM

thank Ha nhé đúng như cái mình cần nhưng còn 1 chỗ nhờ bạn sửa giúp thêm 1 tí. Ban đầu cos +-0.000 nếu copy lên thì sẽ +3.600 nếu copy xuống thì -3.600. thanks.

Đây bạn! Tuy nhiên, bạn đừng y/c theo kiểu lâu lâu 1 y/c thì khổ người viết lắm. Tóm lại, bạn nên nêu tất cả y/c 1 lần thôi. Lisp dưới đây bỏ dấu +-cho bạn, còn các y/c khác thì đợi bạn... hết y/c mới nhào vô viết 1 lần luôn (vì vừa mới sửa xong, up lên thì lại thấy bạn bổ sung thêm y/c nữa).

; Doan Van Ha CADViet.com
; Copy-Array, rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
(defun C:HA (/ dsdt dt dt1 dt2 p1 p2 sl x strt strp num sym ds daup giaso)
(command "undo" "be")
(princ "\nChon cac doi tuong can Copy-Array...")
(setq dsdt (acet-ss-to-list (setq dt (ssget)))
dt1 dt
p1 (getpoint "\nDiem goc: ")
p2 (getpoint p1 "\nDiem den: ")
sl (getint "\nSo lan: ")
x 1 giaso (/ (- (cadr p2) (cadr p1)) 1000))
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(foreach n dsdt
(if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
(if (KT_NUM (cdr (assoc 1 (entget n))))
(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt)))
(if dt2
(progn
(setq x 1)
(repeat sl
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
; (entmod (subst (cons 1 (strcat (car ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
(entmod (subst (cons 1 (strcat (ACET-STR-REPLACE (chr 177) "" (car ds)) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
(entupd (entlast))
(setq x (1+ x)))))
(if dt1
(progn
(setq x 1)
(repeat sl
(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
(setq x (1+ x)))))
(command "undo" "e")
(acet-sysvar-restore)
(princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
(cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
(T (setq lstt nil))))
(while lstn
(cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
(foreach n (vl-string->list str)
(if (and (>= n 48) (<= n 57)) (setq kt T)))
kt)

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 October 2011 - 10:08 AM

Hôm qua về mệt quá ngủ luôn, nên quên không viết, srr risusu ^^
1 ví dụ với copy cao độ (ở 2D là tọa độ Y) với tập các đối tượng Text như trong bản vẽ :

(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (mapcar 'entget (acet-ss-to-list (setq ss(ssget))))
Txt (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr x)"*TEXT")) lstSS))
txtstr (atof (acet-dxf 1 txt))
p1 (getpoint "\nBasepoint :")
eL (entlast)
)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) Listname))
eL (entlast)
)
(vla-put-textstring (vlax-ename->vla-object txt1)
(strcat (cond ((> (setq num (+ txtstr (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 3))
)
)
)

  • 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


#10 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 08 October 2011 - 01:18 PM

Xin cảm ơn 2 bạn ketxu và Doan Van Ha đã bỏ chút thời gian giúp mình.
Yêu cầu cuối cùng:
Lisp đánh cos cao độ từ cos có sẵn (Để đồng bộ bản vẽ của từng công ty vì mỗi công ty có ký hiệu cos cao độ riêng)
1. Cos là Mtext hoặc Dtext
2. Cos là Att block (Enhanced Attribute Editor)

File bản vẽ: http://www.cadviet.c..._nhu_ban_ve.dwg
Hình ảnh: Hình đã gửi

Bài viết đã được chỉnh sửa nội dung bởi risusu: 08 October 2011 - 01:23 PM

  • 0
^_^0905-0988.782004^_^

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 October 2011 - 02:06 PM

K thấy nói j về 2 lisp bên trên nhỉ :o Giải tán thôi ^^
  • 0

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


#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 October 2011 - 02:18 PM

Hình đã gửi

Viết cho anh em xài. Lisp chấp nhận cả Cos cao độ dạng Text hoặc ATT, và tất nhiên lấy text đầu - ATT đầu của Block đầu xử lý
-Update DImzin ^^

(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
(setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
)
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (acet-ss-to-list (setq ss (ssget)))
obj (car (setq en (dowith lstSS)))
str (cdr en)
p1 (getpoint "\nBasepoint :")
eL (entlast)
oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (dowith listName))
eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 3))
)
)
(setvar "DIMZIN" oDZ)
)

  • 5

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


#13 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 08 October 2011 - 02:23 PM

Hình đã gửi

Viết cho anh em xài. Lisp chấp nhận cả Cos cao độ dạng Text hoặc ATT, và tất nhiên lấy text đầu - ATT đầu của Block đầu xử lý


(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
(defun dowith(lstSS / lstSS en str)
(cond ((setq en (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
(setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
)
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq lstSS (acet-ss-to-list (setq ss (ssget)))
obj (car (setq en (dowith lstSS)))
str (cdr en)
p1 (getpoint "\nBasepoint :")
eL (entlast)
)
(while (setq p2 (getpoint p1 "\nTo point :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq Txt1 (car (dowith listName))
eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) "%%p")
(T "")
)
(rtos num 2 3))
)
)
)




Vô cùng cảm ơn bạn ketxu. Cuối cùng tờ cũng thấy được thành Rome rồi. Lisp này thì bất kể ai dùng cũng được và tự tạo ký hiệu cos theo ý thích. một lần nữa cảm ơn ketxu. Chúc bạn vui vẻ
  • 2
^_^0905-0988.782004^_^

#14 lenhatanh

lenhatanh

    biết vẽ polygon

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

Đã gửi 28 November 2011 - 09:54 AM

Bạn ketxu cho thêm tỉ lệ vẽ vào nữa thì lsp sẽ tổng quát hơn !
Chúc bạn vui vẻ.
  • 0

#15 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 28 November 2011 - 12:33 PM

Bạn ketxu cho thêm tỉ lệ vẽ vào nữa thì lsp sẽ tổng quát hơn !
Chúc bạn vui vẻ.

Hề hề hề,
Xin lỗi bác ketxu cho mình trả lời nhé.
1/- Bạn Lenhatanh là một người sử dụng lisp khá nhiều rồi và cũng đã có một số yêu cầu về việc viết lisp.
Vì thế chắc hẳn bạn cũng hiểu rằng các lisp trên diễn đàn được viết ra hầu hết đều theo ý định ban đầu của chủ topic. Vì thế nó khó đáp ứng được đầy đủ yêu cầu của mọi người. Để sử dụng được các lisp này thì những người tham khảo, không phải là chủ thớt nên hiểu rõ yêu cầu đặt ra của chủ thớt và từ đó tìm cách vận dụng trong trường hợp riêng của mình để phù hợp hoặc nếu muốn sửa đổi cho phù hợp với yêu cầu riêng của mình thì nên tạo một topic khác với tiêu đề là sửa đổi như trong hướng dẫn lập topic ở chuyên mục Autolisp này.
Không nện viết ké như vậy vì rất có thể yêu cầu bổ sung này không phù hợp với yêu cầu của chủ thớt (nghĩa là không tôn trọng chủ thớt).
2/- Vì bạn là người sử dụng lisp khá nhiều nên bạn cũng nên tự tìm hiểu để có thể đ5c và hiểu nội dung của các lisp được gửi lên diễn đàn, đồng thời có thể tự mình sửa những chỗ có thể cho phù hợp với yêu cầu riêng của mình. Như vậy sẽ có lợi hơn cho bạn trong quá trình sử dụng về sau này. (vì biết dâu bạn lại có thêm những yêu cầu mới với những lisp bạn đã và đang dùng). Đồng thời bạn cũng sẽ chủ động được trong công việc của mình, khỏi bị phụ thuộc vào diễn đàn
3/- Với cái yêu cầu của bạn thực ra mình nghĩ bạn hoàn toàn có thể tự sửa được. Bởi vì với yêu cầu đó vấn đề chỉ là bổ sung thêm vào các code dùng để nhập hệ số tỷ lệ bản vẽ và code dùng để xác định giá trị text ghi ra bản vẽ mà thôi.
- Việc nhập hệ số tỷ lệ bạn cũng đã biết, tùy theo ý thích của bạn có thể sử dụng hàm (getint....) hay (getreal .....) và ví dụ là bạn thích dùng (getreal ...) . vậy thì bạn có thể vào help develpoer của CAd để đọc hướng dẫn về cái hàm này rồi sau đó ứng dụng vào để nhập cái tỷ lệ của bản vẽ vào . Tỷ như (setq k (getreal "\n Nhap he so ty le cua ban ve: "))
- Với các code dùng để ghi giá trị text ra bản vẽ thì đọc trong lisp bạn sẽ dễ dàng đoán ra đó là đoạn code:

(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) " %%p")
(T "")
)
(rtos num 2 3))
)
Và giá trị của txt1 được ghi ra bản vẽ chính là chuỗi :


(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) " %%p")
(T "")
)
(rtos num 2 3))
Trong đó , đoạn:


(cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) 1000))) 0) "+")
((= num 0) " %%p")
(T "")
)
Chỉ là điều kiện để ghi cái dấu +, - hay +/- phía trước giá trị của cao độ mà thôi.
Còn (rtos num 2 3) mới thực sự là giá trị được ghi ra bản vẽ.
Đến đây bạn hoàn toàn có thể bắt lisp thể hiện cái cao độ bạn cần phụ thuộc vào giá trị của hệ số tỷ lệ k mà bạn nhập vào trước đó.
Do : Giá trị thực x k = Giá trị vẽ nên Cao độ thực bạn cần ghi sẽ là (/ num k) và bạn chỉ cần thay gia trị này vào trong đoạn code lấy gá trị của cao độ phía trên là Ok. Nghĩa là bạn sẽ có: (rtos (/ num k) 2 3)

Bạn hãy cố gắng để làm thử coi sao. nếu thành công, đó là điều tốt để bạn thấy rằng bạn hoàn toàn có thể tự làm mà khỏi cần nhờ ai cả. nếu chưa thành công, hãy post cái kết quả bạn đã làm lên mọi người sẽ góp ý thêm.
Đây chỉ là vài lời thô thiển, có thể trúng có thể trật nhưng mong bạn chớ giận vì đó cũng là cái cách để bản thân tôi có thể tồn tại và làm việc cho tới ngày hôm nay bạn ạ.
Không có việc gì khó, chỉ sợ mình hơi lười thôi bạn ạ....
Hề hề hề,...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#16 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 28 November 2011 - 03:55 PM

nếu cao độ là con số có 2 chữ số trở nên. VD: +26.50 hay -26.50 thì dấu + và - bị chèn vào đường gióng thẳng của ký hiệu cao độ, các bác nhỉ.
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 November 2011 - 04:05 PM

nếu cao độ là con số có 2 chữ số trở nên. VD: +26.50 hay -26.50 thì dấu + và - bị chèn vào đường gióng thẳng của ký hiệu cao độ, các bác nhỉ.


K biết phải nói sao nữa ^^ Lisp viết tùy biến, mọi người tự đặt Text, tự đặt ATT, chèn vào hay không là do người dùng
  • 0

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


#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 28 November 2011 - 04:32 PM


K biết phải nói sao nữa ^^ Lisp viết tùy biến, mọi người tự đặt Text, tự đặt ATT, chèn vào hay không là do người dùng

Hề hề hề,
Đúng hơn là do cái bản vẽ mà người dùng sử dụng bác nhể???? Nếu muốn thì người dùng phải tự hiệu chỉnh thôi bác ạ,Chớ lisp không thể ứng phó hết cái sự khó tính của người dùng đâu.
Hề hề hề,...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 anhsaoxanh222

anhsaoxanh222

    biết vẽ line

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

Đã gửi 28 November 2011 - 07:35 PM

bác ketxu dùng phần mềm gì để tạo ra ảnh gif thế, chỉ cho em với :)
  • 0

#20 lenhatanh

lenhatanh

    biết vẽ polygon

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

Đã gửi 29 November 2011 - 03:37 PM

Hề hề hề, Xin lỗi bác ketxu cho mình trả lời nhé...
...Không có việc gì khó, chỉ sợ mình hơi lười thôi bạn ạ.... Hề hề hề,...

Cám ơn bạn Phamthanhbinh đã nhắc nhở !
  • 0