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

#2581 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 16 August 2009 - 11:06 PM

Cảm ơn bác nhưng em đã load lisp này về và gõ lệnh cps thì cad nó báo unknown cammand. Bác check lại giúp em nhé!

mình đã test rồi, ok mà. Bây giờ bạn thử lại lần nữa xem sao, chứ tại vì nếu máy báo unknown cammand tức là bạn chưa load được đấy hoặc là khi load no báo lỗi nên nó không thể thực hiện được lệnh vừa rồi. Chúc bạn thành công nha
:bigsmile:
(defun c:cps (/ input redraws copyit)
(defun input (/ sset)
(setq sset (ssget))
)
;;; ---------endsub input--------
(defun redraws (val idx / n i entn)
(setq n (sslength val)
i 0
)
(repeat n
(setq entn (ssname val i))
(redraw entn idx)
(setq i (+ i 1))
)
)
;;; -------endsub redraws--------
(defun copyit (val / copy_clsic copy_ntyp n)
(defun copy_clsic (val p /)
(if (not p)
(setq p (getpoint "Specify base point or displacement:"))
)
(if p
(command "copy" val "" "m" p pause)
(redraws val 4)
)
)
;end copy_clsic
(defun copy_ntyp (val / text_loc change entn entg
dxf ans tt ok p typ ptext dt
at pn pkt dkt akt txt ntxt
)
(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p loc)
)
)
(setq ketqua p)
)
;end text_loc
(defun change (txt tt / ans len n num ott )
(if (= tt "Prefix")
(progn
(setq txt (vl-string-left-trim " " txt)
ans (vl-string-left-trim "0123456789" txt)
len (strlen txt)
n(strlen ans)
num(- len n)
ott(itoa(+ (atoi(substr txt 1 num)) 1))
txt(strcat ott ans)
)
)
(progn
(setq txt (vl-string-right-trim " " txt)
ans (vl-string-right-trim "0123456789" txt)
len (strlen txt)
n(strlen ans)
num(- len n)
ott(itoa(+ (atoi(substr txt (+ n 1) num)) 1))
txt(strcat ans ott)
)
)
)
txt
)
;end change
(setq entn (ssname val 0)
entg (entget entn)
)
(setq dxf (cdr (assoc 0 entg)))
(if (= dxf "TEXT")
(progn
(setq ans (getvar "users1"))
(if (or (= ans "Prefix") (= ans "Suffix") (= ans "Off"))
(setq tt ans)
(setq tt "Prefix")
)
(setq ok "YES")
(while (= ok "YES")
(initget "Prefix Suffix Off")
(setq p
(getpoint
(strcat "\nSpecify base point or [Prefix/Suffix/Off] <"
tt
">: "
)
)
)
(if p
(progn
(setq typ (type p))
(if (= typ 'LIST)
(setq ok "NO")
(setq tt (setvar "users1" p))
)
)
(setq ok "NO")
)
)
(if p
(progn
(if (/= tt "Off")
(progn
(setq
ptext (text_loc (ssname val 0))
ptext (subst 0 (nth 2 ptext) ptext)
dt (distance '(0 0 0) ptext)
at (angle '(0 0 0) ptext)
ok "YES"
)
(while (= ok "YES")
(command "copy" val "" p)
(prompt
"\nSpecify second point of displacement or :"
)
(command pause)
(setq pn (text_loc (entlast))
pn (subst 0 (nth 2 pn) pn)
pkt (subst 0 (nth 2 p) p)
dkt (distance pkt pn)
akt (angle pkt pn)
)
(if
(and (equal dt dkt 0.0001) (equal at akt 0.0001))
(progn
(entdel (entlast))
(setq ok "NO")
)
(progn
(setq entg (entget (entlast))
txt (cdr (assoc 1 entg))
)
(if (not ntxt) (setq ntxt txt))
(setq
ntxt (change ntxt tt)
entg (subst (cons 1 ntxt) (assoc 1 entg) entg)
)
(entmod entg)
)
)
)
)
(copy_clsic val p)
)
)
(redraws val 4)
)
)
)
)
;;; -------mainsub copyit-------
(if val
(progn
(setq n (sslength val))
(if (> n 1)
(copy_clsic val '())
(copy_ntyp val)
)
)
)
)
;;; ---------MAIN----------------
(setq val (ssget))
(redraws val 3)
(copyit val)
)
  • 0

#2582 hailuavnn

hailuavnn

    biết vẽ ellipse

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

Đã gửi 17 August 2009 - 08:13 AM

trong lĩnh vực thiết kế xây dựng của bạn thì mình không rành về chuyên môn lắm, nên bạn có thể gửi bản vẽ có wall trong đó đc không, tại vì mình không biết wall mà bạn vẽ thuộc đối tượng nào: LINE hay LWPOLYLINE, vẽ nét đôi hay nét đơn ... và tim trục nằm ở đâu. Nếu được mình sẽ cố gắng giúp bạn

vẽ line thôi bạn, trục bạn có thể đặt ở giữa. lúc vẽ thì nó tự động OFFSET sang 2 bên, khi vẽ 2 đường đó chéo nhau thì nó sẽ cắt nhau.
  • 0

#2583 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 August 2009 - 08:19 AM

Vâng, em cảm ơn anh Tue_NV nhiều! Cad còn có lệnh này à. Hay quá! Thế mà giờ em mới biết.
Anh cho em hỏi, ngoài biến Dimlfac ra, lệnh này còn biến gì nữa không. Em đã xem trong Help, nhưng chẳng thấy có gì.
Một lần nữa cảm ơn anh!

Em có thể xem bằng cách ấn phím F1
-> Command Reference -> System Variables
Có đủ cả
Ngoài ra, để xem tên biến -> gõ setvar ngay tại dòng Command
Command: SETVAR

Enter variable name or [?]: ? : gõ ? enter

Enter variable(s) to list <*>: enter

ACADVER "16.0s (LMS Tech)" (read only)
ACISOUTVER 70
AFLAGS 0
ANGBASE 0
........
........
Press ENTER to continue:

Ấn Enter để xem tiếp nhá -> Các biến về DIMENSION.
Còn ý nghĩa các biến thì svba chịu khó tìm hiểu -> Nhiều quá
Lệnh DIMOVERRIDE có thể xác định nhiều biến về DIM cho em thay đổi đấy
:bigsmile:

Chào bạn t031285.
Bạn có thể upload luôn file CAD chứa tên Dim1-100 được không?
  • 2

#2584 t031285

t031285

    biết vẽ rectang

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

Đã gửi 17 August 2009 - 10:31 AM

Chào bạn t031285.
Bạn có thể upload luôn file CAD chứa tên Dim1-100 được không?
[/quote]
File đó nè bạn.Thanks
http://www.cadviet.c...es/2/dim100.dwg
  • 0

#2585 ruamap

ruamap

    Chưa sử dụng CAD

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

Đã gửi 17 August 2009 - 04:43 PM

bác NH oi!!!
em cài lệnh sd vào thì được,đánh lệnh nó hiểu nhưng tới đoạn này thì nó báo lỗi thế này,chẳng biết làm thế nào hết.
Bác giúp em với!! cảm ơn bác nhiều!!!
Command: sd
Sap xep dim © CADViet.com
Chon duong dim goc: Unknown command "SD". Press F1 for help.
bad point argument
  • 0

#2586 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 August 2009 - 08:27 AM

Cảm ơn bạn,mình muốn khi đánh dim100 nó sẽ tự tạo tất cả các thông số của dim100 khi đó chỉ việc sử dụng thôi.Bạn có thể viết giùm mình được không.Thanks

Bạn sử dụng Code này Tue_NV viết theo ý bạn xem sao :

(defun c:dim100()
(command "style" "style1" "VHELVCN.TTF" "0" "1" "0" "n" "n")
(if (not (tblsearch "DImstyle" "Dim100"))
(progn
(command "dimstyle" "S" "Dim100")
(command "dim" "style" "style1"
"DIMADEC" 0
"DIMALT" 0
"DIMALTD" 3
"DIMALTF" 0.0394
"DIMALTRND" 0.0000
"DIMALTTD" 3
"DIMALTTZ" 0
"DIMALTU" 2
"DIMALTZ" 0
"DIMASZ" 1.2000
"DIMATFIT" 3
"DIMAUNIT" 0
"DIMAZIN" 0
"DIMBLK" "_Dot"
"DIMBLK1" ""
"DIMBLK2" ""
"DIMCLRD" 8
"DIMCLRE" 8
"DIMCLRT" 4
"DIMDEC" 0
"DIMDLE" 0.0000
"DIMDLI" 7.0000
"DIMEXE" 2.0000
"DIMEXO" 2.0000
"DIMFRAC" 0
"DIMGAP" 0.5000
"DIMJUST" 0
"DIMLFAC" 1.0000
"DIMLIM" 0
"DIMLUNIT" 2
"DIMLWD" 9
"DIMLWE" 9
"DIMRND" 0.0000
"DIMSAH" 0
"DIMSCALE" 100.0000
"DIMSD1" 0
"DIMSD2" 0
"DIMSE1" 0
"DIMSE2" 0
"DIMSOXD" 0
"DIMTAD" 1
"DIMTIH" 0
"DIMTIX" 1
"DIMTM" 0.0000
"DIMTMOVE" 0
"DIMTOFL" 1
"DIMTOH" 0
"DIMTSZ" 0.0000
"DIMTVP" 0.0000
"DIMTXSTY" "style1"
"DIMTXT" 2.5000 \e)
(command "dimstyle" "S" "Dim100" "Y")
)
)
(graphscr)
(princ)
)


@ruamap : Dưới đây là lời khuyên và góp ý của Tue_NV cho bạn 790312 và cũng chính là lời khuyên và góp ý cho bạn đấy.

@790312 : Đề nghị bạn đọc từ đầu đến cuối những bài viết liên quan đến Lisp sắp dim của bác Hoành .
Bạn đọc bài mà bỏ dở giữa chừng thì bạn làm không được đó cũng là điều dễ hiểu và chẳng có ai có thể giúp bạn được trong trường hợp này cả
Khi làm việc thì nên làm đến nơi đến chốn đừng bao giờ bỏ dở giữa chừng. Điều đó là không nên.

Vài lời khuyên và góp ý cùng bạn


Bài viết đã được chỉnh sửa nội dung bởi Tue_NV: 05 November 2009 - 09:16 PM

  • 1

#2587 kiukiu.

kiukiu.

    biết vẽ line

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

Đã gửi 18 August 2009 - 09:42 AM

Chào các bác! Em là thành viên mới nhập cuộc, em không biết nhiều về lisp nhưng công việc của em lại cần đến nó rất nhiều. Em đang làm san nền, làm thủ công thì nâu quá. Tìm trên diễn đàn thì có nhiều lisp của nhiều tác giả, em không biết cái nào Pro nhất. Bác nào có lisp san nền Pro nhất cho em xin nhé, em đang rất cần. Mong các Bác giúp em. Thank!
  • 0

#2588 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 18 August 2009 - 09:46 AM

... mình muốn khi đánh dim100 nó sẽ tự tạo tất cả các thông số của dim100 khi đó chỉ việc sử dụng thôi.
.......

Các bạn viết giùm 1 lisp như sau với:khi ta đánh dim100 thì sẽ hiện ra 1 loại dim giá trị như dim100 trong dimtyle,tương tự
dim20,dim50....

Chào t031285
Các yêu cầu của bạn đã đuợc bạn Tue_NV viết rồi.
Tuy nhiên để tạo mới (copy) 1 DimStyle từ file Cad có sẵn bạn có thể dùng 2 cách sau :
- sử dụng DesignCenter (nhấn Ctr+2), duyệt đến file Cad có DimStyle cần copy, chọn DimStyles -> kéo thả các DimStyle cần copy vào bản vẽ mới.
- sử dụng Express Tools : Xuất và Nhập các kiểu DimStyle.
dòng lệnh DimEx ,DimIm
Menu: Express -> Dimensions -> Dimstyle Export hay Dimstyle Import
  • 2

#2589 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 18 August 2009 - 01:53 PM

Bạn thử test Code này xem sao. Test cả trường hợp LINE và cả POLYLINE luôn bạn nhé :

TUE ơi!sao LISP vạt góc mình dùng lại bị lỗi nữa rồi!TUE xem file CAD kèm theo giúp mình nhé!mình test lại bị sai nữa!thank bạn nhé!
http://www.cadviet.c...s/2/vat_goc.dwg
  • 0

#2590 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 18 August 2009 - 02:34 PM

Chào cả nhà, mình muốn nhờ các bạn viết dùng mình lisp như sau : sai khi dùng lệnh DI (để đo khoảng cách) thì lisp sẽ tự động cộng giá trị khoảng cách mình vừa đo, cụ thể hơn là : ví dụ mình DI 10 lần liên tiếp thì sau khi kết thúc lệnh Di thứ 10 thì lisp sẽ cho ta tổng khoảng cách 10 lần mà ta vừa đo - cảm ơn các bạn cadviet :bigsmile:
  • 0

#2591 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 August 2009 - 02:36 PM

TUE ơi!sao LISP vạt góc mình dùng lại bị lỗi nữa rồi!TUE xem file CAD kèm theo giúp mình nhé!mình test lại bị sai nữa!thank bạn nhé!
http://www.cadviet.c...s/2/vat_goc.dwg

Lỗi này do bạn mà ra cả thôi. Sao bạn không nói ngay từ đầu??
Lisp trên không thể đo được kích thước vạt góc của cung arc được chỉ đo là các đoạn thẳng LINE,POLYLINE thôi
Bản thân hoạt động của Lisp là kéo dài đoạn thẳng thứ nhất , kéo dài đoạn thẳng thứ hai -> giao hai đoạn thẳng đó làm tâm vạt góc.
Nay bạn chuyển 1 đoạn thẳng làm cung thì giao của đoạn thẳng thứ nhất với đoạn thẳng nối hai đầu mút của dây cung. Giao hai đoạn thẳng này làm tâm vạt góc thì há chẳng phải là không đúng ý bạn hay sao?
Tue_NV gửi lại file cho bạn xem :
http://www.cadviet.c...2/vat_goc_1.dwg
  • 0

#2592 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 18 August 2009 - 02:50 PM

Lỗi này do bạn mà ra cả thôi. Sao bạn không nói ngay từ đầu??
Lisp trên không thể đo được kích thước vạt góc của cung arc được chỉ đo là các đoạn thẳng LINE,POLYLINE thôi
Bản thân hoạt động của Lisp là kéo dài đoạn thẳng thứ nhất , kéo dài đoạn thẳng thứ hai -> giao hai đoạn thẳng đó làm tâm vạt góc.
Nay bạn chuyển 1 đoạn thẳng làm cung thì giao của đoạn thẳng thứ nhất với đoạn thẳng nối hai đầu mút của dây cung. Giao hai đoạn thẳng này làm tâm vạt góc thì há chẳng phải là không đúng ý bạn hay sao?

xin lỗi TUE nhé!cái này mình mới làm Quy Hoạch 1 khu sinh thái nên mới phát hiện ra!vậy bây giờ mình nâng cấp lên cho arc được ko vậy TUE?cảm ơn ạn nhiều nhen!
  • 0

#2593 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 August 2009 - 02:57 PM

xin lỗi TUE nhé!cái này mình mới làm Quy Hoạch 1 khu sinh thái nên mới phát hiện ra!vậy bây giờ mình nâng cấp lên cho arc được ko vậy TUE?cảm ơn ạn nhiều nhen!

Bạn làm ơn nói rõ một lần nữa đi.
Cơ sở để ghi kích thước theo phương 1, theo phương 2????
Bạn nói rõ nhé.

@NguyenKhoaDung : Bạn xem Lisp này của Tue_NV có thể giúp bạn đấy :
http://www.cadviet.c...showtopic=12179
  • 0

#2594 cuongtk2

cuongtk2

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 18 August 2009 - 04:08 PM

Chào cả nhà, mình muốn nhờ các bạn viết dùng mình lisp như sau : sai khi dùng lệnh DI (để đo khoảng cách) thì lisp sẽ tự động cộng giá trị khoảng cách mình vừa đo, cụ thể hơn là : ví dụ mình DI 10 lần liên tiếp thì sau khi kết thúc lệnh Di thứ 10 thì lisp sẽ cho ta tổng khoảng cách 10 lần mà ta vừa đo - cảm ơn các bạn cadviet :bigsmile:


Hình như bạn cũng biết về lisp mà, bạn dung vòng lặp while cho các lần pick là được
(setq p1 (getpoint) tong_chieu_dai 0)

(while (setq p2 (getpoint "\nDiem tiep theo:" p1))
(setq tong_chieu_dai (+ tong_chieu_dai (distance p1 p2))
p1 p2)
)
  • 0

#2595 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 18 August 2009 - 05:02 PM

Bạn làm ơn nói rõ một lần nữa đi.
Cơ sở để ghi kích thước theo phương 1, theo phương 2????
Bạn nói rõ nhé.

xin lỗi đã ko nói rõ nhé!làm phiền TUE quá!mình gửi file CAD sau nè!TUE giúp mình nhé!
http://www.cadviet.c...s/2/vatgoc2.dwg
  • 0

#2596 t031285

t031285

    biết vẽ rectang

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

Đã gửi 18 August 2009 - 05:09 PM

[quote name='Tue_NV' date='Aug 18 2009, 8:27' post='70536']
Bạn sử dụng Code này Tue_NV viết theo ý bạn xem sao :

(defun c:dim100()
(command "style" "style1" "VHELVCN.TTF" "0" "1" "0" "n" "n")
(if (not (tblsearch "DImstyle" "Dim100"))
(progn
(command "dimstyle" "S" "Dim100")
(command "dim" "style" "style1"
"DIMADEC" 0
"DIMALT" 0
"DIMALTD" 3
"DIMALTF" 0.0394
"DIMALTRND" 0.0000
"DIMALTTD" 3
"DIMALTTZ" 0
"DIMALTU" 2
"DIMALTZ" 0
"DIMASZ" 1.2000
"DIMATFIT" 3
"DIMAUNIT" 0
"DIMAZIN" 0
"DIMBLK" "_Dot"
"DIMBLK1" ""
"DIMBLK2" ""
"DIMCLRD" 8
"DIMCLRE" 8
"DIMCLRT" 4
"DIMDEC" 0
"DIMDLE" 0.0000
"DIMDLI" 7.0000
"DIMEXE" 2.0000
"DIMEXO" 2.0000
"DIMFRAC" 0
"DIMGAP" 0.5000
"DIMJUST" 0
"DIMLFAC" 1.0000
"DIMLIM" 0
"DIMLUNIT" 2
"DIMLWD" 9
"DIMLWE" 9
"DIMRND" 0.0000
"DIMSAH" 0
"DIMSCALE" 100.0000
"DIMSD1" 0
"DIMSD2" 0
"DIMSE1" 0
"DIMSE2" 0
"DIMSOXD" 0
"DIMTAD" 1
"DIMTIH" 0
"DIMTIX" 1
"DIMTM" 0.0000
"DIMTMOVE" 0
"DIMTOFL" 1
"DIMTOH" 0
"DIMTSZ" 0.0000
"DIMTVP" 0.0000
"DIMTXSTY" "style1"
"DIMTXT" 2.5000 \e)
(command "dimstyle" "S" "Dim100" "Y")
)
)
(graphscr)
(princ)
)


Cảm ơn bạn rất nhiều,bạn thật là tốt bụng.
  • 0

#2597 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 August 2009 - 05:17 PM

xin lỗi đã ko nói rõ nhé!làm phiền TUE quá!mình gửi file CAD sau nè!TUE giúp mình nhé!
http://www.cadviet.c...s/2/vatgoc2.dwg

Trường hợp của bạn thì tâm của đường tròn có bán kính = 8 chính là tâm vạt góc và tâm này nằm trên phương của đường thẳng. Bạn đã tính đến trường hợp tâm của đường tròn đó không trùng với phương của đường thẳng chưa?
Hay nói cách khác kích thước vạt góc theo phương 1 và theo phương 2 không bằng nhau? Còn của bạn thì bằng nhau.
Hãy nêu ra 1 yêu cầu thật tổng quát
  • 0

#2598 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 18 August 2009 - 09:47 PM

Trường hợp của bạn thì tâm của đường tròn có bán kính = 8 chính là tâm vạt góc và tâm này nằm trên phương của đường thẳng. Bạn đã tính đến trường hợp tâm của đường tròn đó không trùng với phương của đường thẳng chưa?
Hay nói cách khác kích thước vạt góc theo phương 1 và theo phương 2 không bằng nhau? Còn của bạn thì bằng nhau.
Hãy nêu ra 1 yêu cầu thật tổng quát

Đối với những góc vạt mà giữa ARC và PLINE mình chỉ cần trường hợp là tâm vạt góc và tâm này nằm trên phương của đường thẳng!bạn giúp mình tí nhé!thanks TUE rất nhiều!mình ghép cái trường hợp này vào cung 1 LISP với trường hợp cũ luôn được ko TUE?
  • 0

#2599 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 19 August 2009 - 01:19 AM

vẽ line thôi bạn, trục bạn có thể đặt ở giữa. lúc vẽ thì nó tự động OFFSET sang 2 bên, khi vẽ 2 đường đó chéo nhau thì nó sẽ cắt nhau.

ok, bạn chạy thử chương trình này rồi cho ý kiến nhé! lệnh là: WALL
note: đọc kỹ hướng dẫn sử dụng trước khi dùng.
(defun c:wall (/ ang_213 entn2lst getreals input undo trim draw next)
(defun ang_213 (p1 p2 p3 / ang_p12 ang_p13 ang_2-1-3 ketqua)
(if (equal (distance p3 p1) 0 0.0001)
(setq ang_2-1-3 0)
(progn
(if (equal (distance p3 p2) 0 0.0001)
(setq ang_2-1-3 0)
(progn
(setq ang_p12 (angle p1 p2)
ang_p13 (angle p1 p3)
)
(if (< ang_p13 ang_p12)
(setq ang_2-1-3 (- ang_p12 ang_p13))
(if (> ang_p13 ang_p12)
(setq ang_2-1-3 (- (* 2 pi) (- ang_p13 ang_p12)))
(if (= ang_p13 ang_p12)
(setq ang_2-1-3 0)
)
)
)
(if (equal ang_2-1-3 (* 2 pi) 0.0001)
(setq ang_2-1-3 0)
)
(setq ketqua ang_2-1-3)
)
)
)
)
)
;end ang_213
(defun entn2lst
(entn / entt entg
object lst fromLWPolyline
fromARC fromLINE ketqua
)
(defun fromLWPolyline
(entg / assoc_10 i
ok nth_lst j ma h
len p bulge gate gate_ans
ketqua
)
(setq assoc_10 (assoc 10 entg))
(setq i 0)
(setq ok "YES")
(while (= ok "YES")
(progn
(setq nth_lst (nth i entg))
(if (equal nth_lst assoc_10)
(setq ok "NO")
)
(setq i (+ i 1))
)
)
(setq j i)
(setq ma '())
(setq h (cdr (assoc 38 entg)))
(setq len (length entg))
(repeat (/ (- len i) 4)
(progn
(setq p (append (cdr (nth (- i 1) entg)) (list h)))
(setq bulge (cdr (nth (+ i 2) entg)))
(setq ma (append ma (list p) (list bulge)))
(setq i (+ i 4))
)
)
(setq gate (cdr (assoc 70 entg))
gate_ans (getgate 1 gate 10)
)
(if (= gate_ans 1)
(progn
(setq p (append (cdr (nth (- j 1) entg)) (list h)))
(setq bulge 1)
(setq ma (append ma (list p) (list bulge)))
)
)
(setq ketqua ma)
)
;;;--------------------------
(defun fromARC (entg / cen r p1 p2 p3 bulge ang_2-1-3 ketqua)
(setq cen (cdr (assoc 10 entg)))
(setq r (cdr (assoc 40 entg)))
(setq p1 (polar cen (cdr (assoc 50 entg)) r))
(setq p2 (polar cen (cdr (assoc 51 entg)) r))
(setq p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
(setq bulge (/ (* (- (distance cen p1) (distance cen p3)) 2)
(distance p1 p2)
)
)
(setq ang_2-1-3 (ang_213 p1 p2 CEN))
(if (< ang_2-1-3 pi)
(setq bulge (/ (* (+ (distance cen p3) r) 2) (distance p1 p2)))
)
(setq ketqua (list p1 bulge p2 0.0))
)
;;;--------------------------
(defun fromLINE (entg / p1 p2 ketqua)
(setq p1 (cdr (assoc 10 entg)))
(setq p2 (cdr (assoc 11 entg)))
(setq ketqua (list p1 0.0 p2 0.0))
)
;;;--------------------------
(defun fromCIRCLE (entg / cen r ketqua)
(setq cen (cdr (assoc 10 entg))
r (cdr (assoc 40 entg))
p1 (polar cen 0 r)
p2 (polar cen pi r)
)
(setq ketqua (list p1 1 p2 1 p1 1))
)
;;;--------------------------
(setq entt (type entn))
(if (= entt 'ENAME)
(progn
(setq entg (entget entn))
(setq object (cdr (assoc 0 entg)))
(cond
((= object "LWPOLYLINE") (setq lst (fromLWPolyline entg)))
((= object "ARC") (setq lst (fromARC entg)))
((= object "LINE") (setq lst (fromLINE entg)))
((= object "CIRCLE") (setq lst (fromCIRCLE entg)))
)
)
(setq lst nil)
)
(setq ketqua lst)
)
;end entn2lst
(defun getreals (real text init / old_real realt name ketqua)
(if (not real)
(setq real 0)
)
(setq old_real real)
(setq realt (rtos real 2))
(initget init)
(setq name (strcat text "<" realt "> :"))
(setq real (getdist name))
(if (not real)
(setq real old_real)
)
(setq ketqua real)
)
;end getreals
(defun input (/ j w ok p)
(setq j (getvar "users1")
w (getvar "userr3")
)
(if (not (or (= j "Center") (= j "Left") (= j "Right")))
(setq j (setvar "users1" "Center"))
)
(if (< w 0)
(setq w 0)
)
(setq ok "YES")
(while (= ok "YES")
(initget "Center Left Right Width")
(setq p
(getpoint
(strcat "Specify start point or [Center/Left/Right/Width] <"
j
": "
(rtos w 2)
">: "
)
)
)
(if p
(cond
((= p "Center") (setq j (setvar "users1" p)))
((= p "Left") (setq j (setvar "users1" p)))
((= p "Right") (setq j (setvar "users1" p)))
((= p "Width")
(setq w (setvar "userr3"
(getreals w "\nChieu day buc tuong " "")
)
)
)
((= (type p) 'LIST) (setq ok "NO"))
)
(setq ok "NO")
)
)
p
)

;enf input
(defun undo (val i / nval p j)
(if (> i 0)
(progn
(setq i (- i 1)
nval '()
p (nth 0 (nth i val))
j 0
)
(if (not p)
(alert "thieu p1")
)
(repeat (1+ i)
(setq nval (append nval (list (nth j val)))
j (1+ J)
)
)
(setq val nval)
(command "Undo" "")
)
(setq p (nth 0 (nth 0 val)))
)
(list p val i)
)
;end undo
(defun trim (sset val / taodanhsachcat yeucaucat cat)
(defun taodanhsachcat (sset val / sslen hand_lst
i len sec1 sec2 hand3 hand4
data hand1 hand2 entg hand dxf
pos len ent
)
(setq sslen (sslength sset)
hand_lst '()
i 0
len (length val)
sec1 (nth (- len 2) val)
sec2 (nth (- len 1) val)
hand3 (nth 1 sec2)
hand4 (nth 2 sec2)
data '()
)
(if (> (length sec1) 1)
(setq hand1 (nth 1 sec1)
hand2 (nth 2 sec1)
data (append data
(list (list hand1 (entn2lst (handent hand1))))
)
data (append data
(list (list hand2 (entn2lst (handent hand2))))
)
)
)
(setq data (append data
(list (list hand3 (entn2lst (handent hand3))))
)
data (append data
(list (list hand4 (entn2lst (handent hand4))))
)
)
(repeat sslen
(setq entg (entget (ssname sset i))
hand (cdr (assoc 5 entg))
dxf (cdr (assoc 0 entg))
pos (vl-position dxf '("LINE"))
i (1+ i)
)
(if pos
(setq hand_lst (append hand_lst (list hand)))
)
)
(setq len (length data)
i 0
)
(repeat len
(setq hand_lst (vl-remove (nth 0 (nth i data)) hand_lst)
i (1+ i)
)
)
(setq len (length hand_lst)
i 0
)
(repeat len
(setq ent (handent (nth i hand_lst))
hand_lst (subst
(list (cdr (assoc 5 (entget ent))) (entn2lst ent))
(nth i hand_lst)
hand_lst
)
i (1+ i)
)
;;; (redraw ent 3)
)
(list data hand_lst)
)
;end taodanhsachcat
(defun yeucaucat (pt_lst / m k entg)
(setq oldpt_lst pt_lst)
(progn
(setq m (fix (/ ptlen 2))
k 0
)
(if (> m 1)
(progn
(setq entg (entget (handent hand)))
(repeat (- m 1)
(setq entg (subst (cons 10 (nth 1 (nth k pt_lst)))
(assoc 10 entg)
entg
)
entg (subst (cons 11 (nth 1 (nth (+ k 1) pt_lst)))
(assoc 11 entg)
entg
)
k (+ k 2)
)
(entmake entg)
)
(setq entg (subst (cons 10 (nth 1 (nth k pt_lst)))
(assoc 10 entg)
entg
))
(if (= (rem ptlen 2) 0 )
(setq entg
(subst (cons 11 (nth 1 (nth (+ k 1) pt_lst)))
(assoc 11 entg)
entg
)
)
(setq entg
(subst (cons 11 (nth 1 (nth (+ k 2) pt_lst)))
(assoc 11 entg)
entg
)
)
)

(entmod entg)
)
)
)
)
;end yeucaucat
(defun cat (hand_lst data idx / len i n hand
line line2 pt_lst p1 p2 j p3 p4 p
sr ptlen rems entg pd pc ang m k
)
(setq len (length hand_lst)
i 0
n (length data)
)
(repeat len
(setq hand (nth 0 (nth i hand_lst))
line (nth 1 (nth i hand_lst))
pt_lst '()
p1 (nth 0 line)
p2 (nth 2 line)
pt_lst (append pt_lst (list (list 0 p1)))
pt_lst (append pt_lst (list (list (distance p1 p2) p2)))
)
(setq j 0)
(repeat n
(setq line (nth 1 (nth j data))
p3 (nth 0 line)
p4 (nth 2 line)
p (inters p1 p2 p3 p4 t)
)
(if (or (equal p p2 0.000001) (equal p p1 0.000001)) (setq p '()))
(if (= (rem j 2) 0)
(setq sr (list p4 p3))
(setq sr (list p3 p4))
)
(if p
(setq
pt_lst
(append pt_lst (list (list (distance p1 p) p sr)))
p '()
)
)
(setq j (+ j 1))
)
(setq pt_lst (vl-sort pt_lst
(function (lambda (e1 e2)
(< (nth 0 e1) (nth 0 e2))
)
)
)
)
(setq ptlen (length pt_lst)
rems (rem ptlen 2)
)
(if (= idx 1)
(progn
(if (= rems 0)
(yeucaucat pt_lst)
(progn
(setq entg (entget (handent hand)))
(setq p1 (cdr (assoc 10 entg))
p2 (cdr (assoc 11 entg))
p (nth 1 (nth 1 pt_lst))
sr (nth 2 (nth 1 pt_lst))

)
(if sr
(progn
(setq
pd (nth 0 sr)
pc (nth 1 sr)
)
(setq ang (ang_213 pd pc p1))
(if (> ang pi)
(setq
entg (subst (cons 10 p) (assoc 10 entg) entg)
)
(setq
entg (subst (cons 11 p) (assoc 11 entg) entg)
)
)
(entmod entg)
)
)
)
)
)
(progn
(setq m (fix (/ ptlen 2))
k 0
)
(if (> m 1)
(yeucaucat pt_lst)
)

)
)
(setq i (+ i 1))
)
)
;end cat
(setq ans (taodanhsachcat sset val)
data (nth 0 ans)
hand_lst (nth 1 ans)
)
(cat hand_lst data 1) ;cat thuc the chan cua no idx=0,1 Khong/Co cat
(cat data hand_lst 0)
)
;end trim
(defun draw (val / j w len sec1 sec2 c1 c2
ang p1 p2 p3 p4 entg1 entg2 ps1 ps2
ps3 ps4 pt_list sset
)
(setq j (getvar "users1")
w (getvar "userr3")
len (length val)
sec1 (nth (- len 2) val)
sec2 (nth (- len 1) val)
c1 (nth 0 sec1)
c2 (nth 0 sec2)
)
(cond
((= j "Left") (setq s w))
((= j "Center") (setq s (/ w 2)))
((= j "Right") (setq s 0))
)
(setq ang (angle c1 c2)
p1 (polar c1 (+ ang (/ pi 2)) s)
p2 (polar c2 (+ ang (/ pi 2)) s)
p3 (polar p1 (- ang (/ pi 2)) w)
p4 (polar p2 (- ang (/ pi 2)) w)
)
(if (> (length sec1) 1)
(progn
(setq entg1 (entget (handent (nth 1 sec1)))
entg2 (entget (handent (nth 2 sec1)))
ps1 (cdr (assoc 10 entg1))
ps2 (cdr (assoc 11 entg1))
ps3 (cdr (assoc 10 entg2))
ps4 (cdr (assoc 11 entg2))
p1 (inters ps1 ps2 p1 p2 nil)
p3 (inters ps3 ps4 p3 p4 nil)
entg1 (subst (cons 11 p1) (assoc 11 entg1) entg1)
entg2 (subst (cons 11 p3) (assoc 11 entg2) entg2)
pt_list (list ps4 p3 p4 p2 p1)
)
(entmod entg1)
(entmod entg2)
)
)
(if (not pt_list)
(setq pt_list (list p1 p2 p4 p3))
)
(command "line" p1 p2 "")
(setq hand (cdr (assoc 5 (entget (entlast)))))
(setq sec2 (append sec2 (list hand)))
(command "line" p3 p4 "")
(setq hand (cdr (assoc 5 (entget (entlast)))))
(setq sec2 (append sec2 (list hand)))
(setq val (subst sec2 (nth (- len 1) val) val))
(setq sset (ssget "f" pt_list))
(if sset
(trim sset val)
)
val
)
;end draw
(defun next (p1 / ok val i p2 ans p1)
(if (= (type p1) 'LIST)
(progn
(setq ok "YES"
val (list (list p1))
i 0
)
(while (= ok "YES")
(if (= i 0)
(setq name "\nSpecify next point:")
(setq name "\nSpecify next point or [Undo]: ")
)
(initget "Undo")
(setq p2 (getpoint name p1))
(if p2
(progn
(if (= p2 "Undo")
(progn
(setq ans (undo val i))
(setq p1 (nth 0 ans)
val (nth 1 ans)
i (nth 2 ans)
)
)
(progn
(setq p1 p2
val (append val (list (list p1)))
i (+ i 1)
)
(command "Undo" "group")
(setq val (draw val))
(command "undo" "end")
)
)
)
(setq ok "NO")
)
)
)
)
)
;end next
;;;--------MAIN-----------
(command "Undo" "group")
(setq p (vl-catch-all-apply 'input '()))
(next p)
;;; (vl-catch-all-apply 'next '(p))
(command "Undo" "End")
)

  • 0

#2600 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 19 August 2009 - 07:46 AM

Chào conghoan
Lisp này Tue_NV đã viết xong. Conghoan chạy thử xem sao :
http://www.cadviet.c...les/2/vbun6.lsp
Conghoan cho ý kiến nhé

Tue_NV xem lại giúp mình với mình test trên cad 2007 nó bị như thế này: http://www.cadviet.c...iles/2/tnct.dwg
Cảm ơn Tue_NV nhiều!
  • 0
Học học nữa học mãi.
Đúp học lại!