Đế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

#2041 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 May 2009 - 10:18 PM

Bạn xem lại giúp mình nhé, khi bị lỗi thì nó vận bị mất hết tấc cả snap ban đầu.
Cảm ơn nhiều!


Mình thử thấy tốt mà. Bạn trước khi vào lệnh ar,ar2 thì đánh lệnh osmode và cho nó bằng 1 số nào đó(. Sau đó đánh lệnh ar,ar2 của bạn. Giả vờ cho bị lỗi rồi nhấn esc. Thử lại lệnh osmode xem có đúng là nó vẫn là số cũ không.
lệnh vd thì do bạn đặt tên osmode khác nên mình có đổi lại tên biến. Bạn chép lại và chạy lai thử xem.

(defun DXF (code elist)
(cdr (assoc code elist))
) ;dxf

(defun c:AR (/ dtl dtcon pt1 pt2 ss et oslast vsize)
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)

(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR
;------------------------------------------------------------------------
(defun c:AR2 (/ dtl dtcon pt1 pt2 ss et oslast vsize)
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)
(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR2
;-------------------------------------------------------------------------------
(defun C:vd ()
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)
(print)
(print)
(print)
(setq oslast (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0)

(if (= tl nil)
(setq tl (getreal "Ty le ban ve : "))
)

(setq PT1 (getpoint "Diem 1 : "))
; (setq PT2 (getpoint "Diem 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt
(strcat "\n Chieu dai doan vua do la " (rtos dist 2 4))
)
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
) ;while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Viet vao cho nao ? : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (/ sum 2))

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

(command "setvar" "OSMODE" oslast)
(princ)
)

(prompt
"\n Start with AR to calculate area by pick points method"
)
(prompt
"\n Start with AR2 to calculate haft area by pick points method"
)
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt
"\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007"
)
(princ)

  • 0

#2042 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 26 May 2009 - 09:02 AM

Mình thử thấy tốt mà. Bạn trước khi vào lệnh ar,ar2 thì đánh lệnh osmode và cho nó bằng 1 số nào đó(. Sau đó đánh lệnh ar,ar2 của bạn. Giả vờ cho bị lỗi rồi nhấn esc. Thử lại lệnh osmode xem có đúng là nó vẫn là số cũ không.
lệnh vd thì do bạn đặt tên osmode khác nên mình có đổi lại tên biến. Bạn chép lại và chạy lai thử xem.

Cảm ơn bạn đã nhiệt tình giúp đỡ nhưng sao mình vẫn không dùng được bạn ơi, sau khi bị lỗi nó vẫn tắc tấc cả snap ban đầu mình chọn, đánh lại osmode thì thấy giá trị là 0.
Bạn xem lại giúp mình nghe. Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2043 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 26 May 2009 - 09:22 AM

Lệnh là SD (sắp dim)

Chương trình sẽ yêu cầu người sử dụng chọn đường Dim chuẩn. Sau đó, yêu cầu người sử dụng chọn các đường Dim cần sắp xếp. Chương trình sẽ tự động dàn các Dim theo hàng đều.
Hình đã gửi


(defun c:sd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
)
(princ (strcat "\n" msg))
)
(done)
)
;;----------
(defun init ()
(setq
HOANH_CMD (getvar "CMDECHO")
HOANH_OLDERROR *error*
*error* hoanh_newerror

)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
)
;;----------
(defun done ()
(command ".redraw")
(command ".undo" "E")
(if HOANH_CMD
(setvar "CMDECHO" HOANH_CMD)
)
(if HOANH_OLDERROR
(setq *error* HOANH_OLDERROR)
)
(princ)
)
;;----------

(defun cdim (entdt pchan pduong / tt old10
old13 old14 new10 new13 new14 p10n
p13n p14n p10o p13o p14o gocduong
gocchan pchanb pduongb loaidim
)
(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)
(setq
goc (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq (inters ph ptemp p1 p2 nil)
)
pkq
)
(setq
tt (entget entdt)
old10 (assoc '10 tt)
old13 (assoc '13 tt)
old14 (assoc '14 tt)
p10o (cdr old10)
p13o (cdr old13)
p14o (cdr old14)
loaidim (logand (cdr (assoc '70 tt)) 7)
gocduong (cond
((= loaidim 1) (angle p13o p14o))
((= loaidim 0) (cdr (assoc '50 tt)))
(t nil)
)
pchan (cond
(pchan (list (car pchan) (cadr pchan) 0.0))
(t pchan)
)
pduong (cond
(pduong (list (car pduong) (cadr pduong) 0.0))
(t pduong)
)

)
(if gocduong
(progn
(if pchan
(setq
pchanb (polar pchan gocduong 1000.0)
p13n (chanvuonggoc
(list (car p13o) (cadr p13o) 0.0)
pchan
pchanb
)
p14n (chanvuonggoc
(list (car p14o) (cadr p14o) 0.0)
pchan
pchanb
)
new13 (cons 13 p13n)
new14 (cons 14 p14n)
tt (subst new13 old13 tt)
tt (subst new14 old14 tt)
)
)
(if pduong
(setq
pduongb (polar pduong gocduong 1000.0)
p10n (chanvuonggoc
(list (car p10o) (cadr p10o) 0.0)
pduong
pduongb
)
new10 (cons 10 p10n)
tt (subst new10 old10 tt)
)
)
(entmod tt)
)
)
gocduong
)

(defun textdimheight (ent / tmp)
(command ".copy" ent "" (list 0.0 0.0 0.0) "@")
(command ".explode" (entlast) "")
(setq tmp (cdr (assoc 40 (entget (entlast)))))
(command ".erase" "p" "")
tmp
)
(defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
(setq
x1 (car p1)
y1 (cadr p1)
z1 (caddr p1)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
x3 (car p3)
y3 (cadr p3)
z3 (caddr p3)
tmp (+ (* (- x1 x2) x3)
(* (- y1 y2) y3)
(* (- z1 z2) z3)
)
)
(cond
((= tmp 0.0) 0.0)
(t (/ tmp (abs tmp)))
)
)
(defun khoangcachdim (p1 ent goc / tt p2 A B D)
(setq tt (entget ent)
p2 (cdr (assoc 10 tt))
B (cdr (assoc 50 tt))
A (angle p1 p2)
D (distance p1 p2)
)
(* (* D (sin (- A [b]B )[/b])) (phia p1 (polar p1 goc 1.0) p2))
)

(defun phanloai (ent)
(setq
kc (khoangcachdim pgoc ent goc)
loai (fix (/ kc heightdimgoc 0.93))
)
(cons loai ent)
)

(init)
(princ "\nSap xep dim © CADViet.com")
(while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
)
(setq
ttgoc (entget entgoc)
p13goc (cdr (assoc 13 ttgoc))
pgoc (cdr (assoc 10 ttgoc))
goc (cdr (assoc 50 ttgoc))
heightdimgoc (textdimheight entgoc)
ssd (ssget (list
(cons 0 "DIMENSION")
(cons -4 " (cons 70 32)
(cons 70 64)
(cons 70 96)
(cons 70 128)
(cons 70 160)
(cons 70 196)
(cons 70 224)
(cons -4 "OR>")
(cons -4 " (cons 50 goc)
(cons 50 (+ goc pi))
(cons 50 (- goc pi))
(cons -4 "OR>")
)
)
lstd (ss2ent ssd)
lstd (mapcar 'phanloai lstd)
lstlevel nil
)
(foreach pp lstd
(if (not (member (car pp) lstlevel))
(setq lstlevel (append lstlevel (list (car pp))))
)
)
(setq lstlevel (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam nil
lstduong nil
lstamtmp nil
lstduongtmp nil
)
(foreach pp lstlevel
(if (< pp 0.0)
(setq lstam (append lstam (list pp)))
)
(if (> pp 0.0)
(setq lstduong (append lstduong (list pp)))
)
)
(setq index 0)
(foreach pp (reverse lstam)
(setq
index (1+ index)
lstamtmp (append lstamtmp (list (cons pp index)))
)
)
(setq
lstam lstamtmp
index 0
)
(foreach pp lstduong
(setq
index (1+ index)
lstduongtmp (append lstduongtmp (list (cons pp index)))
)
)
(setq lstduong lstduongtmp)
(setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

(setq kcdimstandard (* 3.0 heightdimgoc))
(foreach pp lstd
(setq plht (car pp))
(progn
(setq
kcdimht (khoangcachdim pgoc (cdr pp) goc)
duongthu (cdr (assoc plht lstlevel))
heso (cond
((/= 0 kcdimht)
(abs (* (/ kcdimstandard kcdimht) duongthu))
)
(t 0.0)
)
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi (polar pgoc
(angle pgoc diemchenht)
(* heso (distance pgoc diemchenht))
)
)

(cdim (cdr pp) p13goc pmoi)
)
)
(done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)

Anh Hoành xem lại giúp cái lisp này với, sao mình load xong nhung đánh lệnh sd cad vẫn không hiểu.
Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2044 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 May 2009 - 09:39 AM

Anh Hoành xem lại giúp cái lisp này với, sao mình load xong nhung đánh lệnh sd cad vẫn không hiểu.
Thank!

Lỗi do bạn đọc bài viết chưa đến nơi đến chốn mà thôi.
Lisp của bác Hoành đây bạn : http://www.cadviet.c...sapxepdim_2.lsp
  • 0

#2045 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 26 May 2009 - 09:47 AM

Xin lisp có nội dung như sau:
- Công việc giống lệnh offset trong cad nhưng mình có thể chọn nhiều đối tượng cùng một lúc.
- Sau khi offset thanh công thì các đường mới vừa được offset cùng thuộc layer hiện hành (layer current)
Các bạn giúp mình nhé!
Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2046 oanhvang

oanhvang

    biết zoom

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

Đã gửi 26 May 2009 - 10:17 AM

Thật ra là cách nhau 1 đoạn <=10. Tuy nhiên nếu bạn muốn thêm option thì mình sửa lại như sau:
Chỉ cần nhập 1 lần kc khi vào lệnh, nếu k muôn đổi thì enter.

(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )
(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" kc "")))
(defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" kc ""))

(setq kc (getreal (strcat "Chon khoang cach toi da de noi <" (rtos (getvar "USERR1")) ">:" )))
(if (not kc) (setq kc (getvar "USERR1")) (setvar "USERR1" kc))

(setq tdt (ssget))
(while tdt
(setq ssdt (ssname tdt 0))

(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt))

(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt))
(setq tdt (ssget))
)
(princ)
)



thanks bạn q288 nhưng mà vẫn kô đc bạn ah, nó kô nối được những đoạn cách nhau và những đoạn chéo nhau như lisp trước bạn ạ, nó chỉ nối được những đoạn liền nhau thôi, mong bạn sửa lại dùm mình nhé, cảm ơn bạn lần nữa.
  • 0

#2047 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 May 2009 - 10:29 AM

thanks bạn q288 nhưng mà vẫn kô đc bạn ah, nó kô nối được những đoạn cách nhau và những đoạn chéo nhau như lisp trước bạn ạ, nó chỉ nối được những đoạn liền nhau thôi, mong bạn sửa lại dùm mình nhé, cảm ơn bạn lần nữa.


Bạn nhập kc tối đa là bao nhiêu mà k nối đc? nếu cho = 10 thì mấy cái pline của bạn nối đc hết mà
  • 0

#2048 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 May 2009 - 12:12 PM

Xin lisp có nội dung như sau:
- Công việc giống lệnh offset trong cad nhưng mình có thể chọn nhiều đối tượng cùng một lúc.
- Sau khi offset thanh công thì các đường mới vừa được offset cùng thuộc layer hiện hành (layer current)
Các bạn giúp mình nhé!
Thank!

Bạn sử dụng đoạn Code này xem :
(defun c:ofs()
(prompt "Ban chon doi tuong offset :")
(setq ss (ssget) n (sslength ss) i 0)
(setq po (getpoint "\n Pick diem phia offset :"))
(setq kc (getdist "\n Khoang cach offset :"))
(while (< i n)
(setq curve (ssname ss i))
(command "offset" kc curve po "")
(setq LA (entlast))
(Command "point" po)
(command "MATCHPROP" (entlast) LA "")
(entdel (entlast))
(setq i (1+ i))
)
(princ)
)

  • 1

#2049 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 May 2009 - 01:27 PM

Cảm ơn bạn đã nhiệt tình giúp đỡ nhưng sao mình vẫn không dùng được bạn ơi, sau khi bị lỗi nó vẫn tắc tấc cả snap ban đầu mình chọn, đánh lại osmode thì thấy giá trị là 0.
Bạn xem lại giúp mình nghe. Thank!


Lần này k xong thì mình cũng pótay.com luôn.


(defun DXF (code elist)
(cdr (assoc code elist))
) ;dxf

(defun trap(e) (setvar "OSMODE" oslast))

(defun c:AR (/ dtl dtcon pt1 pt2 ss et vsize)
(setq temperr *error*
*error* trap)

(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR
;------------------------------------------------------------------------
(defun c:AR2 (/ dtl dtcon pt1 pt2 ss et vsize)
(setq temperr *error*
*error* trap)
(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR2
;-------------------------------------------------------------------------------
(defun C:vd ()
(setq temperr *error*
*error* trap)
(print)
(print)
(print)
(setq oslast (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0)

(if (= tl nil)
(setq tl (getreal "Ty le ban ve : "))
)

(setq PT1 (getpoint "Diem 1 : "))
; (setq PT2 (getpoint "Diem 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt
(strcat "\n Chieu dai doan vua do la " (rtos dist 2 4))
)
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
) ;while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Viet vao cho nao ? : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (/ sum 2))

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

(command "setvar" "OSMODE" oslast)
(princ)
)

(prompt
"\n Start with AR to calculate area by pick points method"
)
(prompt
"\n Start with AR2 to calculate haft area by pick points method"
)
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt
"\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007"
)
(princ)

  • 0

#2050 oanhvang

oanhvang

    biết zoom

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

Đã gửi 26 May 2009 - 04:39 PM

Bạn nhập kc tối đa là bao nhiêu mà k nối đc? nếu cho = 10 thì mấy cái pline của bạn nối đc hết mà



mình thử nhập khoảng cách là 100 này, 1000 này nhưng vẫn kô được, mình chọn khoảng cách tối đa xong pick 2 đường PL xong rồi enter mà nó y chang như cũ, :s_big: liệu có phải do các đường của mình nó chéo nhau kô nhỉ
  • 0

#2051 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 May 2009 - 04:49 PM

mình thử nhập khoảng cách là 100 này, 1000 này nhưng vẫn kô được, mình chọn khoảng cách tối đa xong pick 2 đường PL xong rồi enter mà nó y chang như cũ, :s_big: liệu có phải do các đường của mình nó chéo nhau kô nhỉ

Bạn đã chạy thử Code của Tue_NV chưa?
Tue_NV đã sửa lại đọan Code của bạn ở bài viết số 2026, topic "Viết Lisp theo yêu cầu"
:s_big:
  • 0

#2052 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 May 2009 - 07:04 PM

mình thử nhập khoảng cách là 100 này, 1000 này nhưng vẫn kô được, mình chọn khoảng cách tối đa xong pick 2 đường PL xong rồi enter mà nó y chang như cũ, :s_big: liệu có phải do các đường của mình nó chéo nhau kô nhỉ


bạn test trên file bạn đưa hay file khác. Nếu file khác thì up file đó lên để mình xem lại. Còn nếu trên file cũ mà k đc thì thật là lạ vì mình test thấy ok hết mà. Nhờ các bạn khác test thử xem và cho ý kiến.
  • 0

#2053 ToTo08

ToTo08

    biết vẽ line

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

Đã gửi 26 May 2009 - 09:32 PM

Mình cần 1 lisp khi cóp pi 1 text ở dạng số thì tự động đối tượng sau cóp pi được cộng thêm n đơn vị, đối tượng sau nữa là cộng thêm (n+n) đơn vị, mong mọi người giúp đỡ, cám ơn.
  • 0

#2054 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 27 May 2009 - 09:17 AM

Lần này k xong thì mình cũng pótay.com luôn.

Mình cũng không rõ vì sao lại thế nữa nhưng nó cũng không được bạn à, Mình cảm ơn bạn nhiều nha. Mình dung mấy cái lisp tính diện tích trên diễn đàn nhưng thấy chưa đúng ý mình lắm, bạn có thể cho mĩnhin cái lisp tính diện tích với các công việc sau:
1. Chạy lisp xong hỏi tỷ lệ bản vẽ,
2. Sau đó pick vào những vùng cần tính diện tích.
3. Sau khi ấn enter thì pick điểm để ghi kết quả. Rồi tiếp tục pick các vùng khác để tính tiếp
Lưu ý nếu có lỗi cũng không mất các snap ban đầu mình chọn nha.
Cảmơn nhiều!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2055 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 27 May 2009 - 09:46 AM

Mình đang cần lisp thực hiện công việc gấp vải địa kỹ thuật (trong thiêt kế trắc ngang đường) nội dung như sau:
Mình đã có sẵn nhiều đường polyline, mình muốn sau khi chạy lisp tấc cả các đường polyline đó được vẽ thêm hai đầu (gấp vào trong) một đoạn thẳng mình chọn trước. Bác nào viết giúp mình nhé. Thanhk!
Mình up file lên các bạn xem cho dể hiểu nha:
http://www.cadviet.c...pfiles/load.dwg
  • 0
Học học nữa học mãi.
Đúp học lại!

#2056 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 27 May 2009 - 10:23 AM

thanks bạn q288 nhưng mà vẫn kô đc bạn ah, nó kô nối được những đoạn cách nhau và những đoạn chéo nhau như lisp trước bạn ạ, nó chỉ nối được những đoạn liền nhau thôi, mong bạn sửa lại dùm mình nhé, cảm ơn bạn lần nữa.

Bạn kiểm tra lại đi nhé. Mình dùng thấy OK mà, có khi là do máy bạn đã có lisp cũ bạn chưa remove nó đi. bạn thử xóa lisp cũ đi, hoặc đồi lệnh nn thành lệnh khác để thử xem. Chúc bạn thanh công!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2057 dvdcad

dvdcad

    biết vẽ arc

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

Đã gửi 27 May 2009 - 03:14 PM

các bác cho em xin lisp tính chiều dài pline bằng cách chọn đối tượng
  • 0

#2058 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 27 May 2009 - 03:45 PM

Mình đang cần lisp thực hiện công việc gấp vải địa kỹ thuật (trong thiêt kế trắc ngang đường) nội dung như sau:
Mình đã có sẵn nhiều đường polyline, mình muốn sau khi chạy lisp tấc cả các đường polyline đó được vẽ thêm hai đầu (gấp vào trong) một đoạn thẳng mình chọn trước. Bác nào viết giúp mình nhé. Thanhk!
Mình up file lên các bạn xem cho dể hiểu nha:
http://www.cadviet.c...pfiles/load.dwg


Bạn dùng cái này thử.

(defun c:thd(/ dthem os ss ss1 ent obj p1 p2 ang ang1)
(setq dthem (getreal "Chieu dai doan can them :")
os (getvar "OSMODE"))
(prompt "\nChon duong can sua:")
(setq ss (ssget '((0 . "LWPOLYLINE")))
ss1 (ssadd))
(setvar "OSMODE" 0)

(repeat (sslength ss)
(setq ent (ssname ss 0)
obj (vlax-ename->vla-object ent)
p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getEndPoint obj))
(if (< (car p1) (car p2)) (setq ang 0 ang1 pi) (setq ang pi ang1 0))

(command "line" p1 (polar p1 ang dthem) "") (ssadd (entlast) ss1)
(command "line" p2 (polar p2 ang1 dthem) "") (ssadd (entlast) ss1)
(ssadd ent ss1)
(command "pedit" "M" ss1 "" "Y" "J" 0 "")
(ssdel ent ss)
)
(setvar "OSMODE" os)
)

  • 1

#2059 thiensoncadviet

thiensoncadviet

    Chưa sử dụng CAD

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

Đã gửi 27 May 2009 - 05:51 PM

Bạn có thể post yêu cầu về autolisp ở topic này.

Tạo giúp em lisp này với
-Trong bản vẽ em thường quản lý dim bằng dimflac và dimfit do đó trong bản vẽ tuy chỉ có 1 loại dim nhưng có những tỷ lệ dimflac và discale khác nhau.
-Giả sử trong bản vẽ ta có dim thứ nhất có dimflac = 1, dimscale =1 . Dim thứ 2 có dimflac = 0.5, dimscale = 0.5
-Khi vẽ em dim thứ nhất đang hiện hành bây giờ em muốn chọn dim thứ 2 làm dim hiện hành để vẽ (Ai giúp em với và nhớ đắt tên lệnh là DHH nha) . Em xin cảm ơn trước.
  • 0

#2060 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 28 May 2009 - 04:34 PM

chào cả nhà CADVIET, hồi trước mình có nhờ các bạn NDTVN, TUE_NV, THANHBINH viết cho mình cái lisp bắn cột đèn và bắn số cột đèn nôi dung của nó như sau :
nó sẽ tu dong rải cho mình 1 block trên 1 đoạn thẳng Pline hoặc SPline... sau đó nó sẽ đánh tên blog này theo thứ tự là T1/L1-1A rồi đến T1/L1-2B, T1/L1-3C, T1/L1-4A.....

bây giờ mình chỉ cần nó tu dong đánh số cho mình thôi mà kô cần rải blog kia nữa ( vì mình rải block sẵn rồi giờ chỉ đánh số thôi ) xin nhờ các bạn : lisp ấy đây

Chào bạn nguyenkhoadung98
Vì gần đây công việc nhiều quá nên không lên đây được.
Lisp đã viết cũng thoả mãn yêu cầu của bạn
Khi dùng lệnh, bạn chỉ cần chọn text chứ không chọn block.
Khi "Chon diem goc de copy :" thì bạn pick vào điểm chèn của cột tương ứng với text là được rồi.
  • 2