Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3701 gasmanc

gasmanc

    biết vẽ line

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

Đã gửi 23 June 2011 - 11:21 PM

Hề hề hề,
Có nhẽ đây là lỗi do cái biến key_ctnc mà ra. Vì khi bạn nhập t có thể lisp sẽ hiểu nhầm là một biến logic chứ không phải cái key.
Bạn có thể đổi cái key này đi bằng một chử cái khác xem sao nhé.


Híc, nó báo lỗi giống hệt vậy với cùng 4 key C,T,N,H. mình thử đổi key rồi nhưng không ăn thua
  • 0

#3702 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 23 June 2011 - 11:30 PM

vâng .đã nghe rõ .sorry.
mong muốn là muốn mong thôi các bác .
ước mơ để mơ ước đến nhanh thêm một tý thôi .
vì cũng đã và đang vất vả và vật vã nên nó mới vạ vật như thế bác à .bác thông cảm cho em nhé.

Hề hề hề,
Có chi mà bạn vạ vật vậy hỉ???? Cái yêu cầu của bạn là chọn hai điểm trên một đường đã có trước để ghi độ dốc thì không quá khó, Nó đây nè:

(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 512)
(setq ;;;;; en (car (entsel "\n Chon LINE can xac dinh do doc"))
p1 (getpoint "\n Chon diem thu nhat tren duong can ghi do doc");;;;;;;;(cdr (assoc 10 (entget en)))
p2 (getpoint p1 "\n Chon diem thu hai tren duong can ghi do doc");;;;;;(cdr (assoc 11 (entget en)))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))
)
(if (equal (- doc (fix doc)) 0 0.0099)
(setq dd (strcat (rtos doc 2 0) "%%%"))
(setq dd (strcat (rtos doc 2 2) "%%%"))
)
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)


Hề hề hề, hết bức xúc chưa hè????

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 24 June 2011 - 12:47 AM
Bổ sung yêu cầu thể hiện độ dốc của bạn hakhoailang

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3703 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 23 June 2011 - 11:45 PM

Hề hề hề,
Có chi mà bạn vạ vật vậy hỉ???? Cái yêu cầu của bạn là chọn hai điểm trên một đường đã có trước để ghi độ dốc thì không quá khó, Nó đây nè:


(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 512)
(setq ;;;;; en (car (entsel "\n Chon LINE can xac dinh do doc"))
p1 (getpoint "\n Chon diem thu nhat tren duong can ghi do doc");;;;;;;;(cdr (assoc 10 (entget en)))
p2 (getpoint p1 "\n Chon diem thu hai tren duong can ghi do doc");;;;;;(cdr (assoc 11 (entget en)))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))

)
(if (equal (- doc (fix doc)) 0 0.0099)
(setq dd (strcat (rtos doc 2 0) "%%%"))
(setq dd (strcat (rtos doc 2 2) "%%%"))
)
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)


Hề hề hề, hết bức xúc chưa hè????

cảm ơn bác đúng là cái em cần thank bác nhiều . mỗi người một hoàn cảnh bác à.
ko ai giống ai .có người ở hoàn cảnh tốt người ở hoàn cảnh ko dc tốt
nên phải vạ vật bác à.
có những cái trước mắt là của mình . mình nhìn thấy chính xác là của mình nhưng vẫn phải im lặng cho người khác cướp đi .
cuộc đời mà bác .

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 24 June 2011 - 12:48 AM
Bổ sung yêu cầu thể hiện độ dốc của bạn hakhoailang

  • 0

#3704 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 23 June 2011 - 11:49 PM

sẵn đay nhờ bác xem hộ em cái này luôn bác à .
nó chống các lip khác khi chạy nó lên và nó không lưu tính chất của text cũ . nó đổi màu text và làm đậm nét hơn
em thì lại muốn nó vẫn mang tính chất của text cũ vì mình chỉ cần thay số liệu thôi mà bác .
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ () (command "'.zoom" "8x"))
(defun c:++++++ () (command "'.zoom" "16x"))
(defun c:++++ () (command "'.zoom" "4x"))
(defun c:+++ () (command "'.zoom" "2x"))
(defun c:++ () (command "'.zoom" "1.5x"))
(defun c:+ () (command "'.zoom" "1.2x"))
(defun c:- () (command "'.zoom" "0.9x"))
(defun c:-- () (command "'.zoom" "0.5x"))
(defun c:--- () (command "'.zoom" "0.2x"))
(defun c:---- () (command "'.zoom" "0.1x"))
(defun c:----- () (command "'.zoom" "0.05x"))
(defun c:------ () (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
(setvar "cmdecho" 0)
;(setq osm (getvar "osmode"))
(if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
(prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
;(if (/= sc2 nil)(setq sc sc2))
(command ".zoom" "e")
;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
(command "zoom" "p")
(if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
(IF (= a nil)
(setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
(progn
(setq kitu nil)
(initget "Co Khong")
(setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
(If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
)
)

;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
(IF (= nil g)
(progn
(prompt "Khong co cao do tai vi tri can tim!")
(setq g (Getreal "\n Nhap cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
(If(= kitu "Co")
(progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
)
)
)


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
(PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
(c:goc)
(setq xa (* sc (car a)))
(setq ya (* sc (cadr a)))
(setq l1 xa)
(setq l3 ya)
(While
(setq b (Getpoint "\n Chon diem can tinh:"))
(setq xb (* sc (car B)))
(setq x (- xb xa))
(setq yb (* sc (cadr B)))
(setq y (+ g (- yb ya)))
(setq ypr (rtos y 2 3))
(setq l2 xb)
(setq l4 yb)
(setq dy (- l4 l3))
(setq l3 l4)
(setq l (- l2 l1))
(setq ypr1 (rtos L 2 3))
(setq l1 l2)
(Prompt "\nCao do diem vua chon:") (princ (rtos y 2 3))
(Prompt "\nK/C x le:") (princ (rtos l 2 3))
(Prompt " _ K/C x den diem goc:") (princ (rtos x 2 3))
(if (= 0 l)
(Prompt " _ Do doc doan vua chon: E%")
(Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
)

;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
;(command "TEXT" pt2 "" "90" ypr)
;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
;(command "TEXT" pt3 "" "90" ypr1)
;(setq a '(0 0 0) g 0)
(setq thchon (nentselp"\nChon text can thay the:"))
(if (/= nil thchon)
(progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens "" "p" "c" "6" "")
)
)
(princ)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  • 0

#3705 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 23 June 2011 - 11:56 PM

Híc, nó báo lỗi giống hệt vậy với cùng 4 key C,T,N,H. mình thử đổi key rồi nhưng không ăn thua

Hề hề hề,
Lỗi ở dòng code này:
(setq t_left (ssadd txt t_left))
Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil
Bạn chỉ cần vô hiệu hóa dòng code này là được thôi...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3706 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 June 2011 - 12:00 AM

Hề hề hề,
Lỗi ở dòng code này:
(setq t_left (ssadd txt t_left))
Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil
Bạb chỉ cần vô hiệu hóa dòng code này là được thôi...

Ý, cho thêm dòng này (setq t_left (ssadd)) vào sau (setq t_right (ssadd)) chứ ạ ?
  • 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


#3707 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 24 June 2011 - 12:52 AM

Ý, cho thêm dòng này (setq t_left (ssadd)) vào sau (setq t_right (ssadd)) chứ ạ ?

Hề hề hề,
Thêm làm chi vì bác ấy có dùng chi tới thằng t_left đâu. Chỉ là bác ấy vui tay thêm vô cho có tụ rồi lại quên hổng xóa ấy mừ. 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.

#3708 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 24 June 2011 - 01:08 AM

sẵn đay nhờ bác xem hộ em cái này luôn bác à .
nó chống các lip khác khi chạy nó lên và nó không lưu tính chất của text cũ . nó đổi màu text và làm đậm nét hơn
em thì lại muốn nó vẫn mang tính chất của text cũ vì mình chỉ cần thay số liệu thôi mà bác .

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ () (command "'.zoom" "8x"))
(defun c:++++++ () (command "'.zoom" "16x"))
(defun c:++++ () (command "'.zoom" "4x"))
(defun c:+++ () (command "'.zoom" "2x"))
(defun c:++ () (command "'.zoom" "1.5x"))
(defun c:+ () (command "'.zoom" "1.2x"))
(defun c:- () (command "'.zoom" "0.9x"))
(defun c:-- () (command "'.zoom" "0.5x"))
(defun c:--- () (command "'.zoom" "0.2x"))
(defun c:---- () (command "'.zoom" "0.1x"))
(defun c:----- () (command "'.zoom" "0.05x"))
(defun c:------ () (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
(setvar "cmdecho" 0)
;(setq osm (getvar "osmode"))
(if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
(prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
;(if (/= sc2 nil)(setq sc sc2))
(command ".zoom" "e")
;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
(command "zoom" "p")
(if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
(IF (= a nil)
(setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
(progn
(setq kitu nil)
(initget "Co Khong")
(setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
(If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
)
)

;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
(IF (= nil g)
(progn
(prompt "Khong co cao do tai vi tri can tim!")
(setq g (Getreal "\n Nhap cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
(If(= kitu "Co")
(progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
)
)
)


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
(PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
(c:goc)
(setq xa (* sc (car a)))
(setq ya (* sc (cadr a)))
(setq l1 xa)
(setq l3 ya)
(While
(setq b (Getpoint "\n Chon diem can tinh:"))
(setq xb (* sc (car B)))
(setq x (- xb xa))
(setq yb (* sc (cadr B)))
(setq y (+ g (- yb ya)))
(setq ypr (rtos y 2 3))
(setq l2 xb)
(setq l4 yb)
(setq dy (- l4 l3))
(setq l3 l4)
(setq l (- l2 l1))
(setq ypr1 (rtos L 2 3))
(setq l1 l2)
(Prompt "\nCao do diem vua chon:") (princ (rtos y 2 3))
(Prompt "\nK/C x le:") (princ (rtos l 2 3))
(Prompt " _ K/C x den diem goc:") (princ (rtos x 2 3))
(if (= 0 l)
(Prompt " _ Do doc doan vua chon: E%")
(Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
)

;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
;(command "TEXT" pt2 "" "90" ypr)
;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
;(command "TEXT" pt3 "" "90" ypr1)
;(setq a '(0 0 0) g 0)
(setq thchon (nentselp"\nChon text can thay the:"))
(if (/= nil thchon)
(progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens "" "p" "c" "6" "")
)
)
(princ)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Hề hề hề,
Cái vụ đổi màu text thì mình có thể giúp bạn bỏ đi, còn cái vụ làm text đậm lên thì mình chịu chết vì theo như mình đọc trong lisp thì đâu có vụ này. Chỉ có mỗi việc thay đổi nội dung text và đổi màu nó chứ có đụng gì đến các thông số khác của text đâu. Có nhẽ chỉ do đổi màu mà nó làm bạn cảm thấy nét chữ to lên mà thôi.
Để sửa bạn chỉ cần vô hiệu hóa dòng code sau :
(COMMAND "CHANGE" ens "" "p" "c" "6" "")

Tuy nhiên theo mình thì không nên sửa vì điều này sẽ giúp bạn nhận ra text nào đã được sửa và text nào thì chưa sửa. Như vậy rất có lợi với việc chỉnh sửa các bản vẽ có rất nhiều text mà nó` lại nằm chồng chéo lên nhau nữa bạn ạ.
Hề hề hề.

Cách vô hiệu hóa đơn giản nhất là bạn thêm vào đầu dòng code ấy một hay vài ký tự chấm phẩy ;
Khi bạn cần khôi phục nó thì lại xóa các ký tự này đi.
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.

#3709 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 24 June 2011 - 01:53 AM

thứ 2 nữa là, nhờ bạn Tue và Phamthanhbinh tích hợp thêm cho lisp có thể trừ tất cả text số (chú ý là các text số rời rạc ở các vị trí ngẫu nhiên, hướng xoay ngẫu nhiên) cho 1 hằng số, kết quả trả trả về được ghi lại ở đúng vị trí của text bị trừ và góc xoay của text không đổi. mở rộng cho cả 4 phép tính cộng/trừ/ nhân/ chia thì càng tốt.
Điều cốt lõi nhất là góc xoay của text không đổi và nếu kết quả trả về được ghi ở dạng số thập phân làm tròn 2 số sau dấu phẩy thì thật tuyệt.

Hề hề hề,
Phải chăng bạn cần cái lisp thế này:

(defun c:Chgt (/ tsl hs key_ctnc key_ctnc1 t1 txt num et)
(vl-load-com)
(command "undo" "be")
(setq tsl (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach txt tsl
(setq et (entget txt))
(setq t1 (cdr (assoc 1 et)))
(setq num (congtrunhanchia key_ctnc (atof t1) hs))
(setq et (subst (cons 1 (rtos num 2 2)) (assoc 1 et) et))
(entmod et)
)
(command "undo" "e")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)

Hế hề hề, nếu bạn muốn ghép nó vào lisp nào thì chỉ việc copy và paste nó vào thôi nhé. Nhớ các lệnh khi chạy lisp.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3710 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 June 2011 - 09:00 AM

Hề hề hề,
Thêm làm chi vì bác ấy có dùng chi tới thằng t_left đâu. Chỉ là bác ấy vui tay thêm vô cho có tụ rồi lại quên hổng xóa ấy mừ. Hề hề hề,...

Hề hề, srr các bác vì e hấp tấp quá, chỉ thấy thiếu thì bỏ thêm vô chứ hổng đọc hết code được ^^ Mong các bác lượng thứ.
P/S : dạo này bác Bình quay trở lại, quả có lợi hại, đánh đông dẹp bắc các loại request ^^ Chúc bác sớm đẻ được nhiều thứ hay để bọn em mót.
  • 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


#3711 minhvanvui

minhvanvui

    biết pan

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

Đã gửi 24 June 2011 - 10:08 AM

Mình muốn nhờ bạn viết cho mình cái lisp nối dài một hình chữ nhật (rec) tới một đoạn thẳng (line), giống như là nối đoạn thẳng (line) với đoạn thẳng (line) thông dụng và có sẳn trong auto cad vậy.
Và nếu có thể thì viết luôn nối hact giúp.
Mong được giúp đở.
  • 0

#3712 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 24 June 2011 - 10:20 AM

Mình muốn nhờ bạn viết cho mình cái lisp nối dài một hình chữ nhật (rec) tới một đoạn thẳng (line), giống như là nối đoạn thẳng (line) với đoạn thẳng (line) thông dụng và có sẳn trong auto cad vậy.
Mong được giúp đở.

Bạn có "nối dài tới" và "nối với" nên chưa rỏ "thông dụng và có sẳn trong auto cad" ở đây là bạn nói đến lệnh extend hay Pedit.
-Nếu là extend thì bạ dùng STRETCH với hình chữ nhật xem.
-Nếu là Pedit thì nên cho bản vẽ trước và sau khi thực hiện mong muốn.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#3713 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 24 June 2011 - 10:21 AM

nhờ các bác giúp cho cái lip với ý tưởng như trong hình vẽ sau

http://www.cadviet.c...haytencoc_1.dwg

thank cac bac
  • 0

#3714 minhvanvui

minhvanvui

    biết pan

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

Đã gửi 24 June 2011 - 11:02 AM

Bạn có "nối dài tới" và "nối với" nên chưa rỏ "thông dụng và có sẳn trong auto cad" ở đây là bạn nói đến lệnh extend hay Pedit.
-Nếu là extend thì bạ dùng STRETCH với hình chữ nhật xem.
-Nếu là Pedit thì nên cho bản vẽ trước và sau khi thực hiện mong muốn.

Mình muốn dùng lệnh extend cho hình chữ nhật (kéo dài "extend" cho hình chữ nhật chứ không phải di chuyển như lệnh "stretch")
Thông thường mình hay dùng lệnh "extend" cho đường thẳng bậy giờ là cho hình chữ nhật.
  • 0

#3715 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 June 2011 - 11:19 AM

Mình muốn dùng lệnh extend cho hình chữ nhật (kéo dài "extend" cho hình chữ nhật chứ không phải di chuyển như lệnh "stretch")
Thông thường mình hay dùng lệnh "extend" cho đường thẳng bậy giờ là cho hình chữ nhật.

Bạn có lường trước được tình huống cả 2 phía của HCN nếu kéo dài thì đều gặp Line không ? Hoặc bạn có chỉ định cho HCN kéo dài thì gặp Line ở điểm giao nào ? Nếu là điểm Extend đầu mút thì là đầu mút nào ?
  • 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


#3716 gasmanc

gasmanc

    biết vẽ line

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

Đã gửi 24 June 2011 - 12:55 PM

Hề hề hề,
Phải chăng bạn cần cái lisp thế này:


(defun c:Chgt (/ tsl hs key_ctnc key_ctnc1 t1 txt num et)
(vl-load-com)
(command "undo" "be")
(setq tsl (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach txt tsl
(setq et (entget txt))
(setq t1 (cdr (assoc 1 et)))
(setq num (congtrunhanchia key_ctnc (atof t1) hs))
(setq et (subst (cons 1 (rtos num 2 2)) (assoc 1 et) et))
(entmod et)
)
(command "undo" "e")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)

Hế hề hề, nếu bạn muốn ghép nó vào lisp nào thì chỉ việc copy và paste nó vào thôi nhé. Nhớ các lệnh khi chạy lisp.

chuẩn luôn. thanks bạn nhiều! ^^

Hề hề hề,
Lỗi ở dòng code này:
(setq t_left (ssadd txt t_left))
Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil
Bạn chỉ cần vô hiệu hóa dòng code này là được thôi...


ừ đúng rồi. mình làm được rồi. giờ nó chạy ngon. hề hề. thanks bạn nhiều.
  • 0

#3717 minhvanvui

minhvanvui

    biết pan

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

Đã gửi 24 June 2011 - 01:26 PM

Bạn có lường trước được tình huống cả 2 phía của HCN nếu kéo dài thì đều gặp Line không ? Hoặc bạn có chỉ định cho HCN kéo dài thì gặp Line ở điểm giao nào ? Nếu là điểm Extend đầu mút thì là đầu mút nào ?

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.
Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.
Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :
Cho hình chữ nhật ABCD có AB=600mm , AD=800mm
Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X
Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.
Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.
Bài toán của mình đưa ra là vậy
Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.
  • 0

#3718 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 24 June 2011 - 01:36 PM

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.
Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.
Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :
Cho hình chữ nhật ABCD có AB=600mm , AD=800mm
Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X
Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.
Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.
Bài toán của mình đưa ra là vậy
Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.

-Bạn chỉ cần biết dùng lệnh STRETCH là làm được thôi. Qua cách diển đạt của bạn mình biết bạn chưa biết cách dùng STRETCH.
-Còn bạn bảo "đơn giản" sau khi bác ket đã nêu các trường hợp chứng tỏ bạn dùng cad chưa thạo. Minh hoạ ý bác ket bằng hình để bạn dể hình dung:
Hình đã gửi
*Đây là mục lisp nhưng mình xin pép hướng dẩn bạn dùng lệnh STRETCH ở đây luôn.
-Hình chử nhật có 4 đỉnh. Khi tạo vùng chọn thì bạn chọn bằng cửa sổ như cái nét gạch đứt trong hình. Đỉnh nào nằm trong vùng chọn phần mình thể hiện màu xanh thì sẽ di chuyển các đỉnh khác giữ nguyên.
-Bạn xem 4 trường hợp chọn đối tượng làm theo xong kéo thử để nhận ra sự khác biệt.
Hình đã gửi
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#3719 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 June 2011 - 01:50 PM

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.
Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.
Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :
Cho hình chữ nhật ABCD có AB=600mm , AD=800mm
Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X
Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.
Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.
Bài toán của mình đưa ra là vậy
Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.

Nếu bạn đã ngại đọc kỹ mấy câu mình hỏi thì bạn post hình lên để mọi người cùng hiểu nhé :) Như ý bạn thì rõ ràng HCN sẽ k còn là HCN nữa
  • 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


#3720 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 24 June 2011 - 02:22 PM

nhờ các bác giúp cho cái lip với ý tưởng như trong hình vẽ sau

http://www.cadviet.c...haytencoc_1.dwg

thank cac bac

Hề hề hề,
bạn xài thử cái nàu coi đã ưng cái bụng chưa hè???


(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo thu tu thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(alert "\n Chon ten coc tren trac ngang theo thu tu thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(foreach txt tsl1
(setq t1 (cdr (assoc 1 (entget txt))))
(setq n (vl-position txt tsl1))
(setq tx (nth n tsl2))
(if tx
(progn
(setq elt (entget tx)
t2 (substr (cdr (assoc 1 elt)) 1 4)
t3 (strcat t2 " " t1)
elt (subst (cons 1 t3) (assoc 1 elt) elt)
)
(entmod elt)
)
)
)
(command "undo" "e")
(princ)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.