Đến nội dung


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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2854 replies to this topic

#1321 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 12 September 2012 - 01:48 PM

Khi copy và paste xong, hoặc:
- Bạn save (chứ không phải saves).
- Bạn saves: khi đó hãy nhớ chọn "Saves as type" là "All file" + "Encoding" là "ANSI" + Tên file ví dụ là "Lisp_chung.lsp".
  • 0

* 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.


#1322 matusalem

matusalem

    biết zoom

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

Đã gửi 13 September 2012 - 10:46 AM

Khi copy và paste xong, hoặc:
- Bạn save (chứ không phải saves).
- Bạn saves: khi đó hãy nhớ chọn "Saves as type" là "All file" + "Encoding" là "ANSI" + Tên file ví dụ là "Lisp_chung.lsp".


Chao A!
em làm lại theo như A hướng dẫn nhưng không được
1. khi e copy code của 1 Lisp rồi ghép vào code của Lisp khác thì khi lưu lại thành Lisp mới. Lisp mới chỉ hiểu được 1 lệnh của 1 trong 2 Lisp củ (tùy vào mình gõ lệnh của Lisp 1 hay Lisp 2 thì Lisp mới hiểu lệnh của Lisp đó)
2. Khi mình ghép Lisp lại, làm sao đặt lệnh cho Lisp mới
Nhờ A chỉ bảo Ah!
Nếu có thể A mail cho e rõ hơn vào địa chỉ: Thanhphuc.bd@gmail.com nha A!
Mong nhận được hồi âm của A
  • 0

#1323 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 13 September 2012 - 11:00 AM


Chao A!
em làm lại theo như A hướng dẫn nhưng không được
1. khi e copy code của 1 Lisp rồi ghép vào code của Lisp khác thì khi lưu lại thành Lisp mới. Lisp mới chỉ hiểu được 1 lệnh của 1 trong 2 Lisp củ (tùy vào mình gõ lệnh của Lisp 1 hay Lisp 2 thì Lisp mới hiểu lệnh của Lisp đó)
2. Khi mình ghép Lisp lại, làm sao đặt lệnh cho Lisp mới
Nhờ A chỉ bảo Ah!
Nếu có thể A mail cho e rõ hơn vào địa chỉ: Thanhphuc.bd@gmail.com nha A!
Mong nhận được hồi âm của A

Mình nghĩ cách copy và ghép của bạn có vấn đề
Phiền bạn upload file Lisp mà bạn đã copy và ghép lên đây nhé!
  • 0

#1324 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 13 September 2012 - 11:01 AM

Đây là lisp ghép lại. Mọi thứ vẫn ổn chứ không như bạn nói.

(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(command "layer" "m" "Ranh_toado" "c" 6 "" "")
(defun Wdis (p1 p2 / dis ang point point1)
(setq dis (distance p1 p2))
(setq ang (angle p1 p2))
(if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
(progn
(setq ang (+ Ang Pi))
(setq Point (polar p2 ang (/ dis 2.0)))
(setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

)
(progn
(setq Point (polar p1 ang (/ dis 2.0)))
(setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
)
)
(command "Text" "S" "vaptimn0" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2) )
)
(defun ssgetLayer( La1 La2 / ss)
(setq ss (ssget "X" (list
(cons -4 "<OR")
(cons -4 "<AND")
(cons 8 La1)
(cons 0 "LWPOLYLINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La1)
(cons 0 "LINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La2)
(cons 0 "LWPOLYLINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La2)
(cons 0 "LINE")
(cons -4 "AND>")
(cons -4 "OR>")
)
))
ss
)
(defun pointpl (name m k / namem i bien t1 p1 diem)
(setq namem name)
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc m namem))
(setq t1 (member bien namem))
(setq p1 (car t1))
(setq namem (cdr t1))
(setq diem (cdr p1))
(setq i (+ 1 i))
)
)
diem
)
(defun c:Toado( / i k luuxy st p xoa)
(setvar "cmdecho" 0)
(setq st (ssgetLayer "Ranh_toado" "Ranh_38") )
(if (/= st nil)
(progn
(if (null (tblsearch "style" "vaptimn0"))
(command "_style" "vaptimn0" "Vavon.ttf" "" "" "" "" ""))
(if (null (tblsearch "style" "vhelveb"))
(command "_style" "vhelveb" "vhelveb.ttf" "" "" "" "" ""))
(if (null (tblsearch "layer" "sohieu_diem"))
(command "_layer" "n" "sohieu_diem" ""))
(command "_layer" "c" "2" "sohieu_diem" "")
(if (null (tblsearch "layer" "canh"))
(command "_layer" "n" "canh" ""))
(command "_layer" "c" "3" "canh" "")
(if (null (tblsearch "layer" "bang_toado"))
(command "_layer" "n" "bang_toado" ""))
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "6" "Ranh_38" "")
(command "_layer" "c" "6" "Ranh_toado" "")
(if (null (tblsearch "layer" "Polygon"))
(command "_layer" "n" "Polygon" ""))
(command "_layer" "c" "8" "Polygon" "")
(setq r1 (getvar "USERR1"))
(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
(if (= TileBdHT nil)
(setq TileBdHT r1))
(setvar "USERR1" TileBdHT)

(setvar "blipmode" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Pick"))
(command "_layer" "s" "Polygon" "")
(if (/= p nil)
(command "-Boundary" "a" "b" "n" st "" "" p "" )
)
(setq luuxy (entget (entlast)))
(setq p (getpoint "\n Diem dat bang toa do :"))
; (entdel (entlast))
(setq k (cdr (assoc 90 luuxy)))
(if (/= p nil)
(progn
(setq p01 p)
(setq p02 (mapcar '+ p '(10.0 0.0 0.0)))
(setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))
(setq p04 (mapcar '+ p '(35.0 0.0 0.0)))
(setq p05 (mapcar '+ p '(45.0 0.0 0.0)))
(setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))
(setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))
(setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))
(setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))
(if (<= k 10)
(progn
(setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))
(setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))
(setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))
(setq p13 (mapcar '+ p '(35.0 -40.0 0.0)))
(setq p14 (mapcar '+ p '(45.0 -40.0 0.0)))
)
(progn
(setq ty (* -1 (+ 10.0 (* k 3))))
(setq t0 (list 0.0 ty 0.0))
(setq t1 (list 10.0 ty 0.0))
(setq t2 (list 22.5 ty 0.0))
(setq t3 (list 35.0 ty 0.0))
(setq t4 (list 45.0 ty 0.0))
(setq p10 (mapcar '+ p t0))
(setq p11 (mapcar '+ p t1))
(setq p12 (mapcar '+ p t2))
(setq p13 (mapcar '+ p t3))
(setq p14 (mapcar '+ p t4))
)
)
(command "layer" "s" "bang_toado" "")
(command "Line" p01 p05 "")
(command "Line" p01 p10 "")
(command "Line" p02 p11 "")
(command "Line" p03 p12 "")
(command "Line" p04 p13 "")
(command "Line" p05 p14 "")
(command "Line" p07 p08 "")
(command "Line" p06 p09 "")
(command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 2.0 0.0)) 1.25 0 "BA&#219;NG KE&#194; TO&#207;A &#209;O&#196; VN2000")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "So&#225; hie&#228;u")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "&#241;ie&#229;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "To&#239;a &#241;o&#228;")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.25 0 "Ca&#239;nh")
)
)
(setq i 1)
(while (<= i k)
(progn
(setq toado (pointpl luuxy 10 i))
(setq x (rtos (car toado) 2 3))
(setq y (rtos (cadr toado) 2 3))
(command "layer" "s" "sohieu_diem" "")
(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
(command "Text" "S" "vaptimn0" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
(command "donut" "0.0" (* 0.25 (/ TileBdHT 500)) toado "")
(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
(setq psh (mapcar '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p tgc))
(if (= i 1)
(progn
(setq toado1 toado)
(setq x1 (rtos (car toado1) 2 3))
(setq y1 (rtos (cadr toado1) 2 3))
)
)
(if (>= i 2)
(progn
(setq canh (distance toado0 toado))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn0" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
(command "layer" "s" "canh" "")
(wdis toado0 toado)
)
)
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn0" "j" "M" psh 1.2 0 i)
(command "Text" "S" "vaptimn0" "j" "M" pxx 1.2 0 y)
(command "Text" "S" "vaptimn0" "j" "M" pyy 1.2 0 x)
(setq toado0 toado)
(setq i (+ i 1))
)
)
(command "layer" "s" "canh" "")
(wdis toado toado1)
(setq canh (distance toado toado1))
(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
(setq psh (mapcar '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p tgc))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn0" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
(command "Text" "S" "vaptimn0" "j" "M" psh 1.2 0 "1")
(command "Text" "S" "vaptimn0" "j" "M" pxx 1.2 0 y1)
(command "Text" "S" "vaptimn0" "j" "M" pyy 1.2 0 x1)
(setvar "osmode" old)
) ;(end progn)
) ;(end if)
(if (= st nil)
(progn
(setvar "cmdecho" 1)
(princ "Khong co layer Ranh_toado")
)
)
(command "_layer" "s" "0" "")

)
(defun c:capnhat()
(setq is (ssgetLayer "Polygon" "Polygon") )
(setq namecn (getfiled "FILE CAP NHAT" "" "DWG" 3))
(command "Wblock" namecn "" '(0 0) is "")
(command "oops")
(command "save")
; (setq namegoc (getfiled "FILE BAN DO GOC" "" "DWG" 3))
(setq TenQuan (strcat " " (getString T "\nTen Quan : ")))
(setq TenPhuong (strcat " " (getString T "\nTen Phuong : ")))
(setq TenTo (strcat " " (getString T "\nTo So : ")))
(setq namegoc (strcat "q" TenQuan "-" TenPhuong "-" TenTo ".dwg"))
(command "open" namegoc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:hl( / k k1 k2 st X Xt Xd Y Yt Yd p1 p2 p3 old oold)
(if (null (tblsearch "style" "arial"))
(command "_style" "arial" "arial.ttf" "" "" "" "" "" ""))
(setq old (getvar "textstyle"))
(setq oold (getvar "osmode"))
(setvar "osmode" 513)
(setq r (getvar "USERR1"))
(setq TileBd (getint (strcat "\nMau So Ti Le Cua Ban Ve" "(" (rtos r 2 0) "):")))
(if (= TileBd nil)
(setq TileBd r))
(setvar "USERR1" TileBd)
(initget "Y")
(setq opt (getkword "\nBan do co xoay khung khong? <N>: "))
(setq p1 (getpoint "\nDiem dau (goc khung): "))
(setq z1 (getpoint "\nDiem cuoi(goc khung): "))

(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x2 (car z1))
(setq y2 (cadr z1))
(setq na (abs(- x2 x1)))
(setq do (abs(- y2 y1)))
(setq onale (/ na (/ TileBD 10)))
(setq odole (/ do (/ TileBD 10)))
(setq ona (fix onale))
(setq odo (fix odole))

(setq LayerOld (getvar "clayer"))
(if (null (tblsearch "layer" "hl"))
(command "_layer" "m" "hl" ""))
(command "_layer" "s" "hl" "")
(command "_layer" "c" "5" "hl" "")
(setvar "osmode" 0)
(setq k (/ (cadr p1) (/ TileBd 10)))
(setq b (rtos (cadr p1) 2 0))
(setq c (rtos (car p1) 2 0))
(setq k1 (rtos k 2 0))
(if (< (atoi k1) k)
(progn
(setq k11 (+ (atoi k1) 1))
(setq k1 (rtos k11 2 0))
)
)
(setq k2 (* (/ TileBd 10) (atoi k1)))
(setq p3 (list (car p1) k2 0.0))
(setq st (strcat (substr b 6 1) (substr b 7 1)))
(if (= opt nil)
(progn
(setq i (+ odo 1))
(setq ngang (/ onale 10))
(setq doc (/ odole 10))
(if (> (- k2 (cadr p1)) (* 0.03 TileBd))
(setq i odo)
)
)
)

(if (/= opt nil)
(progn
(setq ngang (/ odole 10))
(setq doc (/ onale 10))
(setq i (+ ona 1))
(if (> (- k2 (cadr p1)) (* 0.02 TileBd))
(setq i ona)
)
)
)
(setq m 1)
(setq ii i)
(while (<= m i)
(progn
(setq X (rtos (cadr p3) 2 0))
(setq Xt (strcat (substr X 1 1) (substr X 2 1) (substr X 3 1) (substr X 4 1)))
(setq Xd (strcat (substr X 5 1) (substr X 6 1) (substr X 7 1)))
(setq p31 (list (* -0.01 TileBd) 0 0))
(setq p41 (list (* 0.005 TileBd) (* 0.001 TileBd) 0))
(setq p51 (list (* 0.005 TileBd) (* -0.003 TileBd) 0))
(setq p4 (mapcar '+ p3 p31))
(setq p5 (mapcar '+ p4 p41))
(setq p6 (mapcar '+ p4 p51))
(command "_line" p4 p3 "")
(if (= opt nil)
(progn
(command "_text" "s" "arial" "j" "C" p5 (* 0.002 TileBd) "0" Xt)
(command "_text" "s" "arial" "j" "C" p6 (* 0.002 TileBd) "0" Xd)
)
)
(if (/= opt nil)
(progn
(setq p41 (list (* 0.003 TileBd) 0 0))
(setq p41 (mapcar '+ p4 p41))
(command "_text" "s" "arial" "j" "R" p41 (* 0.002 TileBd) "90" (strcat Xt " "))
(command "_text" "s" "arial" p41 (* 0.002 TileBd) "90" (strcat " " Xd))
)
)
(setq p31 (list (* ngang TileBd) 0 0))
(setq p33 (mapcar '+ p3 p31))
(setq p44 (mapcar '+ p4 p31))
(setq p55 (mapcar '+ p5 p31))
(setq p66 (mapcar '+ p6 p31))
(command "_line" p44 p33 "")
(if (= opt nil)
(progn
(command "_text" "s" "arial" "j" "C" p55 (* 0.002 TileBd) "0" Xt)
(command "_text" "s" "arial" "j" "C" p66 (* 0.002 TileBd) "0" Xd)
)
)
(if (/= opt nil)
(progn
(setq p331 (list (* -0.001 TileBd) 0 0))
(setq p331 (mapcar '+ p33 p331))
(command "_text" "s" "arial" "j" "R" p331 (* 0.002 TileBd) "90" (strcat Xt " "))
(command "_text" "s" "arial" p331 (* 0.002 TileBd) "90" (strcat " " Xd))
)
)
(setq p31 (list 0 (* 0.1 TileBd) 0))
(setq p3 (mapcar '+ p3 p31))
(setq m (+ 1 m))
)
)
(setq j (/ (car p1) (/ TileBd 10)))
(setq j1 (rtos j 2 0))
(if (< (atoi j1) j)
(progn
(setq j11 (+ (atoi j1) 1))
(setq j1 (rtos j11 2 0))
)
)
(setq j2 (* (* 0.1 TileBd) (atoi j1)))
(setq q3 (list j2 (cadr p1) 0.0))
(setq st (strcat (substr c 5 1) (substr c 6 1)))
(if (= opt nil)
(progn
(setq ngang (/ onale 10))
(setq doc (/ odole 10))
(setq i (+ ona 1))
(if (> (- j2 (car p1)) (* 0.02 TileBd))
(setq i ona)
)
)
)
(if (/= opt nil)
(progn
(setq ngang (/ odole 10))
(setq doc (/ onale 10))
(setq i (+ odo 1))
(if (> (- j2 (car p1)) (* 0.03 TileBd))
(setq i odo)
)
)
)
(setq m 1)
(setq jj i)
(while (<= m i)
(progn
(setq Y (rtos (car q3) 2 0))
(setq Yt (strcat (substr Y 1 1) (substr Y 2 1) (substr Y 3 1)))
(setq Yd (strcat (substr Y 4 1) (substr Y 5 1) (substr Y 6 1)))
(setq q31 (list 0 (* -0.01 TileBd) 0))
(setq q41 (list 0 (* 0.0005 TileBd) 0))
(setq q4 (mapcar '+ q3 q31))
(setq q5 (mapcar '+ q4 q41))
(command "_line" q4 q3 "")
(if (= opt nil)
(progn
(command "_text" "s" "arial" "j" "R" q5 (* 0.002 TileBd) "0" (strcat Yt " "))
(command "_text" "s" "arial" q5 (* 0.002 TileBd) "0" (strcat " " Yd))
)
)
(if (/= opt nil)
(progn
(setq q555 (list (* -0.001 TileBd) (* 0.005 TileBd) 0))
(setq q666 (list (* 0.003 TileBd) (* 0.005 TileBd) 0))
(setq q5551 (mapcar '+ q5 q555))
(setq q6661 (mapcar '+ q5 q666))
(command "_text" "s" "arial" "j" "C" q5551 (* 0.002 TileBd) "90" Yt)
(command "_text" "s" "arial" "j" "C" q6661 (* 0.002 TileBd) "90" Yd)
)
)
(setq q31 (list 0 (* doc TileBd) 0))
(setq q41 (list 0 (* (+ doc 0.0065) TileBd) 0))
(setq q33 (mapcar '+ q3 q31))
(setq q44 (mapcar '+ q4 q31))
(setq q55 (mapcar '+ q5 q41))
(command "_line" q44 q33 "")
(if (= opt nil)
(progn
(command "_text" "s" "arial" "j" "R" q55 (* 0.002 TileBd) "0" (strcat Yt " "))
(command "_text" "s" "arial" q55 (* 0.002 TileBd) "0" (strcat " " Yd))
)
)
(if (/= opt nil)
(progn
(setq q555 (list (* -0.001 TileBd) (* 0.005 TileBd) 0))
(setq q666 (list (* 0.003 TileBd) (* 0.005 TileBd) 0))
(setq q5551 (mapcar '+ q44 q555))
(setq q6661 (mapcar '+ q44 q666))
(command "_text" "s" "arial" "j" "C" q5551 (* 0.002 TileBd) "90" Yt)
(command "_text" "s" "arial" "j" "C" q6661 (* 0.002 TileBd) "90" Yd)
)
)
(setq q31 (list (* 0.1 TileBd) 0 0))
(setq q3 (mapcar '+ q3 q31))
(setq m (+ 1 m))
)
)
(setq tl TileBd)
(setq goc (list j2 k2 0))
(setq gocd goc)
(setq n 1)
(while (<= n ii)
(progn
(setq m 1)
(setq gocn gocd)
(while (<= m jj)
(progn
(setq r gocn)
(setq r1 (list (* -0.0025 tl) 0 0))
(setq r2 (list (* 0.0025 tl) 0 0))
(setq r3 (list 0 (* -0.0025 tl) 0))
(setq r4 (list 0 (* 0.0025 tl) 0))
(setq r11 (mapcar '+ r r1))
(setq r22 (mapcar '+ r r2))
(setq r33 (mapcar '+ r r3))
(setq r44 (mapcar '+ r r4))
(command "_line" r11 r22 "")
(command "_line" r33 r44 "")
(setq aa (list (* 0.1 tl) 0 0))
(setq gocn (mapcar '+ gocn aa))
(setq m (+ 1 m))
)
)
(setq bb (list 0 (* 0.1 tl) 0))
(setq gocd (mapcar '+ gocd bb))
(setq n (+ 1 n))
)
)
(setvar "clayer" LayerOld)
(setvar "osmode" oold)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  • 0

* 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.


#1325 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 01 October 2012 - 02:48 PM

Tôi trích xuất values của block attributes, viết bằng tiếng Việt Unicode, nhưng:
- Khi xuất ra trên cad thì nó vẫn ra tiếng Việt như đã ghi trong values (VD: "MẶT BẰNG").
- Còn khi xuất ra file (xls, csv) thì nó chuyển thành unicode hexa (VD: "M\U+1EB6T B\U+1EB0NG"). Ai biết cách để nó vẫn giữ nguyên tiếng Việt mà không đổi qua hecxa xin chỉ giùm. Thanks!
P/S: hình như bác Gia_bach rành cái này. Mà vừa test thử "Exblk.vlx" (phiên bản mới nhất) của bác cũng bị như vậy.
  • 0

* 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.


#1326 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 October 2012 - 07:07 PM

Bác nên thử thuần lisp thay vì Vl trong trường hợp này xem sao ^^
  • 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


#1327 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 01 October 2012 - 07:20 PM

Thuần lisp cũng không sáng sủa gì Ket ạ. Nó vẫn Hecxa.
VD:
(setq PW (open "D:\\a.csv" "w"))
(princ (cdr (assoc 1 a)) PW)
(close PW)
Trong đó: a lấy được từ block_att: '((...) (1. "MẶT BẰNG") (...))
  • 0

* 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.


#1328 VoHoan

VoHoan

    biết lệnh move

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

Đã gửi 02 October 2012 - 03:31 PM

Lâu nay dùng cái lisp "zv0" mà không xem thuật toán của nó. Giờ xem lại thấy có mấy thắc mắc xin các bắc giải thích hộ cái.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=2817
(defun c:ve0 ()
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)


- Trường hợp đối tượng (ent) là đường LWPOLYLINE: đưa giá trị Z về 0 thì đổi (assoc 38 ent) về (38 . 0), nhưng sao mình xem (entget ent) không thấy nó đâu nhỉ.
- Còn các trường hợp còn lại:
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
có phải là tên các đối tượng sau không:

(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
  • 0

#1329 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 02 October 2012 - 03:48 PM

1). Lwpolyline có dxf 38. Bạn xem lại. Trường hợp khác thì bạn post bản vẽ lên xem nhé.
2). Đúng như bạn hỏi. Hàm (tendoituong ssdt) lấy kiểu đối tượng (LINE, ARC, HATCH...).
  • 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.


#1330 VoHoan

VoHoan

    biết lệnh move

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

Đã gửi 02 October 2012 - 04:12 PM

1). Lwpolyline có dxf 38. Bạn xem lại. Trường hợp khác thì bạn post bản vẽ lên xem nhé.
2). Đúng như bạn hỏi. Hàm (tendoituong ssdt) lấy kiểu đối tượng (LINE, ARC, HATCH...).

Bạn có thể giải thích cho mình cái hàm con "suadinh" với!
  • 0

#1331 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 02 October 2012 - 04:48 PM

Hàm này nhiều khả năng do bác Duy viết. Vậy, bác Duy đang online thì nhờ trả lời giùm cho nhanh vậy.
  • 0

* 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.


#1332 VoHoan

VoHoan

    biết lệnh move

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

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

Hàm này nhiều khả năng do bác Duy viết. Vậy, bác Duy đang online thì nhờ trả lời giùm cho nhanh vậy.

Về thuật toán thì mình đọc thấy cũng hiểu được, nhưng ý tưởng của nó thì chịu. Đành nhờ đích danh bác Duy nhà ta giải thích giùm với!
  • 0

#1333 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 - 07:42 PM

Thuần lisp cũng không sáng sủa gì Ket ạ. Nó vẫn Hecxa.
VD:
(setq PW (open "D:\\a.csv" "w"))
(princ (cdr (assoc 1 a)) PW)
(close PW)
Trong đó: a lấy được từ block_att: '((...) (1. "MẶT BẰNG") (...))

@bac Hạ : bác tìm hàm ghi file Unicode trong 4room mục Đố vui với lisp (phần bác đố khi load lisp bằng mà Unicode chứ k phải Ansi) xem có còn k, có lẽ là áp dụng được, còn không thì cái này sửa bên Excel cũng đơn giản quá mà ^^
  • 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


#1334 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 02 October 2012 - 08:00 PM

@bac Hạ : bác tìm hàm ghi file Unicode trong 4room mục Đố vui với lisp (phần bác đố khi load lisp bằng mà Unicode chứ k phải Ansi) xem có còn k, có lẽ là áp dụng được, còn không thì cái này sửa bên Excel cũng đơn giản quá mà ^^

1). Hôm qua có xem rồi, file còn đây, nhưng nghĩ là không được nên dừng. Nay Ket nhắc thì chắc phải xem xét lại.
2). Chuyển bên excel đơn giản ư? Sao bác không nghĩ ra lối nhỏ nào cả. Két chỉ giùm xem.
  • 0

* 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.


#1335 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 - 08:00 PM

Bạn có thể giải thích cho mình cái hàm con "suadinh" với!

Xem qua thì thấy hàm này bác OP viết dài và rườm rà quá, có lẽ viết từ lâu rồi ^^
Hàm sửa đỉnh có chức năng chuyển tất cả cao độ thành 0.0

Bạn nên biết là mã dxf từ 10 -> 39 có kiểu là 3D point, tức là tọa độ



;Hàm sửa đỉnh, đối số là entity data (thong tin)
(defun suadinh (thongtin / index doituong doituongmoi toado)
;Khởi tạo biến thông tin mới là 1 list trống
(setq thongtinmoi nil)
;Duyệt qua từng sub-list của entity data (cái mà bạn dùng entget để lấy)
(foreach doituong thongtin
;Nếu mã dxf <= 10 <= 36 thì ...
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
;thay giá trị thứ 3 của mã Dxf này bằng giá trị 0.0 (tọa độ 3D thì cái thứ 3 là cao độ Z)
(setq doituongmoi
(list (car doituong) ;Dxf
(cadr doituong) ;X
(caddr doituong) ;Y
0.0 ;Z
)
)
;Nếu không thì giữ nguyên
(setq doituongmoi doituong)
)
;Thông tin của đối tượng mới sẽ bằng thông tin của các mã dxf không thuộc 10-36 + thông tin đã sửa
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
;Gọi lại giá trị
(setq thongtinmoi thongtinmoi)
)


  • 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


#1336 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 - 08:01 PM

1). Hôm qua có xem rồi, file còn đây, nhưng nghĩ là không được nên dừng. Nay Ket nhắc thì chắc phải xem xét lại.
2). Chuyển bên excel đơn giản ư? Sao bác không nghĩ ra lối nhỏ nào cả. Két chỉ giùm xem.

Marco replace thôi bác ơi , code viết cũng như cái lisp bác đã viết 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


#1337 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 02 October 2012 - 08:39 PM

Hàm này nhiều khả năng do bác Duy viết. Vậy, bác Duy đang online thì nhờ trả lời giùm cho nhanh vậy.

Cái ve0 này chính xác là của bác Hoành viết thời sinh viên chứ không phải mình.
  • 1

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


#1338 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 - 08:50 PM

Hi hi, cả làng nhầm hàng ^^
  • 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


#1339 VoHoan

VoHoan

    biết lệnh move

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

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

Mình cũng nhớ mơ màng là của bác Hoành, vì trong đó có phần đếm %, nhưng mà được bác Duy trả lời cũng OK. Cuối cùng thì "like this" cho Ketxu, hơi lòng vòng tý thế mà hay!
Trở lại vấn đề mình hỏi.
Nếu là Lwpolyline thì tọa độ Z được lưu là (38 . z) đơn giản hơn các trường hợp khác phải là (DXF x y z) phải không ketxu?
  • 0

#1340 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 - 09:27 PM

Đúng rồi. Bạn có thể tìm 1 lisp quick flatten ketxu post lên lâu lâu rồi, cơ chế sẽ đơn giản hơn chỉnh sửa dxf này nhiều ^^
  • 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