Info | File |
Tác giả: nhoclangbat
Bài viết gốc: 309465
Tên lệnh: angsidet ast |
Nhờ giúp lisp lấy tọa độ x,y
@@ "trạm máy" => "hướng ngắm" => "số bắt đầu" nhập stt đầu tiên bạn mún lấy tọa độ rùi cứ pick tiếp các điểm bạn cần lấy thui xong rùi space ghi bảng ra cad rùi xuất file .txt thui, lsp trên thiếu style, nhoc quên :), tại trong máy truoc khi vẽ nhoc đã tạo đủ style nên ko viết tỏng lsp bạn tải lại lsp này thử ^^
;; free lisp from cadviet.com
;;; this lisp was...
>> @@ "trạm máy" => "hướng ngắm" => "số bắt đầu" nhập stt đầu tiên bạn mún lấy tọa độ rùi cứ pick tiếp các điểm bạn cần lấy thui xong rùi space ghi bảng ra cad rùi xuất file .txt thui, lsp trên thiếu style, nhoc quên :), tại trong máy truoc khi vẽ nhoc đã tạo đủ style nên ko viết tỏng lsp bạn tải lại lsp này thử ^^
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(defun INPUTST (Pt0 num2 Sln user / ang2 delang dis st dl dat Htext d1 d2
d3 d4)
(setvar "texteval" 1)
(setq htext 0.75)
(setq ang2 (angle base PT0))
(setq delang (- ang ang2))
(if (< delang 0)
(setq delang (+ delang (* 2 pi)))
)
(setq dis (* (distance base PT0) (expt user -1)))
(setq SLn (max delang dis Sln))
(setq st (strcat " " (itoa num2)))
(setq Dat (list delang dis))
(setq Ldata (append Ldata Dat (list (cadr PT0) (car PT0))))
(setvar "Osmode" 0)
(command "_layer" "s" "mia" "")
(setq d1 (Polar pt0 0 0.27))
(setq d2 (Polar pt0 (/ pi 2) 0.27))
(setq d3 (Polar pt0 pi 0.27))
(setq d4 (Polar pt0 (* 1.5 pi) 0.27))
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "_layer" "s" "somia" "")
(command "Text" "S" "vhelvei" "Bl" pt0 htext "0" St)
)
;;;
(defun RatoST (Ra / kq Deg du Mi sec stemp stp str)
(setq kq (/ (* Ra 180.0) pi))
(setq Deg (fix kq))
(setq du (- kq Deg))
(setq du3 (* du 60.0))
(setq Mi (fix du3))
(setq sec (* (- du3 Mi) 60.0))
(setq sec (fix sec))
(setq stemp (itoa Mi))
(setq deg (itoa Deg))
(if (< (strlen stemp) 2)
(setq stemp (strcat "0" stemp))
)
(setq stp (itoa sec))
(if (< (strlen stp) 2)
(setq stp (strcat "0" stp))
)
(if (< (strlen deg) 2)
(setq deg (strcat "0" deg))
)
;;; (if (< (strlen deg) 3)
;;; (setq deg (strcat "0" deg))
;;; )
(setq str (strcat Deg "." stemp stp ))
)
;;;
;;;PHAN XuatT RA MAN HINH DO HOA
(defun XuatT (Spoint LData MaxLen num3 / Osm L1 htext
Hc Lenghthy p1 p2 p3 p3x p3y
p4 p5 p6 p7 p8 p31 p32 p71
p72 ptd Pd Pd1 Pd2 Pd3 Pd3X Pd3Y pstt pang Pside j dl toadY
toadX
)
(setq Osm (getvar "Osmode"))
(setvar "Osmode" 0)
(setvar "texteval" 1)
(setq htext (getvar "Textsize"))
(setq L1 (* Htext 5)
hC (* Htext 3)
)
(setq MaxLen (* MaxLen Htext 0.4))
(setq Lenghthy (+ L1 (* MaxLen 3)))
(setq p1 (getpoint "\n Diem dat bang toa do :"))
(command "_layer" "s" "bang_toado" "")
(if (/= p1 nil)
(progn
(setq p2 (Polar p1 0 Lenghthy))
(setq p3 (Polar p1 (* 1.5 pi) hc))
(setq p4 (Polar p3 0 Lenghthy))
(setq p5 (Polar p3 (* 1.5 pi) hc))
(setq p6 (Polar p5 0 Lenghthy))
(setq p7 (Polar p5 (* 1.5 pi) (* (1+ Spoint) hc)))
(setq p8 (Polar p7 0 Lenghthy))
(setq p31 (Polar p3 0 L1))
(setq p32 (Polar p31 0 MaxLen))
(setq p33 (Polar p32 0 MaxLen))
(setq p71 (Polar p7 0 L1))
(setq p72 (Polar p71 0 MaxLen))
(setq p73 (Polar p72 0 MaxLen))
(command "Line" p1 p2 p8 p7 "c")
(command "Line" p3 p4 "")
(command "Line" p5 p6 "")
(command "Line" p7 p8 "")
(command "Line" p31 p71 "")
(command "Line" p32 p72 "")
(command "Line" p33 p73 "")
(setq ptd (mapcar '+ p1 (list (/ Lenghthy 2) (- (/ hC 2)))))
(setq pstt (mapcar '+ p3 (list (/ L1 2) (- (/ hC 2)))))
(setq pang (mapcar '+ pstt (list (/ (+ MaxLen L1) 2) 0)))
(setq Pside (mapcar '+ pang (list MaxLen 0)))
(setq Pnot (mapcar '+ Pside (list MaxLen 0)))
(command "_layer" "s" "bang_toado" "")
(command "text" "S" "vhelveb"
"MC" ptd Htext
"0" "BANG THONG KE TOA DO"
)
(command "text" "MC" pstt Htext "0" "STT")
(command "text" "MC" Pnot Htext "0" " TOADO X TOADO Y")
(setq j 0)
(setq n 1)
(repeat Spoint
(setq Pd1 (mapcar '+ p5 (list (/ L1 2) (- (* hC n)))))
(setq Pd2 (Polar pd1 0 (/ (+ L1 MaxLen) 2)))
(setq Pd3 (mapcar '+ pd2 (list MaxLen 0)))
(setq Pd3X (mapcar '+ Pd3 (list MaxLen 0)))
(setq Pd3Y (mapcar '+ Pd3X (list MaxLen 0)))
(setq delang (Nth j Ldata))
(setq dis (Nth (+ j 1) Ldata))
(setq toadY (Nth (+ j 2) Ldata))
(setq toadX (Nth (+ j 3) Ldata))
(command "text" "S" "vaptimn" "c" pd1 Htext "0" (itoa num3))
(setq dis (rtos dis 2 3))
(setq toadY (rtos toadY 2 3))
(setq toadX (rtos toadX 2 3))
;;; (while (< (strlen dis) 9)
;;; (setq dis (strcat "0" dis))
;;; )
;;; (setq dis1 (substr dis 1 5))
;;; (setq dis2 (substr dis 7 9))
;;; (setq dis (strcat dis1 dis2))
(setq st (strcat (itoa n) "\t" (RatoST delang) "\t" dis))
(command "text" "S" "vaptimn" "C" pd3X Htext "0" toadY)
(command "text" "S" "vaptimn" "C" pd3Y Htext "0" toadX)
(setq j (+ j 4))
(setq n (1+ n))
(setq num3 (1+ num3))
) ;repeat
)
)
(setvar "Osmode" Osm)
)
;;;
;;;PHAN CHUNG TRINH CHINH
;;;
(defun C:AngSideT (/ d1 d2 d3 d4 num3 num
num1 num2 lupreccu units Andir Anu
user sc Base PT ang pt0 i
Nmax Ldata MaxLen Spoint TL
)
(setvar "dimzin" 1)
(setvar "cmdecho" 1)
(setq unts (getvar "lunits"))
(setvar "lunits" 2)
;them
(setvar "luprec" 3)
(setq Andir (getvar "Angdir"))
(setvar "angdir" 0)
(setq Anu (getvar "AUNITS"))
(setvar "AUNITS" 0)
(setq user (getvar "USERR1"))
(if (= user 0)
(progn
(setq user 1)
(setvar "USERR1" 1)
)
)
;;; (setq sc (getreal (strcat "\nTy le ban ve (nhap day du)<" (rtos user) ">:")))
;;; (if (and (/= sc nil) (/= sc 0)) (setvar "USERR1" sc))
;;; (setq user (getvar "USERR1"))
(if (null (tblsearch "layer" "mia"))
(command "_layer" "N" "mia" "")
)
(if (null (tblsearch "layer" "somia"))
(command "_layer" "N" "somia" "")
)
(if (null (tblsearch "layer" "trammay"))
(command "_layer" "N" "trammay" "")
)
(if (null (tblsearch "layer" "bang_toado"))
(command "_layer" "n" "bang_toado" "")
)
(if (null (tblsearch "style" "vhelvei"))
(command "_style" "vhelvei" "vhelvei.ttf" "" "" "" "" "")
)
(if (null (tblsearch "style" "vhelveb"))
(command "_style" "vhelveb" "vhelveb.ttf" "" "" "" "" "")
)
(if (null (tblsearch "style" "vaptimn"))
(command "_style" "vaptimn" "vaptimn.ttf" "" "" "" "" "")
)
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "1" "somia" "")
(command "_layer" "c" "3" "mia" "")
(initget 1)
(setvar "Osmode" 33)
(setq Base (getpoint "\nTram may: "))
(command "_layer" "s" "trammay" "")
(setq d1 (Polar base 0 0.27))
(setq d2 (Polar base (/ pi 2) 0.27))
(setq d3 (Polar base pi 0.27))
(setq d4 (Polar base (* 1.5 pi) 0.27))
(setvar "Osmode" 0)
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "CIRCLE" base 0.22)
(setvar "Osmode" 33)
(setq PT (getpoint base "\nHuong ngam: "))
(setq ang (angle base PT))
(setq d1 (Polar pt 0 0.27))
(setq d2 (Polar pt (/ pi 2) 0.27))
(setq d3 (Polar pt pi 0.27))
(setq d4 (Polar pt (* 1.5 pi) 0.27))
(setvar "Osmode" 0)
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "CIRCLE" pt 0.22)
(setq num (getint "\nSo bat dau:"))
(setq num2 num)
(setq num1 num)
(setq num3 num)
(setvar "Osmode" 545)
(setq pt0 (getpoint base "\nMia:"))
(setq i 1
Ldata nil
)
(setq Nmax 1)
(while (/= pt0 nil)
(INPUTST pt0 num2 Nmax user)
(setvar "Osmode" 1)
(setq pt0 (getpoint base "\nSelect endpoints:"))
(setq num2 (1+ num2))
(setq i (+ i 1))
)
(setq Spoint (- i 1))
(setq MaxLen (* (strlen (angtos Nmax 1 4)) 3))
(XuatT Spoint Ldata MaxLen num3)
;;; (initget 1 "Yes No")
;;; (setq TL (getKword "\nCo ghi du lieu ra file?<N>:"))
;;; (if (= TL "Yes")
(SaveT Ldata Spoint num1)
(setvar "AUNITS" Anu)
(setvar "lunits" unts)
(setvar "angdir" Andir)
(setvar "cmdecho" 1)
(princ)
)
;;;
;;;PHAN GHI VAO FILE
(defun SaveT (Ldata Spoint num1 / Fname Fn j n delang dis toadY toadX)
(setq fname (Getfiled "TAO FILE MOI" "" "Txt" 1))
(setq fn (OPEN Fname "W"))
(setq j 0)
(setvar "luprec" 3)
(setq n num1)
(Write-line "BEGIN" fn)
(Write-line "TiTle" fn)
(repeat Spoint
(setq delang (Nth j Ldata))
(setq dis (Nth (+ j 1) Ldata))
(setq toadY (Nth (+ j 2) Ldata))
(setq toadX (Nth (+ j 3) Ldata))
(setq toadY (rtos toadY 2 3))
(setq toadX (rtos toadX 2 3))
(setq dis (rtos dis 2 3))
;;; (while (< (strlen dis) 9)
;;; (setq dis (strcat "0" dis))
;;; )
;;; (setq dis1 (substr dis 1 5))
;;; (setq dis2 (substr dis 7 9))
;;; (setq dis (strcat dis1 dis2))
(setq st (strcat "NOI DUNG 1, " "\t" "NOI DUNG 2, " "\t" toadY "\t" "\t" toadX "\t" "\t" "NOIDUNG 3"))
(Write-line st fn)
(setq j (+ j 4))
(setq n (+ 1 n))
);repeat
(Write-line "end" fn)
(close fn)
)
;;;
(defun C:AST ()
(setvar "dimzin" 1)
(C:AngSideT)
)
(print "Start by command AngSideT or AST")
<<
|
Filename: 309465_angsidet_ast.lsp
|
|
Tác giả: Tot77
Bài viết gốc: 309466
Tên lệnh: int |
Tại sao bắt điểm Intersection tại điểm giao trên 3D không được?
Nhìn bằng mắt thì thấy nó giao nhau nhưng dùng lệnh dưới đây thì chỉ có điểm D là giao thôi.
@tien2005 : lệnh ID thì cứ phương đứng là y, ngang là x. Nhưng ở đây đứng là z.
(defun c:int(/ a b c)
(defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
(defun ints (o1 o2 mo)
(get3 (vlax-Invoke (vlax-EName->vla-Object o1)...
>> Nhìn bằng mắt thì thấy nó giao nhau nhưng dùng lệnh dưới đây thì chỉ có điểm D là giao thôi.
@tien2005 : lệnh ID thì cứ phương đứng là y, ngang là x. Nhưng ở đây đứng là z.
(defun c:int(/ a b c)
(defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
(defun ints (o1 o2 mo)
(get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo))
)
(setq a (car (entsel "\nchon doi tuong 1: "))
b (car (entsel "\nchon doi tuong 2: "))
c (ints a b acextendnone)
)
)
<<
|
Tác giả: nhoclangbat
Bài viết gốc: 309510
Tên lệnh: angsidet ast |
Nhờ giúp lisp lấy tọa độ x,y
@@ nhoc cũng chưa rành lisp đâu viết nổi lisp chôm người ta mà, chỉ lỗi thiếu style mà lisp bắt buộc có thui, nhoc đã sữa rùi lần này bảo đảm chạy ngọt :))
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(command "style" "vhelvei" "vni-helve" 0 1 0 "" "")
(command "style"...
>> @@ nhoc cũng chưa rành lisp đâu viết nổi lisp chôm người ta mà, chỉ lỗi thiếu style mà lisp bắt buộc có thui, nhoc đã sữa rùi lần này bảo đảm chạy ngọt :))
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109178-nho-giup-lisp-lay-toa-do-x-y/
(command "style" "vaptimn" "vni-aptima" 0 1 0 "" "")
(command "style" "vhelvei" "vni-helve" 0 1 0 "" "")
(command "style" "vhelveb" "vni-avo" 0 1 0 "" "")
(defun INPUTST (Pt0 num2 Sln user / ang2 delang dis st dl dat Htext d1 d2
d3 d4)
(setvar "texteval" 1)
(setq htext 0.75)
(setq ang2 (angle base PT0))
(setq delang (- ang ang2))
(if (< delang 0)
(setq delang (+ delang (* 2 pi)))
)
(setq dis (* (distance base PT0) (expt user -1)))
(setq SLn (max delang dis Sln))
(setq st (strcat " " (itoa num2)))
(setq Dat (list delang dis))
(setq Ldata (append Ldata Dat (list (cadr PT0) (car PT0))))
(setvar "Osmode" 0)
(command "_layer" "s" "mia" "")
(setq d1 (Polar pt0 0 0.27))
(setq d2 (Polar pt0 (/ pi 2) 0.27))
(setq d3 (Polar pt0 pi 0.27))
(setq d4 (Polar pt0 (* 1.5 pi) 0.27))
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "_layer" "s" "somia" "")
(command "Text" "S" "vhelvei" "Bl" pt0 htext "0" St)
)
;;;
(defun RatoST (Ra / kq Deg du Mi sec stemp stp str)
(setq kq (/ (* Ra 180.0) pi))
(setq Deg (fix kq))
(setq du (- kq Deg))
(setq du3 (* du 60.0))
(setq Mi (fix du3))
(setq sec (* (- du3 Mi) 60.0))
(setq sec (fix sec))
(setq stemp (itoa Mi))
(setq deg (itoa Deg))
(if (< (strlen stemp) 2)
(setq stemp (strcat "0" stemp))
)
(setq stp (itoa sec))
(if (< (strlen stp) 2)
(setq stp (strcat "0" stp))
)
(if (< (strlen deg) 2)
(setq deg (strcat "0" deg))
)
;;; (if (< (strlen deg) 3)
;;; (setq deg (strcat "0" deg))
;;; )
(setq str (strcat Deg "." stemp stp ))
)
;;;
;;;PHAN XuatT RA MAN HINH DO HOA
(defun XuatT (Spoint LData MaxLen num3 / Osm L1 htext
Hc Lenghthy p1 p2 p3 p3x p3y
p4 p5 p6 p7 p8 p31 p32 p71
p72 ptd Pd Pd1 Pd2 Pd3 Pd3X Pd3Y pstt pang Pside j dl toadY
toadX
)
(setq Osm (getvar "Osmode"))
(setvar "Osmode" 0)
(setvar "texteval" 1)
(setq htext (getvar "Textsize"))
(setq L1 (* Htext 5)
hC (* Htext 3)
)
(setq MaxLen (* MaxLen Htext 0.4))
(setq Lenghthy (+ L1 (* MaxLen 3)))
(setq p1 (getpoint "\n Diem dat bang toa do :"))
(command "_layer" "s" "bang_toado" "")
(if (/= p1 nil)
(progn
(setq p2 (Polar p1 0 Lenghthy))
(setq p3 (Polar p1 (* 1.5 pi) hc))
(setq p4 (Polar p3 0 Lenghthy))
(setq p5 (Polar p3 (* 1.5 pi) hc))
(setq p6 (Polar p5 0 Lenghthy))
(setq p7 (Polar p5 (* 1.5 pi) (* (1+ Spoint) hc)))
(setq p8 (Polar p7 0 Lenghthy))
(setq p31 (Polar p3 0 L1))
(setq p32 (Polar p31 0 MaxLen))
(setq p33 (Polar p32 0 MaxLen))
(setq p71 (Polar p7 0 L1))
(setq p72 (Polar p71 0 MaxLen))
(setq p73 (Polar p72 0 MaxLen))
(command "Line" p1 p2 p8 p7 "c")
(command "Line" p3 p4 "")
(command "Line" p5 p6 "")
(command "Line" p7 p8 "")
(command "Line" p31 p71 "")
(command "Line" p32 p72 "")
(command "Line" p33 p73 "")
(setq ptd (mapcar '+ p1 (list (/ Lenghthy 2) (- (/ hC 2)))))
(setq pstt (mapcar '+ p3 (list (/ L1 2) (- (/ hC 2)))))
(setq pang (mapcar '+ pstt (list (/ (+ MaxLen L1) 2) 0)))
(setq Pside (mapcar '+ pang (list MaxLen 0)))
(setq Pnot (mapcar '+ Pside (list MaxLen 0)))
(command "_layer" "s" "bang_toado" "")
(command "text" "S" "vhelveb"
"MC" ptd Htext
"0" "BANG THONG KE TOA DO"
)
(command "text" "MC" pstt Htext "0" "STT")
(command "text" "MC" Pnot Htext "0" " TOADO X TOADO Y")
(setq j 0)
(setq n 1)
(repeat Spoint
(setq Pd1 (mapcar '+ p5 (list (/ L1 2) (- (* hC n)))))
(setq Pd2 (Polar pd1 0 (/ (+ L1 MaxLen) 2)))
(setq Pd3 (mapcar '+ pd2 (list MaxLen 0)))
(setq Pd3X (mapcar '+ Pd3 (list MaxLen 0)))
(setq Pd3Y (mapcar '+ Pd3X (list MaxLen 0)))
(setq delang (Nth j Ldata))
(setq dis (Nth (+ j 1) Ldata))
(setq toadY (Nth (+ j 2) Ldata))
(setq toadX (Nth (+ j 3) Ldata))
(command "text" "S" "vaptimn" "c" pd1 Htext "0" (itoa num3))
(setq dis (rtos dis 2 3))
(setq toadY (rtos toadY 2 3))
(setq toadX (rtos toadX 2 3))
;;; (while (< (strlen dis) 9)
;;; (setq dis (strcat "0" dis))
;;; )
;;; (setq dis1 (substr dis 1 5))
;;; (setq dis2 (substr dis 7 9))
;;; (setq dis (strcat dis1 dis2))
(setq st (strcat (itoa n) "\t" (RatoST delang) "\t" dis))
(command "text" "S" "vaptimn" "C" pd3X Htext "0" toadY)
(command "text" "S" "vaptimn" "C" pd3Y Htext "0" toadX)
(setq j (+ j 4))
(setq n (1+ n))
(setq num3 (1+ num3))
) ;repeat
)
)
(setvar "Osmode" Osm)
)
;;;
;;;PHAN CHUNG TRINH CHINH
;;;
(defun C:AngSideT (/ d1 d2 d3 d4 num3 num
num1 num2 lupreccu units Andir Anu
user sc Base PT ang pt0 i
Nmax Ldata MaxLen Spoint TL
)
(setvar "dimzin" 1)
(setvar "cmdecho" 1)
(setq unts (getvar "lunits"))
(setvar "lunits" 2)
;them
(setvar "luprec" 3)
(setq Andir (getvar "Angdir"))
(setvar "angdir" 0)
(setq Anu (getvar "AUNITS"))
(setvar "AUNITS" 0)
(setq user (getvar "USERR1"))
(if (= user 0)
(progn
(setq user 1)
(setvar "USERR1" 1)
)
)
;;; (setq sc (getreal (strcat "\nTy le ban ve (nhap day du)<" (rtos user) ">:")))
;;; (if (and (/= sc nil) (/= sc 0)) (setvar "USERR1" sc))
;;; (setq user (getvar "USERR1"))
(if (null (tblsearch "layer" "mia"))
(command "_layer" "N" "mia" "")
)
(if (null (tblsearch "layer" "somia"))
(command "_layer" "N" "somia" "")
)
(if (null (tblsearch "layer" "trammay"))
(command "_layer" "N" "trammay" "")
)
(if (null (tblsearch "layer" "bang_toado"))
(command "_layer" "n" "bang_toado" "")
)
;(if (null (tblsearch "style" "vhelvei"))
;(command "_style" "vhelvei" "vhelvei.ttf" "" "" "" "" "")
;)
;(if (null (tblsearch "style" "vhelveb"))
;(command "_style" "vhelveb" "vhelveb.ttf" "" "" "" "" "")
;)
;(if (null (tblsearch "style" "vaptimn"))
;(command "_style" "vaptimn" "vaptimn.ttf" "" "" "" "" "")
;)
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "1" "somia" "")
(command "_layer" "c" "3" "mia" "")
(initget 1)
(setvar "Osmode" 33)
(setq Base (getpoint "\nTram may: "))
(command "_layer" "s" "trammay" "")
(setq d1 (Polar base 0 0.27))
(setq d2 (Polar base (/ pi 2) 0.27))
(setq d3 (Polar base pi 0.27))
(setq d4 (Polar base (* 1.5 pi) 0.27))
(setvar "Osmode" 0)
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "CIRCLE" base 0.22)
(setvar "Osmode" 33)
(setq PT (getpoint base "\nHuong ngam: "))
(setq ang (angle base PT))
(setq d1 (Polar pt 0 0.27))
(setq d2 (Polar pt (/ pi 2) 0.27))
(setq d3 (Polar pt pi 0.27))
(setq d4 (Polar pt (* 1.5 pi) 0.27))
(setvar "Osmode" 0)
(command "Line" d1 d3 "")
(command "Line" d2 d4 "")
(command "CIRCLE" pt 0.22)
(setq num (getint "\nSo bat dau:"))
(setq num2 num)
(setq num1 num)
(setq num3 num)
(setvar "Osmode" 545)
(setq pt0 (getpoint base "\nMia:"))
(setq i 1
Ldata nil
)
(setq Nmax 1)
(while (/= pt0 nil)
(INPUTST pt0 num2 Nmax user)
(setvar "Osmode" 1)
(setq pt0 (getpoint base "\nSelect endpoints:"))
(setq num2 (1+ num2))
(setq i (+ i 1))
)
(setq Spoint (- i 1))
(setq MaxLen (* (strlen (angtos Nmax 1 4)) 3))
(XuatT Spoint Ldata MaxLen num3)
;;; (initget 1 "Yes No")
;;; (setq TL (getKword "\nCo ghi du lieu ra file?<N>:"))
;;; (if (= TL "Yes")
(SaveT Ldata Spoint num1)
(setvar "AUNITS" Anu)
(setvar "lunits" unts)
(setvar "angdir" Andir)
(setvar "cmdecho" 1)
(princ)
)
;;;
;;;PHAN GHI VAO FILE
(defun SaveT (Ldata Spoint num1 / Fname Fn j n delang dis toadY toadX)
(setq fname (Getfiled "TAO FILE MOI" "" "Txt" 1))
(setq fn (OPEN Fname "W"))
(setq j 0)
(setvar "luprec" 3)
(setq n num1)
(Write-line "BEGIN" fn)
(Write-line "TiTle" fn)
(repeat Spoint
(setq delang (Nth j Ldata))
(setq dis (Nth (+ j 1) Ldata))
(setq toadY (Nth (+ j 2) Ldata))
(setq toadX (Nth (+ j 3) Ldata))
(setq toadY (rtos toadY 2 3))
(setq toadX (rtos toadX 2 3))
(setq dis (rtos dis 2 3))
;;; (while (< (strlen dis) 9)
;;; (setq dis (strcat "0" dis))
;;; )
;;; (setq dis1 (substr dis 1 5))
;;; (setq dis2 (substr dis 7 9))
;;; (setq dis (strcat dis1 dis2))
(setq st (strcat "NOI DUNG 1, " "\t" "NOI DUNG 2, " "\t" toadY "\t" "\t" toadX "\t" "\t" "NOIDUNG 3"))
(Write-line st fn)
(setq j (+ j 4))
(setq n (+ 1 n))
);repeat
(Write-line "end" fn)
(close fn)
)
;;;
(defun C:AST ()
(setvar "dimzin" 1)
(C:AngSideT)
)
(print "Start by command AngSideT or AST")
<<
|
Filename: 309510_angsidet_ast.lsp
|
|
Tác giả: duytuankts
Bài viết gốc: 309553
Tên lệnh: 9 |
Nhờ sửa lisp chuyển layer và hướng dẫn về array trong block dynamic
;;************************Chuyen doi tuong ve dung layer
1. Mình dùng lisp chuyển đối tượng như sau để quản lý layer:
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end...
>> ;;************************Chuyen doi tuong ve dung layer
1. Mình dùng lisp chuyển đối tượng như sau để quản lý layer:
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )
Bây h mình muốn khi thực hiện lệnh của lisp trên "9" thì những đối tượng hatch của layer "---Q63-LAT NEN" không bị chuyển sang layer "---Q8-HATCH" thì phải sửa lisp như thế nào.
2. Mình muốn dùng tính năng array của block dynamic nhưng chỉ dùng được 1 chiều, muốn dùng 2 chiều thì như thế nào. Ví dụ: 1 viên gạch 500x500, chỉ cần kéo mũi tên sẽ lát gạch đó cho phòng 4000x6000 (file đính kèm)
3. Mình dùng cad hay bị lỗi khi sử dụng wipeout khi hiển thị vẫn che mất đối tượng nằm phía trên, nhưng khi move thì lại view đúng, rồi vẽ 1 lúc lại bị che mất (đối tượng nằm trên wipeout). In thì bình thường nhưng khi vẽ khó quản lý.
Thanks đã đọc. Chúc mọi người kỳ nghỉ vui vẻ.
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT") )
<<
|
Tác giả: gp14
Bài viết gốc: 13451
Tên lệnh: sum |
Lý thuyết sáng tác.
Cuộc hành trình lãng mạn qua các hình thức tổ hợp kiến trúc:
http://www.cadviet.com/upfiles/hanh_trinh_Langman.doc
|
Tác giả: tnmtpc
Bài viết gốc: 13455
Tên lệnh: sum |
Ghép số bị tách trong bình đồ
Lệnh quá hay!!! Nhưng góp ý và mong Bác nghiên cứu giúp: sau khi text được nối bị lệch vị trí sang trái, nếu giữ nguyên vị trí tại dấu chấm thì quá tuyệt vời
|
Tác giả: tien2005
Bài viết gốc: 309697
Tên lệnh: test |
Nối nhiều đường polyline vuông góc.
Bản vẽ của bạn là các line không phải polyline, các line được vẽ từ trái qua phải, từ trên xuống dưới. Bạn dùng lisp sau để tạo polyline, mình làm nhanh nên sẽ đúng về hình dạng, polyline ở layer hiện hành và có màu số 5 (xanh dương)
(defun c:test (/ ss lst)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun Make-LWPolyline
(listpoint closed Color / Lst)
(setq Lst (list '(0 ....
>> Bản vẽ của bạn là các line không phải polyline, các line được vẽ từ trái qua phải, từ trên xuống dưới. Bạn dùng lisp sau để tạo polyline, mình làm nhanh nên sẽ đúng về hình dạng, polyline ở layer hiện hành và có màu số 5 (xanh dương)
(defun c:test (/ ss lst)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun Make-LWPolyline
(listpoint closed Color / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 62
(if Color
Color
256
)
)
'(100 . "AcDbPolyline")
(cons 90
(if closed
(1+ (length listpoint))
(length listpoint)
)
)
(cons 70
(if closed
1
0
)
)
)
)
(foreach PP listpoint
(setq Lst (append Lst (list (cons 10 PP))))
)
(entmakex Lst)
)
(princ "\nChon cac line: ")
(if (setq ss (ssget '((0 . "line"))))
(progn
(setq
ss (vl-sort
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(function
(lambda (a b) (< (car (dxf 10 a)) (car (dxf 10 b))))
)
)
)
(foreach n ss
(setq lst (append lst (list (dxf 10 n) (dxf 11 n) (dxf 10 n))))
) ;for
(Make-LWPolyline lst nil 5)
) ;progn
) ;if
(princ)
)
<<
|
Filename: 309697_test.lsp
|
|
Tác giả: nhoclangbat
Bài viết gốc: 309734
Tên lệnh: 9 |
Nhờ sửa lisp chuyển layer và hướng dẫn về array trong block dynamic
^^ nhoc bỏ đại chạy thử thấy q63 ko bị đỗi thành Q8 :)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer"...
>> ^^ nhoc bỏ đại chạy thử thấy q63 ko bị đỗi thành Q8 :)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/109369-nho-sua-lisp-chuyen-layer-va-huong-dan-ve-array-trong-block-dynamic/
;;************************Chuyen doi tuong ve dung layer
(defun CHANGE-LAYER (_TYPE LAYER / OBJS)
(setq OBJS (ssget "X" (list (cons 0 _TYPE))))
(if (not (tblsearch "layer" LAYER))
(command ".layer" "m" LAYER "")
);_ end if
(command ".chprop" OBJS "" "la" LAYER "")
(princ)
);_ end defun
(defun C:9 (/ OBJS)
(CHANGE-LAYER "DIMENSION" "---Q7-DIM")
;(CHANGE-LAYER "HATCH" "---Q8-HATCH")
(CHANGE-LAYER "*TEXT" "---Q9-TEXT")
(if (and (setq ss (ssget "_x" '((0 . "HATCH") (-4 . "<not")(8 . "---Q63-LAT NEN")(-4 . "not>")))))
(command ".chprop" ss "" "la" "---Q8-HATCH" ""))
)
<<
|
Tác giả: tien2005
Bài viết gốc: 309735
Tên lệnh: noname |
Đếm, sắp xếp, ghi thông tin Block
BẠn thử cái này, chỉ ghi theo 8 hướng
không biết đặt tên gì, thôi thì NONAME :(
(defun c:NoName (/ p0 p1 ss pn ang dirr dxf maketext)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun maketext (p height str)
(entmake (list (cons 0 "TEXT")
(cons 10 p)
(cons 40 height)
(cons 1 str)
)
)
)
(or rank# (setq rank# 30))
(setq rank# (cond ((getint (strcat "\nDo lon cua so de chon <"
...
>> BẠn thử cái này, chỉ ghi theo 8 hướng
không biết đặt tên gì, thôi thì NONAME :(
(defun c:NoName (/ p0 p1 ss pn ang dirr dxf maketext)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun maketext (p height str)
(entmake (list (cons 0 "TEXT")
(cons 10 p)
(cons 40 height)
(cons 1 str)
)
)
)
(or rank# (setq rank# 30))
(setq rank# (cond ((getint (strcat "\nDo lon cua so de chon <"
(rtos rank# 2 0)
">: "
)
)
)
(rank#)
)
)
(command ".undo" "be")
(while (and (setq p0 (getpoint "\nChon diem chuan: "))
(setq ss
(ssget "x"
(list (cons 0 "insert")
(cons -4 ">=,>=,*")
(cons 10 (mapcar '- p0 (list rank# rank# rank#)))
(cons -4 "<=,<=,*")
(cons 10 (mapcar '+ p0 (list rank# rank# rank#)))
)
)
)
)
(setq p1
(cond
((getpoint
"\nChon diem ghi ket qua hoac enter de ghi tai diem chuan: "
)
)
(p0)
)
)
(setq
ss (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
'(lambda (x y)
(< (distance p0 (dxf 10 x))
(distance p0 (dxf 10 y))
)
)
)
)
(foreach n ss
(setq pn (dxf 10 n)
ang (angle p0 pn)
)
(cond
((or (>= (/ pi 8) ang) (< (/ (* 15 pi) 8) ang))
(setq dirr "Dong")
)
((>= (/ (* 3 pi) 8) ang) (setq dirr "Dong Bac"))
((>= (/ (* 5 pi) 8) ang) (setq dirr "Bac"))
((>= (/ (* 7 pi) 8) ang) (setq dirr "Tay Bac"))
((>= (/ (* 9 pi) 8) ang) (setq dirr "Tay"))
((>= (/ (* 11 pi) 8) ang) (setq dirr "Tay Nam"))
((>= (/ (* 13 pi) 8) ang) (setq dirr "Nam"))
((>= (/ (* 15 pi) 8) ang) (setq dirr "Dong Nam"))
)
(maketext p1 2.5 dirr)
(maketext (setq p1 (mapcar '- p1 (list 0 5 0)))
2.5
(dxf 2 n)
)
(maketext (setq p1 (mapcar '- p1 (list 0 5 0)))
2.5
(strcat "L=" (rtos (distance p0 pn) 2 2))
)
(setq p1 (mapcar '- p1 (list 0 8 0)))
) ;for
) ;while
(command ".undo" "en")
(princ)
)
<<
|
Filename: 309735_noname.lsp
|
|
Tác giả: Doan Van Ha
Bài viết gốc: 309737
Tên lệnh: ha |
Đếm, sắp xếp, ghi thông tin Block
Không hiểu hết ý của bạn ở cái đoạn "mình chỉ" nên tạm thế này.
; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng)
(setq pc (getpoint "\nChon diem chuan: "))
(setq cr (getreal "\nNhap chieu rong khung Window: "))
(setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt... >> Không hiểu hết ý của bạn ở cái đoạn "mình chỉ" nên tạm thế này.
; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng)
(setq pc (getpoint "\nChon diem chuan: "))
(setq cr (getreal "\nNhap chieu rong khung Window: "))
(setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
(foreach ent lst
(setq pg (cdr (assoc 10 (entget ent))))
(setq ten (cdr (assoc 2 (entget ent))))
(setq dis (distance pc pg))
(setq goc (angle pc pg))
(setq hng
(cond
((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
(entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat hng "_" ten "_" (rtos dis 2 2)))))))
<<
|
Tác giả: Doan Van Ha
Bài viết gốc: 309808
Tên lệnh: ha |
Đếm, sắp xếp, ghi thông tin Block
Đây. Nhưng hết chữ cái thì ráng chịu nghe!
; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
(setq pc (getpoint "\nChon diem chuan: "))
(setq cr (getreal "\nNhap chieu rong khung Window: "))
(setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ss (ssget "c" ptd ppt '((0 .... >> Đây. Nhưng hết chữ cái thì ráng chịu nghe!
; Font va Height cua Text theo Current Text.
(defun C:HA(/ pc cr ptd ppt ss lst pg ten dis goc hng x)
(setq pc (getpoint "\nChon diem chuan: "))
(setq cr (getreal "\nNhap chieu rong khung Window: "))
(setq ptd (polar pc (* 1.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ppt (polar pc (* 0.25 pi) (* (/ cr 2) (sqrt 2))))
(setq ss (ssget "c" ptd ppt '((0 . "Insert"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (vl-sort lst '(lambda(e1 e2) (< (distance pc (cdr (assoc 10 (entget e1)))) (distance pc (cdr (assoc 10 (entget e2))))))))
(setq x 65)
(repeat (length lst)
(setq ent (nth (- x 65) lst))
(setq pg (cdr (assoc 10 (entget ent))))
(setq ten (cdr (assoc 2 (entget ent))))
(setq dis (distance pc pg))
(setq goc (angle pc pg))
(setq hng
(cond
((equal goc 0 1E-3) "D")
((equal goc (/ pi 2) 1E-3) "B")
((equal goc pi 1E-3) "T")
((equal goc (* 1.5 pi) 1E-3) "N")
((< 0 goc (/ pi 2)) "DB")
((< (/ pi 2) goc pi) "TB")
((< pi goc (* 1.5 pi)) "TN")
((< (* 1.5 pi) goc (* 2 pi)) "DN")))
(entmakex (list (cons 0 "TEXT") (cons 10 pg) (cons 40 (getvar 'textsize)) (cons 1 (strcat (chr x) "_" hng "_" ten "_" (rtos dis 2 2)))))
(setq x (1+ x))))
<<
|
Tác giả: nhoclangbat
Bài viết gốc: 309892
Tên lệnh: s2 |
-Mong các Bro giúp đỡ
cũng tò mò, đúng là lỗi, chỗ lệnh pseclect ^^, bạn thử dùng lisp có lệnh s2 trong topic đó xem
;; free lisp from cadviet.com
(defun c:s2() (SelRange <=))
(defun SelRange(f / ss a b)
(setq ss (acet-ss-to-list (ssget '((0 . "TEXT")))))
(setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
(command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a (distof (cdr (assoc 1...
>> cũng tò mò, đúng là lỗi, chỗ lệnh pseclect ^^, bạn thử dùng lisp có lệnh s2 trong topic đó xem
;; free lisp from cadviet.com
(defun c:s2() (SelRange <=))
(defun SelRange(f / ss a b)
(setq ss (acet-ss-to-list (ssget '((0 . "TEXT")))))
(setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
(command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a (distof (cdr (assoc 1 (entget x)))) b) x nil)) ss))) "")
(princ)
)
<<
|
Tác giả: Tot77
Bài viết gốc: 309922
Tên lệnh: tim |
-Mong các Bro giúp đỡ
Bạn dùng thử cái này, cách dùng :
1. Nhập biểu thức, thí dụ :
>=3
<6
2.3<=5.0
(2 cái trên thì dễ hiểu rồi, cái thứ 3 nghĩa là trong khoảng từ 2.3 đến 5.0 có lấy cả 2 số đó)
2. Quét chọn text.
3. Cái text nào thoả thì bị bắt, khi đó bạn muốn đổi layer như thế nào cũng được.
(defun c:tim()
...
>> Bạn dùng thử cái này, cách dùng :
1. Nhập biểu thức, thí dụ :
>=3
<6
2.3<=5.0
(2 cái trên thì dễ hiểu rồi, cái thứ 3 nghĩa là trong khoảng từ 2.3 đến 5.0 có lấy cả 2 số đó)
2. Quét chọn text.
3. Cái text nào thoả thì bị bắt, khi đó bạn muốn đổi layer như thế nào cũng được.
(defun c:tim()
(defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
(setq gtt (getstring t "\nNhap bieu thuc :")
lso ".1234567890"
so (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) 32 x)) (vl-string->list gtt))) ")")))
)
(sssetfirst nil (ssfrom (vl-remove-if-not '(lambda(x)
(if (= 1 (length so))
((eval chu) (atof (cdr (assoc 1 (entget x)))) (car so))
(and ((eval chu) (car so) (atof (cdr (assoc 1 (entget x)))) (last so)))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT") (1 . "~**")))))))))
)
<<
|
Tác giả: Tot77
Bài viết gốc: 309955
Tên lệnh: tim |
-Mong các Bro giúp đỡ
Thể theo yêu cầu của bác Ha, tôi viết lại như sau:
(defun c:tim()
(defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
(setq gtt (getstring t "\nNhap bieu thuc :")
lso "-.1234567890"
so (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar...
>> Thể theo yêu cầu của bác Ha, tôi viết lại như sau:
(defun c:tim()
(defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (mapcar '(lambda(x) (ssadd x ss0)) sl) ss0)
(setq gtt (getstring t "\nNhap bieu thuc :")
lso "-.1234567890"
so (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) x 32)) (vl-string->list gtt))) ")"))
chu (car (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (vl-string-search (chr x) lso) 32 x)) (vl-string->list gtt))) ")")))
)
(sssetfirst nil (ssfrom (vl-remove-if-not '(lambda(x)
(if (= 1 (length so))
((eval chu) (atof (cdr (assoc 1 (entget x)))) (car so))
(and ((eval chu) (car so) (atof (cdr (assoc 1 (entget x)))) (last so)))))
(vl-remove-if-not '(lambda(x) (distof (cdr (assoc 1 (entget x)))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list '(0 . "*TEXT") )))))))))
)
Các biểu thức so sánh hợp lệ là <, <=, >, >=, =, /= (khác),
<<
|
Tác giả: Tue_NV
Bài viết gốc: 55897
Tên lệnh: jj | |
Tác giả: nhoclangbat
Bài viết gốc: 308777
Tên lệnh: expp nhatt |
BT chương 4.3 - Xử lý list
anh Ket nhoc nộp trước 3 bài đầu hen ^^
; 4-3-1 xuat toa do 1 diem
(defun c:expp (/ old pt1)
(setq old (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq pt1 (getpoint "\n cho diem mun lay toa do:"))
(princ "\n")
(princ (strcat "X= " (rtos (car pt) 2 3) "; Y= " (rtos (cadr pt) 2 3) "; Z= " (rtos (last pt) 2 3)))
(mapcar 'setvar '("cmdecho" "osmode") old)
(princ)
)
;ve hinh chu nhat doi
(defun C:nhatt (/ pt1...
>> anh Ket nhoc nộp trước 3 bài đầu hen ^^
; 4-3-1 xuat toa do 1 diem
(defun c:expp (/ old pt1)
(setq old (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq pt1 (getpoint "\n cho diem mun lay toa do:"))
(princ "\n")
(princ (strcat "X= " (rtos (car pt) 2 3) "; Y= " (rtos (cadr pt) 2 3) "; Z= " (rtos (last pt) 2 3)))
(mapcar 'setvar '("cmdecho" "osmode") old)
(princ)
)
;ve hinh chu nhat doi
(defun C:nhatt (/ pt1 pt2 pt3 pt4 d)
(setq d (getreal "\n nhap khoang cach offset:"))
(setq pt1 (getpoint "\n chon diem 1:"))
(setq pt2 (getpoint pt1 "\n chon diem 2:"))
(setq pt3 (list (+ (car pt1) d) (- (cadr pt1) d) 0))
(setq pt4 (list (- (car pt2) d) (+ (cadr pt2) d) 0))
(command "rectang" pt1 pt2)
(command "rectang" pt3 pt4)
)
;;loai bo 1 phan tu trong list
(defun remove ( tenphanturemove lst)
(append '(reverse (cdr (member tenphanturemove (reverse lst)))) '(cdr (member tenphanturemove lst)))
)
- có chỗ nhoc chưa rõ lắm, vậy 1 điểm mình pick thì thông số của nó mặc định có sẵn là 1 list gồm tọa độ x y z rùi hả a, mình chỉ dùng hàm để lôi nó ra ah ^^
<<
|
Filename: 308777_expp_nhatt.lsp
|
|
Tác giả: luhaivinh
Bài viết gốc: 310127
Tên lệnh: bt2-1 bt2-2 |
Chữa bài tập chương 2
;Chuong 2
(defun c:bt2-1(\ x y z e);cau 1
(setq x (+ 2 7) y (- 3 1.25) z 5.0)
(setq e (+ z (* 0.4 (- x y))))
(setq ketqua (+ x y z e))
)
(defun c: bt2-2(\ ketqua);cau 2
(setq a 2000)
(setq b 1000)
(setq c (/ (* a b) 2))
)
;cau 3
;o vi du nay ta co the nhan voi 0.5 hoac chia 2 dieu duoc.
(defun trungbinhcong(a b c);cau 4
(/ (+ a b c) 3)
)
(defun tinhdientich(a b);cau 5
(* a b 0.5)
)
(defun gangiatri(d) ;cau 6
(setq d 5)
)
...
>>
;Chuong 2
(defun c:bt2-1(\ x y z e);cau 1
(setq x (+ 2 7) y (- 3 1.25) z 5.0)
(setq e (+ z (* 0.4 (- x y))))
(setq ketqua (+ x y z e))
)
(defun c: bt2-2(\ ketqua);cau 2
(setq a 2000)
(setq b 1000)
(setq c (/ (* a b) 2))
)
;cau 3
;o vi du nay ta co the nhan voi 0.5 hoac chia 2 dieu duoc.
(defun trungbinhcong(a b c);cau 4
(/ (+ a b c) 3)
)
(defun tinhdientich(a b);cau 5
(* a b 0.5)
)
(defun gangiatri(d) ;cau 6
(setq d 5)
)
(defun tichbonso(a b c d)
(* (a b c d))
)
(defun lapphuongmotso(a);cau 7
(* a a a)
khi load file và gọi hàm thì nhận thông báo lỗi.nhờ thầy xêm em có sai chổ nào không.
<<
|
Filename: 310127_bt2-1_bt2-2.lsp
|
|
Tác giả: hochoaivandot
Bài viết gốc: 310242
Tên lệnh: ttt |
Lisp xác định tỷ lệ khung Mview
Phải ri không bạn?
(defun C:ttt()
(if (setq e (car (entsel "Chon mview")))
(setq sc (vla-get-CustomScale (vlax-ename->vla-object e)))
)
(setvar "dimscale" sc)
)
|
Tác giả: thanhduan2407
Bài viết gốc: 310274
Tên lệnh: gcd |
hỏi vấn đề tạo liên kết LSP và dialog DCL
Chào các bác! Cho em hỏi ké một chút về liênkeersst DCL
Em đang làm 1 lisp để ghi chú Text lên màn hình với lựa chọn nhập nội dung, cao chữ, Layer, TextStyle, Color
Có một điều sau đây em chưa biết cách làm:
1. Sau mỗi lần chạy thì start_list của em lại nhân đôi lên (em biết nguyên nhân do (mapcar 'add_list khi chưa kiểm duyệt) )
2. Hộp thoại màu sắc em vẫn chưa biết cách...
>> Chào các bác! Cho em hỏi ké một chút về liênkeersst DCL
Em đang làm 1 lisp để ghi chú Text lên màn hình với lựa chọn nhập nội dung, cao chữ, Layer, TextStyle, Color
Có một điều sau đây em chưa biết cách làm:
1. Sau mỗi lần chạy thì start_list của em lại nhân đôi lên (em biết nguyên nhân do (mapcar 'add_list khi chưa kiểm duyệt) )
2. Hộp thoại màu sắc em vẫn chưa biết cách tạo
3. Nếu bỏ kiểu Layer, TextStyle thì chạy ngon ạ.
Đây là Mã Code của em
GHICHU
: dialog
{
label = "Ch\U+01B0\U+01A1ng tr\U+00ECnh ghi ch\U+00FA";
: boxed_column
{
: edit_box
{
label = "Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA";
key = "Text_ghichu";
edit_width = 30;
alignment = left;
edit_limit = 50;
value = "Vi\U+1EBFt ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y";
}
: edit_box
{
label = "Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:";
key = "Height_Text";
edit_width = 3.0;
alignment = left;
edit_limit = 5;
value = 1;
}
}
: boxed_column
{
: row
{
: column
{
: popup_list
{
label = "L\U+1EF1a ch\U+1ECDn Layer" ;
key = "LTSLAY" ;
edit_width = 50 ;
list = "" ;
alignment = left;
}
: popup_list
{
label = "L\U+1EF1a ch\U+1ECDn TextStyle" ;
key = "LTSTEXTSTYLE" ;
edit_width = 50 ;
list = "" ;
alignment = left;
}
}
}
}
: boxed_column
{
: button
{
label = "Pick >>>";
key = "Accept";
is_default = true;
fixed_width = centered;
}
: button
{
label = "H\U+1EE7y";
key = "Cancel";
is_default = false;
fixed_width = centered;
}
}
}
(defun C:GCD ( / dcl_id LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
(exit)
)
(action_tile "Text_ghichu" "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text" "(setq h $value)")
(mode_tile "Height_Text" 2)
(action_tile "Text_ghichu" "(setq TextGhiChu $value)")
(setq LtsLayer (Getlayer))
(start_list "LTSLAY")
(mapcar 'add_list LtsLayer)
(end_list)
(if #CurLay
(set_tile "LTSLAY" (setq CurLay #CurLay))
(set_tile "LTSLAY" (setq CurLay "0"))
)
(action_tile "LTSLAY" "(setq LayerText $value)")
(setq LtsStyle (GetTextStyle))
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list LtsStyle)
(end_list)
(if #CurStyle
(set_tile "LTSTEXTSTYLE" (setq CurStyle #CurStyle))
(set_tile "LTSTEXTSTYLE" (setq CurStyle "Standard"))
)
(action_tile "LTSTEXTSTYLE" "(setq TextStyle $value)")
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn
(GCT TextGhiChu h LayerText TextStyle)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
(defun Getlayer ( / lyr)
(vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq LstLayer (cons (vla-get-name lyr) LstLayer))
)
LstLayer
)
(defun GetTextStyle ( / styl_)
(vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq LstTextStyle (cons (vla-get-name styl_) LstTextStyle))
)
LstTextStyle
)
(defun GCT(TextGhiChu h LayerText TextStyle / i Olmode Gocxoay);;;;GHI CHU TEXT
(setq i 0)
(while
(setvar "OSMODE" 0)
(setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: : "))
(setq P2 (Getpoint P1 "\nChon huong ghi chu TEXT: "))
(setq Gocxoay (Angle (trans P1 1 0)
(trans P2 1 0)
)
)
(command "Style" "Times New Roman" "Times New Roman" 0 1 0 "" "" "" )
(entmake (list (cons 0 "TEXT") (cons 10 P1) (cons 8 LayerText) (cons 40 (atof h)) (cons 50 Gocxoay) (cons 7 TextStyle) (cons 1 TextGhiChu)))
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------
Nhờ các bác chỉnh sửa giúp
Em cảm ơn nhiều
<<
|
Tác giả: Tot77
Bài viết gốc: 310286
Tên lệnh: gcd |
hỏi vấn đề tạo liên kết LSP và dialog DCL
Sửa lại cho bạn.
(defun C:GCD ( / dcl_id LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
(exit)
)
(action_tile "Text_ghichu" "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text" "(setq h $value)")
(mode_tile "Height_Text" 2)
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
(if...
>> Sửa lại cho bạn.
(defun C:GCD ( / dcl_id LtsLayer LtsStyle h Text_ghichu )
(setq dcl_id (load_dialog "GHICHU.DCL"))
(if (not (new_dialog "GHICHU" dcl_id))
(exit)
)
(action_tile "Text_ghichu" "(setq TextGhiChu $value)")
(mode_tile "Text_ghichu" 2)
(action_tile "Height_Text" "(setq h $value)")
(mode_tile "Height_Text" 2)
(start_list "LTSLAY")
(mapcar 'add_list (setq LstLayer (Getlayer)))
(end_list)
(if #CurLay
(set_tile "LTSLAY" #CurLay)
(set_tile "LTSLAY" "0")
)
(action_tile "LTSLAY" "(setq #CurLay $value)")
(start_list "LTSTEXTSTYLE")
(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
(end_list)
(if #CurStyle
(set_tile "LTSTEXTSTYLE" #CurStyle)
(set_tile "LTSTEXTSTYLE" "Standard")
)
(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
(action_tile "Accept" "(setq UseButton 1)(done_dialog)")
(action_tile "Cancel" "(setq UseButton 2)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(if (= UseButton 1)
(progn
(GCT TextGhiChu h #CurLay #CurStyle)
)
)
(if (= UseButton 2)
(alert (strcat "\nTho\U+00E1t"))
)
(Princ)
)
(defun Getlayer ( / lyr l)
(setq l nil)
(vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq l (cons (vla-get-name lyr) l))
)
l
)
(defun GetTextStyle ( / styl_ l)
(setq l nil)
(vlax-for styl_
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq l (cons (vla-get-name styl_) l))
)
l
)
(defun GCT(TextGhiChu h LayerText TextStyle / i Olmode Gocxoay);;;;GHI CHU TEXT
(command "Style" "Times New Roman" "Times New Roman" 0 1 0 "" "" "" )
(while (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
(setq P2 (Getpoint P1 "\nChon huong ghi chu TEXT: "))
(setq Gocxoay (Angle (trans P1 1 0)
(trans P2 1 0)
)
)
(entmake (list (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
(cons 40 (atof h)) (cons 50 Gocxoay)
(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu)))
)
)
;;;-------------------------------------------------------------
<<
|