Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2221 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 25 June 2009 - 10:33 AM

Sorry q288
Xin giới thiệu cách tiếp cận khác, LISP gán (thay đổi) diện tích cho các đối tuợng có diện tích : CIRCLE, ELLIPSE, PLINE, HATCH, ...

(defun c:GDT (/ ent e newVal)
(vl-load-com)
(command "UNDO" "begin")
(or *dt* (setq *dt* 12934e6))
(while
(and
(setq ent (entsel "\nChon doi tuong can thay doi Dien tich :") )
(setq e (vlax-Ename->Vla-Object (car ent)) )
)
(if (vlax-property-available-p e 'Area)
(progn
(setq newVal (getreal (strcat "\nNhap dien tich mong muon <" (rtos *dt*) "> :")) )
(if newVal (setq *dt* newVal) (setq newVal *dt*))
(vlax-invoke e 'ScaleEntity (vlax-curve-getStartPoint e) (sqrt(/ newVal (vla-get-Area e ))))
)
(princ "\n Doi tuong vua chon khong co dien tich. Chon lai ....")
)
)
(command "UNDO" "end")
)


Thật ra scale theo diện tích ko cần viết lisp cũng có thể làm đc, chỉ cần tính ra tỷ lệ scale là có thể scale thủ công là xong.
Vấn đề là tìm công thức tính tỷ lệ.
Thuật toán của mình là qui đổi diện tích hình bất kỳ thành diện tích tương ứng của 1 hình vuông -> cạnh (lấy căn bậc 2)
tỷ lệ diện tích khi đó là tỷ lệ 2 cạnh của 2 hình vuông.
  • 0

#2222 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 25 June 2009 - 11:07 AM

Trước tiên xin cá mon Bác q228 đã chỉnh sữa đoạn lisp vc dùm em, sau khi chạy thử thì em thấy chạy rất tốt, như bên cạnh đó còn một số thắc mắc sau nhờ Bác chỉnh thêm dùm em 1 chút.
- Những thửa nhỏ thì chạy rất tốt, còn thửa lớn như trong file mẫu thì chạy xong rồi mất ranh luôn Bác oi.
- Trước khi chạy thì nó kiểm tra xem có layer kichthuoc, stt, bangtd, nếu có rồi thì thôi, nếu chư có thì tạo. Kích thước thửa đất thì gán cho layer: kichthuoc, số TT và vòng tròn thì gán cho layer: stt và bảng TĐGR thì gán cho layer: bangtd
- Vị trí điểm thứ tự đầu tiên thì cho người sử dụng được chọn. ( do đôi lúc có những thửa đất nằm ngay mặt tiền đường thỉ phải chạy từ hướng mặt tiền rồi mới đến các vị trí khác trên thửa đất )
- Thêm chử : < BẢNG LIỆT KÊ TỌA ĐỘ GÓC RANH> phía trên bảng tọa độ
- Khung text STT thì để nguyên, khung tọa độ x-y thì cho khoảng cách 10, còn khung khoảng cách thì cho 8 ( để bảng TĐGr được đẹp hơn )

File dwg mẫu:
http://www.cadviet.c...files/mau_2.dwg


Cái hình trong file mau_2.dwg là hình 3d và có elevation khác 0, hình đó khi lấy boundary sẽ báo lỗi nên ct chạy ko đc.
Còn hình trong file mẫu trước các đg ranh là line thì chạy ok.
Vậy trong thực tế thì bạn dùng line hay pline2d hay pline3d?
  • 1

#2223 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 25 June 2009 - 11:16 AM

Tue_NV viết trong trường hợp tổng quát :
Khi chạy Lisp hỏi :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)
So ki tu can bo bot : (2)

trong trường hợp của HoangSon thì :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3
So ki tu can bo bot : 1

(defun c:bgtext()
(setq vitri (getint "\n Ban muon bot chuoi cach vi tri dau bao nhieu ki tu :"))
(setq skt (getint "\n So ki tu can bo bot :"))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget '((0 . "TEXT,MTEXT"))) n (sslength ss) i 0)

(while (< i n)
(setq e (entget(ssname ss i)))
(setq chuoicu (cdr(assoc 1 e)))

(setq tachdau (substr chuoicu 1 (- vitri 1)))
(setq tachcuoi (substr chuoicu (+ vitri skt) (+ (- (strlen chuoicu) vitri skt) 1)))
(setq chunoi (strcat tachdau tachcuoi))
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(setq i (1+ i))
)
(princ)
)

Cảm ơn Tue_NV nhiều lắm, thật là tuyệt vời.
  • 0

#2224 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 25 June 2009 - 12:48 PM

Tue_NV viết trong trường hợp tổng quát :
Khi chạy Lisp hỏi :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)
So ki tu can bo bot : (2)

trong trường hợp của HoangSon thì :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3
So ki tu can bo bot : 1



Tue có thể bổ xung them tính năng thêm kí tự và thai đổi kí tự dưạ trên lisp bạn mới tạo không đôi lúc cũng rất cần thiết đó. :s_big:
  • 0

#2225 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 25 June 2009 - 01:10 PM

..........................
Mình đang cần lish
đưa các pline thẳng hàng nhau thành 1 pline
và lish Nhập tỷ lệ Standard Scale của khung viewport bên layout bằng bàn phím
...................

Chào ph168xd
Bạn có thể dùng lệnh Overkill của Express Tools để đưa các pline thẳng hàng nhau thành 1 pline .
Nhớ chọn Option : PLINEs, OVERLAP, END to END

đây là LISP Nhập tỷ lệ Standard Scale của khung viewport bên layout, do không có thời gian nhờ bạn chạy và kiểm tra dùm.
;SVP : Scale ViewPort
(defun c:svp(/ ent dz Viewport newVal)
(if (/= (getvar "cvport") 1)
(alert "\nChi co the chay tren khong gian giay (Layout).")
(progn
(while
(not (and
(setq ent (car (entsel "\nChon Viewport : ")))
(if ent (= (cdr (assoc 0 (entget ent))) "VIEWPORT") )
)
)
(princ "\nkhong phai Viewport. Chon lai : ")
)
(setq dz (getvar "dimzin"))
(setvar "dimzin" 8 )
(setq Viewport (vlax-Ename->Vla-Object ent)
newVal (GetScale (getstring(strcat "\nNhap Scale Standard (vd. 1/50, 1:50, 50 ) <" ( getvport_scale Viewport)"> :")) ))
(if newVal (vla-put-CustomScale Viewport newVal))
(setvar "dimzin" dz )
)
)
(princ)
)

(defun GetScale (Str / Sc)
(cond
((/= (type Str) 'STR) nil)
((or (setq Pos (vl-string-search ":" Str))(setq Pos (vl-string-search "/" Str)))
(setq Sc (vl-catch-all-apply
'(lambda () (/ (distof (substr Str 1 Pos)) (distof (substr Str (+ 2 Pos)))) ) ) ) )
((setq Sc (vl-catch-all-apply '(lambda () (/ 1 (distof Str))))))
)
(if (vl-catch-all-error-p Sc)
(setq Sc nil)
)
Sc
)

(defun getvport_scale (viewport / sc csc)
(setq sc (vla-get-StandardScale viewport))
(cond
((= sc acVpScaleToFit)
(setq csc 1.0)
)
((= sc acVpCustomScale)
(setq csc (/ 1 (vla-get-CustomScale viewport)))
(if (= csc 0.0) (setq csc 1.0))
)
((= sc acVp1_128in_1ft) (setq csc 1536.0))
((= sc acVp1_64in_1ft) (setq csc 768.0))
((= sc acVp1_32in_1ft) (setq csc 384.0))
((= sc acVp1_16in_1ft) (setq csc 192.0))
((= sc acVp3_32in_1ft) (setq csc 128.0))
((= sc acVp1_8in_1ft) (setq csc 96.0))
((= sc acVp3_16in_1ft)(setq csc 64.0))
((= sc acVp1_4in_1ft) (setq csc 48.0))
((= sc acVp3_8in_1ft) (setq csc 32.0))
((= sc acVp1_2in_1ft) (setq csc 24.0))
((= sc acVp3_4in_1ft) (setq csc 16.0))
((= sc acVp1in_1ft) (setq csc 12.0))
((= sc acVp3in_1ft)(setq csc 4.0))
((= sc acVp6in_1ft)(setq csc 2.0))
((= sc acVp1ft_1ft)(setq csc 1.0))
((= sc acVp1_1) (setq csc 1.0))
((= sc acVp1_2) (setq csc 2.0))
((= sc acVp1_4) (setq csc 4.0))
((= sc acVp1_8) (setq csc 8.0))
((= sc acVp1_10) (setq csc 10.0))
((= sc acVp1_16) (setq csc 16.0))
((= sc acVp1_20) (setq csc 20.0))
((= sc acVp1_30) (setq csc 30.0))
((= sc acVp1_40) (setq csc 40.0))
((= sc acVp1_50) (setq csc 50.0))
((= sc acVp1_100)(setq csc 100.0))
((= sc acVp2_1) (setq csc 0.5))
((= sc acVp4_1) (setq csc 0.25))
((= sc acVp8_1) (setq csc 0.125))
((= sc acVp10_1) (setq csc 0.1))
((= sc acVp100_1) (setq csc 0.01))
)
(if (member (getvar "lunits") '(1 2 3 5))
(strcat "1:" (rtos csc ))
(strcat (rtos (/ 12 csc) 4 5) "=" (rtos 12 4))
)
)

  • 0

#2226 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 25 June 2009 - 01:13 PM

Tue_NV viết trong trường hợp tổng quát :
Khi chạy Lisp hỏi :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)
So ki tu can bo bot : (2)

trong trường hợp của HoangSon thì :
Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3
So ki tu can bo bot : 1

Tue có thể bổ xung them tính năng thêm kí tự và thai đổi kí tự dưạ trên lisp bạn mới tạo không đôi lúc cũng rất cần thiết đó. :s_big:

Đã có viết Lisp này rồi. Nó ở đây :
Bài viết số 39
  • 1

#2227 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 25 June 2009 - 02:04 PM

Cái hình trong file mau_2.dwg là hình 3d và có elevation khác 0, hình đó khi lấy boundary sẽ báo lỗi nên ct chạy ko đc.
Còn hình trong file mẫu trước các đg ranh là line thì chạy ok.
Vậy trong thực tế thì bạn dùng line hay pline2d hay pline3d?


Xin lỗi Bác q288 tại file em đưa lên làm mẫu là file bên chủ đầu tư đưa cho em, em chưa đưa Z về 0. Em làm bên trắc địa thì ranh thửa đất thường là đường line hay cùng lắm là pline thôi. Thank Bác q228 nhiều, hi vọng lần sau nhận được lời nhắn của Bác là chạy lisp thửa đi bạn ơi. :s_big:
  • 0

#2228 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 25 June 2009 - 03:12 PM

Xin lỗi Bác q288 tại file em đưa lên làm mẫu là file bên chủ đầu tư đưa cho em, em chưa đưa Z về 0. Em làm bên trắc địa thì ranh thửa đất thường là đường line hay cùng lắm là pline thôi. Thank Bác q228 nhiều, hi vọng lần sau nhận được lời nhắn của Bác là chạy lisp thửa đi bạn ơi. :s_big:


Nếu vậy bạn dùng cái này. Cái này dùng cho line và pline 2d kín.
Sau khi lập bảng xong, CT hỏi có save ko? nếu ko save thì enter, save thì nhấn Y.


;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC ();/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
(setvar "cmdecho" 0)

;;;Vertex Co-ordinate
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 7 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")
;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nBan kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))

;;;PICK & BASE POINT
(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :")
p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq
p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvl (relist pdau pvl1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (- (distance p0 p02)))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
(setq Lkqua nil)
(wtxtMC "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(setq bn "1")
(while (tblsearch "block" bn)
(setq bn (itoa (1+ (atoi bn))))
)
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "hatch" "S" (entlast) "")
(setq j (1+ j))
)

;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh et)
(command "erase" et "")

;;;FINISH
(initget "Y")
(setq save (getkword "\nLuu file? :"))
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "w"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
(setvar "osmode" oldos)
(setvar "cmdecho" 1)
(princ)
)
;;;-------------------------------------------------------------------------------



;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (e / i pvL k p1 p2 dist rad x_mp y_mp mp)
(setq
i 0
pvL (reverse (getvert e))
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
)
(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------

  • 1

#2229 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 25 June 2009 - 03:40 PM

Thank Bác q288 nhiều, em text liền. Thank lần nữa.
  • 0

#2230 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 26 June 2009 - 09:14 AM

Bác q288 ơi, mấy phần khác thì quá tuyệt rồi, nhưng phần save thì em chưa thấy nó cho thồng báo save lại, nhờ Bác coi lại dùm em 1 ít. Thank Bác nhiều.
  • 0

#2231 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 26 June 2009 - 09:23 AM

Bác q288 ơi, mấy phần khác thì quá tuyệt rồi, nhưng phần save thì em chưa thấy nó cho thồng báo save lại, nhờ Bác coi lại dùm em 1 ít. Thank Bác nhiều.


Chắc tại mình để ở cuối ct nên bạn không để ý.
Sau khi nhấp chọn điểm theo câu "Diem chuan bang toa do (phia tren ben trai):"
Bạn sẽ thấy thêm câu "Luu file? :"
nếu muốn lưu thì Y, ko thì enter.
  • 1

#2232 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 10:47 AM

Có bạn nào có lisp đo đường gấp khúc bằng đường thẳng không gởi lên giúp mình đi, mình tìm mà không thấy.
Mình muốn dùng lệnh DIST nhưng không phải đo khoảng cách theo 2 điểm đó mà mình muốn nó tính theo tổng khoảng cách theo trục x và y, giống như đo tổng chiều dài 2 cạnh của tam giác vuông, chỉ cần chọn 2 điểm đầu và cuối của cạnh huyền thôi.
Ai có hay viết được giúp mình đi. Thanks.
  • 0

#2233 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 26 June 2009 - 11:30 AM

Có bạn nào có lisp đo đường gấp khúc bằng đường thẳng không gởi lên giúp mình đi, mình tìm mà không thấy.
Mình muốn dùng lệnh DIST nhưng không phải đo khoảng cách theo 2 điểm đó mà mình muốn nó tính theo tổng khoảng cách theo trục x và y, giống như đo tổng chiều dài 2 cạnh của tam giác vuông, chỉ cần chọn 2 điểm đầu và cuối của cạnh huyền thôi.
Ai có hay viết được giúp mình đi. Thanks.

Lisp này Tue_NV đã viết rồi
Đường gấp khúc đó vẽ bằng lệnh Pline phải không bạn?
Nếu đường gấp khúc vẽ bằng Line thì bạn dùng lệnh PE để chuyển nó về Polyline
và sử dụng Code sau sẽ tính được chiều dài của nó theo ý của bạn
Bạn đọc bài viết này :
Bai viet so 2
Khi chay Lisp yêu cầu chon Pline
- Chon diem dau của duong pline
- Chon diem cuoi của duong pline
-> Lisp sẽ tính chiều dài đoạn gấp khúc từ điểm đầu đến điểm cuối cho bạn
Sử dụng Lisp này có thể đo một đoạn của Line, Pline, Arc, Circle, Spline, elipse
Chúc vui :s_big:
  • 0

#2234 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 12:00 PM

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.
  • 0

#2235 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 26 June 2009 - 12:05 PM

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.

Bạn hãy upload file lên đây và nói rõ ràng nhé.
Chưa hiểu ý bạn lắm
Đường gấp khúc bạn vẽ bằng dối tượng nào?
Dữ liệu đầu vào -> Xử lý -> Dữ liệu đầu ra
Kích thước đi như thế nào? Kiểu kích thước......
Bạn trình bày rõ ràng nhé.
  • 0

#2236 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 26 June 2009 - 12:50 PM

Không phải, mình muốn sử dụng lệnh giống như lệnh DIST hay lisp MDI đó, nghĩa là đánh lệnh, chọn điểm điềm đầu, điểm cuối, enter nó sẽ hiện ra kích thước đoạn đó đi theo trục Ox, Oy.

Chào vnp84055
Thử LISP này xem có đúng ý bạn chưa?

(defun c:xy(/ pt1 pt2 deltaX deltaY)
(setq pt1 (getpoint "\nDiem dau:")
pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))
)
(princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
(princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
(princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
(princ)
)

  • 1

#2237 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 12:59 PM

Thật ra thì cũng không có gì cần phải upload file lên. Để mình nói cho dể hiểu:
Ví dụ cần đo khoảng cách giũa 2 điểm: từ (0;0) đến điểm (50;100), thay vào dùng lệnh DIST thì khoảng cách của nó là 111,8; nhưng ở đây mình muốn kết quả của lệnh này = chiều dài theo trục x + chiều dài theo trục y = 50 + 100 = 150, nghĩa là đo theo hai đoạn line đi vuông góc với nhau.

Với lại mình muốn theo 1 lisp nữa là mình vẽ 1 đường pline 3 điểm nhưng chỉ cần chọn 2 điểm đầu và cuối thôi.

Hình minh họa: gõ lệnh, chọn điểm 1, chọn điểm 3 >> kết quả được như hình. (lệnh đo như trên sẽ tính theo đoạn 1-2 cộng đoạn 2-3)

Hình đã gửi

Hình đã gửi
  • 0

#2238 vnp84055

vnp84055

    biết zoom

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

Đã gửi 26 June 2009 - 01:05 PM

Chào vnp84055
Thử LISP này xem có đúng ý bạn chưa?


(defun c:xy(/ pt1 pt2 deltaX deltaY)
(setq pt1 (getpoint "\nDiem dau:")
pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))
)
(princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
(princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
(princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
(princ)
)


@gia_bach: thanks. Đúng theo ý mình rùi.
Bạn giúp mình viết thêm lệnh là khi mình chọn điểm đầu, điểm cuối như vậy nó sẽ vẽ ra đường pline theo trục x và y + hiển thị kích thước đoạn pline đó luôn được không? (layer theo hiện hành). Giốnh như hình mình upload phía trên đó, chỉ cần chọn điểm 1 & 3, nó sẽ vẽ cho mình đoạn pline như hình.
Giúp mình đi.
  • 0

#2239 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 26 June 2009 - 01:13 PM

Chắc tại mình để ở cuối ct nên bạn không để ý.
Sau khi nhấp chọn điểm theo câu "Diem chuan bang toa do (phia tren ben trai):"
Bạn sẽ thấy thêm câu "Luu file? :"
nếu muốn lưu thì Y, ko thì enter.

Nhờ Bác coi lại dùm em chút, em đã chạy thử trên cad khi có những lisp của em chạy song song với lisp VC và khi cad chạy không có lisp của em mà chỉ có lisp CV thôi thì không thấy Báo phần < lưu file > như Bác đã nói, vô lisp thì em có thấy phần < lưu file >. Vậy nhờ Bác q288 coi lại dùm em 1 chút xíu nữa nha.
Câu lệnh cad khi chạy lệnh lisp VC 2 lần thì báo lội như sau:
----Command: vc
Chon chieu cao text <1.0000>:
So chu so thap phan <2>:
Ban kinh vong tron <0.3000>:
Pick diem dau tien (so thu tu = 1) :
Pick 1 diem giua mien kin:
Diem chuan bang toa do (phia tren ben trai):; error: too many arguments
------------------Thank Bác q288 nhiều, không biết Bác có ở TP.HCM ko, nếu có thì em xin mời Bác 1 chầu Cafe được ko? :s_big:
  • 0

#2240 gia_bach

gia_bach

    biết lệnh adcenter

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

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

@gia_bach: thanks. Đúng theo ý mình rùi.
Bạn giúp mình viết thêm lệnh là khi mình chọn điểm đầu, điểm cuối như vậy nó sẽ vẽ ra đường pline theo trục x và y + hiển thị kích thước đoạn pline đó luôn được không? (layer theo hiện hành). Giốnh như hình mình upload phía trên đó, chỉ cần chọn điểm 1 & 3, nó sẽ vẽ cho mình đoạn pline như hình.
Giúp mình đi.

Chào vnp84055
LISP XY không khác lệnh dist cua CAD ?
Gửi bạn LISP vẽ PLINE
(defun c:PLxy(/ pt1 pt2 deltaX deltaY lst-pt2d)
(defun makeLWPolyline(lst-pt)
(entmakex
(apply
(function append)
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(62 . 3) ; color
(cons 90 (length lst-pt))
'(70 . 0)
)
(mapcar
(function list)
(mapcar (function (lambda (a) (cons 10 a))) lst-pt)
) ;_ mapcar
) ;_ cons
) ;_ apply
)
)

(setq pt1 (getpoint "\nDiem dau:")
pt2 (getpoint pt1 "\nDiem cuoi:")
deltaX (- (car pt2)(car pt1))
deltaY (- (cadr pt2)(cadr pt1))
lst-pt2d (list pt1 (list (car pt2) (cadr pt1) '0) pt2)
)
(makeLWPolyline lst-pt2d)
(princ (strcat "\n Khoang cach theo truc X : " (rtos deltaX)) )
(princ (strcat "\n Khoang cach theo truc Y : " (rtos deltaY)) )
(princ (strcat "\n Tong khoang cach theo truc X,Y : " (rtos (+ (abs deltaX) (abs deltaY)))) )
(princ)
)

  • 2