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

#2181 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 19 June 2009 - 12:20 PM

các bác nào có lisp tính diện tích HATCH được ko vậy?

Thiep nghĩ nếu hatch của bạn lỡ bị mất đường bao thì dùng lisp boundbh.lsp có trên mạng để tái tạo lại, sau đó pick vào đường bao và ^1 thì sẽ thấy được diện tích. Nếu có đảo thì phải trừ diện tích đường bao đảo.
  • 0

#2182 Snowman

Snowman

    biết lệnh mirror

  • Members
  • PipPipPip
  • 155 Bài viết
Điểm đánh giá: 90 (tàm tạm)

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

các bác nào có lisp tính diện tích HATCH được ko vậy?

Lấy dt hatch cũng như lấy dt polyline mà ( lệnh area trong CAD cho phép chọn cả hatch)
Còn đây là lisp: Tên lệnh "DT", chọn các đối tượng --> chọn lỗ thủng (đối tượng cần trừ dt) --> Chọn text hoặc chỉ điểm chèn kết quả

(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)

(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
(defun sothanhchuint (num)
(if (> num 0)
(strcat "+" (rtos num 2 2))
(rtos num 2 2)
)
)
(defun sothanhchuintreal (num) (rtos num 2 2))
(defun sothanhchuintreal1 (num) (rtos num 2 0))


(defun Noichu (Ob newstr key)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 (strcat (cdr txtstr) key newstr)))
(entmod (subst newstr txtstr Ob))
)

(defun thaychu (Ob newstr / obtmp)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr)
obtmp (entmod (subst newstr txtstr Ob))
)
(entupd (cdr (assoc -1 obtmp)))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . " (0 . "text")
(0 . "mtext")
(0 . "ATTRIB")
(-4 . "OR>")
)
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))
;;;;================================================
;;;======================================================
;;;Tinh dien tich bang cach chon doi tuong

(defun C:dt (/ pt1 Objare objtxt dtich dtich1 ss1 ss2 ss3 lacol)

(command "UCS" "W" "")
(command "Undo" "Mark")
(setq oldos (getvar "OsMODE"))

(princ "\nChän ®èi t­îng cÇn lÊy diÖn tÝch")
(setq Objare (car (nentsel)))
(while
(not
(member (cdr (assoc 0 (entget objare)))
'("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")
)
)
(prompt
"\n§èi t­îng kh«ng ®óng kiÓu! Chän l¹i ®èi t­îng cÇn lÊy diÖn tÝch ..."
)
(setq objare (car (nentsel))
)
)
(command "area" "o" Objare)
(setq dtich (getvar "Area"))

(princ "\nChän ®èi t­îng cÇn lÊy diÖn tÝch tiÕp theo (Enter ®Ó dõng l¹i)")
(setq Objare (car (nentsel)))

(while (/= Objare nil)
(if
(not
(member (cdr (assoc 0 (entget objare)))
'("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")
)
)
(prompt
"\n§èi t­îng kh«ng ®óng kiÓu! Chän l¹i ®èi t­îng cÇn lÊy diÖn tÝch ..."
)
(progn
(command "area" "o" Objare)
(setq dtich1 (getvar "Area")
dtich (+ dtich dtich1)
)
)
)
(princ "\nChän ®èi t­îng cÇn lÊy diÖn tÝch tiÕp theo (Enter ®Ó dõng l¹i)")
(setq Objare (car (nentsel)))

)

(princ "\nChän ®èi t­îng lç thñng (cÇn trõ diÖn tÝch)...")
(setq Objare (car (nentsel)))

(while (/= Objare nil)
(if
(not
(member (cdr (assoc 0 (entget objare)))
'("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")
)
)
(prompt
"\n§èi t­îng kh«ng ®óng kiÓu! Chän l¹i ®èi t­îng ..."
)
(progn
(command "area" "o" Objare)
(setq dtich1 (* -1 (getvar "Area"))
dtich (+ dtich dtich1)
)

)
)
(princ "\nChän ®èi t­îng lç thñng tiÕp theo (Enter ®Ó dõng l¹i)")
(setq Objare (car (nentsel)))

)

(setq objtxt (chon1chu "\nChän text chøa kÕt qu¶ diÖn tÝch (Enter ®Ó t¹o text míi)"))
(if (/= objtxt nil)
(progn
(setq st (sothanhchuintreal dtich))
(thaychu objtxt st)
)
(progn
(setq st (sothanhchuintreal dtich))
(setq pt1 (getpoint "\n Diem dat text: "))
(command "text" pt1 "" "" st)
)
)
)


Chú ý với Tiếng Việt ở Command line :lol2:
  • 0

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#2183 ph168xd

ph168xd

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 779 Bài viết
Điểm đánh giá: 309 (khá)

Đã gửi 19 June 2009 - 01:46 PM

Số lượng câu hỏi cũng như câu trả lời nhiều quá
Nên mình không biết tìm ở đâu

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
Thanks mng nhiều

Xin hỏi luôn, có cách nào insert 1 hình chữ nhật không phải block vào bản vẽ hay không



Ai ơi giúp mình với
  • 0

#2184 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 19 June 2009 - 01:49 PM

Chú ý với Tiếng Việt ở Command line :lol2:

Lisp post lên codebox rất hay bị lỗi ở code DXF -4 nên bác post file lisp lên cho chuẩn. Cái nữa là bác dùng font tiếng Việt ở dòng nhắc mà ko hướng dẫn anh em cách chuyển font tiếng Việt cho dòng Command thì thiếu sót quá :lol2:
  • 0

#2185 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 19 June 2009 - 02:32 PM

Thiep nghĩ nếu hatch của bạn lỡ bị mất đường bao thì dùng lisp boundbh.lsp có trên mạng để tái tạo lại, sau đó pick vào đường bao và ^1 thì sẽ thấy được diện tích. Nếu có đảo thì phải trừ diện tích đường bao đảo.

sao mình search quài mà ko thấy cái lisp boundbh.lsp này vậy bạn?bạn cho mình link dc ko?thanks!
  • 0

#2186 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 19 June 2009 - 02:33 PM

Chào các bác, :lol2:
Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

1/ gõ lệnh và enter
2/ pick chọn đối tượng PL
Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).
3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL
4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.
....................

Chào xuantran15
Bạn chạy thử LISP "Add Text Pline"
;ATP -> Add Text Pline
(defun c:ATP (/ cEnt cObj param kc_txt dd dg dc vt ang km met)
(vl-load-com)
(if (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
(eq "AcDbPolyline"
(vla-get-ObjectName
(setq cObj (vlax-ename->vla-object cEnt)))))
(progn
(setq param 1
dd (vlax-curve-getStartPoint cObj)
kc_txt (* 1.5 (getvar "TEXTSIZE")))
(if (< (cadr dd)(cadr (vlax-curve-getPointAtParam cObj (1+ param))))
(setq vt (polar dd (/ pi 2) kc_txt))
(setq vt (polar dd (/ pi -2) kc_txt))
)
(Make_Text vt "K0+000")
(while (< param (vlax-curve-getEndParam cObj))
(setq len (vlax-curve-getDistAtParam cObj param)
dg (vlax-curve-getPointAtParam cObj param)
dc (vlax-curve-getPointAtParam cObj (1+ param))
ang (abs (- (angle dg dc) (angle dg dd) ) )
km (fix (/ len 1000))
met (- len (* km 1000)))
(setq ang (angtos ang 1) dd dg)
(if (> (cadr dg)(cadr dc))
(setq vt (polar dg (/ pi 2) kc_txt))
(setq vt (polar dg (/ pi -2) kc_txt))
)
(Make_Text vt (strcat "K" (rtos km 2 0) "+"(rtos met 2 0)))
(Make_Text (polar vt (/ pi -2) kc_txt) (strcat "S" (rtos param 2 0) "=" ang))
(setq param (1+ param ))
)
)
(princ "\n<< No Polyline Selected >>"))
(princ))

(defun Make_Text (pt val )
(entmake (list (cons 0 "TEXT")
(cons 62 2);color
(cons 10 pt)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 val)
'(71 . 0)
'(72 . 1)
'(73 . 1)
(cons 11 pt)
)))

  • 1

#2187 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 19 June 2009 - 02:40 PM

Lấy dt hatch cũng như lấy dt polyline mà ( lệnh area trong CAD cho phép chọn cả hatch)
..........................

Chào Snowman
Chú ý : với CAD 2004 trở về truớc : lệnh area không cho phép chọn hatch
Selected object does not have an area
-> LISP báo lỗi.
  • 0

#2188 xuantran15

xuantran15

    biết lệnh ddedit

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

Đã gửi 19 June 2009 - 03:58 PM

Chào bác gia bạch!
Mình đã thử lisp của bác và thấy nó chạy ra kết quả tương đối tốt. Nhưng có một số ý kiến mong các bác quan tâm.
1/ Một số số đo góc bị nhầm lẫn trong việc lấy góc. Vì góc cần lấy là góc nhỏ hơn trong hai góc. (Góc này luôn bé hơn 180độ)
2/ Bác cho số đo góc chính xác tới giây luôn nhé.
3/ Lisp chạy luôn lấy giá trị dímstyle của standar thì phải, và chiều cao text không thay đổi được bác à.
Cám ơn các bác nhiều :lol2:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2189 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 June 2009 - 04:21 PM

Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

1/ gõ lệnh và enter
2/ pick chọn đối tượng PL
Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).
3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL
4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.
....................

Tue_NV đã chỉnh sửa tất cả lại
Bạn test thử nhé :

;; free lisp from cadviet.com

(defun c:ggoc(/ oldos curve cao ddau ddau1 pre i diem1 diem2 gocA gocB gocC
do dotinh phut giay diemchen1 diemchen2 diemchen10 chuoido L)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Chon Polyline :")))
(setq cao (getvar "textsize"))
(setq ddau (vlax-curve-getStartPoint curve) i 1)
(setq ddau1 ddau)
(setq pre (vlax-curve-getEndParam curve))

(while (< i pre)

(setq diem1 (vlax-curve-getPointAtParam curve i))
(setq diem2 (vlax-curve-getPointAtParam curve (1+ i)))


(setq gocA (/ (* (angle diem1 ddau) 180) pi))
(setq gocB (/ (* (angle diem1 diem2) 180) pi))
(if (< (abs(- gocA gocB)) 180)
(setq gocC (abs(- gocA gocB)))
(setq gocC (- 360 (abs(- gocA gocB))))
)
(setq do (fix gocC))

(setq dotinh (* (- gocC do) 3600))
(setq phut (fix (/ dotinh 60)))
(setq giay (fix (rem dotinh 60)))

(if (> (cadr diem1) (cadr diem2))
(progn
(setq diemchen1 (list (car diem1) (+ (cadr diem1) (* 3.0 cao)) 0))
(setq diemchen2 (list (car diem1) (+ (cadr diem1) (* 1.5 cao)) 0))
)
(progn
(setq diemchen1 (list (car diem1) (- (cadr diem1) (* 1.5 cao)) 0))
(setq diemchen2 (list (car diem1) (- (cadr diem1) (* 3.0 cao)) 0))
)
)
(setq chuoido (strcat (rtos do 2 0) (chr 176) (rtos phut 2 0) "'" (rtos giay 2 0) "''"))
(setq L (vlax-curve-getDistAtPoint curve diem1))

(wtxt chuoido diemchen1)
(wtxt (strcat "L = " (rtos L 2 0)) diemchen2)

(setq i (1+ i))
(setq ddau diem1)
)
(setq diemchen10 (list (car ddau1) (- (cadr ddau1) (* 1.5 cao)) 0))
(wtxt (strcat "L = " (rtos (vlax-curve-getDistAtPoint curve ddau1) 2 0)) diemchen10)

(setvar "osmode" oldos)
(command "undo" "end")
(princ)
)
;
;

;
(defun wtxt (txt p / sty d h)
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h (cdr (assoc 40 d))
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) (cons 72 1) (cons 73 2)
          (if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

:lol2:
  • 1

#2190 xuantran15

xuantran15

    biết lệnh ddedit

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

Đã gửi 19 June 2009 - 04:51 PM

Tue_NV đã chỉnh sửa tất cả lại
Bạn test thử nhé :


;; free lisp from cadviet.com

(defun c:ggoc(/ oldos curve cao ddau ddau1 pre i diem1 diem2 gocA gocB gocC
do dotinh phut giay diemchen1 diemchen2 diemchen10 chuoido L)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Chon Polyline :")))
(setq cao (getvar "textsize"))
(setq ddau (vlax-curve-getStartPoint curve) i 1)
(setq ddau1 ddau)
(setq pre (vlax-curve-getEndParam curve))

(while (< i pre)

(setq diem1 (vlax-curve-getPointAtParam curve i))
(setq diem2 (vlax-curve-getPointAtParam curve (1+ i)))
(setq gocA (/ (* (angle diem1 ddau) 180) pi))
(setq gocB (/ (* (angle diem1 diem2) 180) pi))
(if (< (abs(- gocA gocB)) 180)
(setq gocC (abs(- gocA gocB)))
(setq gocC (- 360 (abs(- gocA gocB))))
)
(setq do (fix gocC))

(setq dotinh (* (- gocC do) 3600))
(setq phut (fix (/ dotinh 60)))
(setq giay (fix (rem dotinh 60)))

(if (> (cadr diem1) (cadr diem2))
(progn
(setq diemchen1 (list (car diem1) (+ (cadr diem1) (* 3.0 cao)) 0))
(setq diemchen2 (list (car diem1) (+ (cadr diem1) (* 1.5 cao)) 0))
)
(progn
(setq diemchen1 (list (car diem1) (- (cadr diem1) (* 1.5 cao)) 0))
(setq diemchen2 (list (car diem1) (- (cadr diem1) (* 3.0 cao)) 0))
)
)
(setq chuoido (strcat (rtos do 2 0) (chr 176) (rtos phut 2 0) "'" (rtos giay 2 0) "''"))
(setq L (vlax-curve-getDistAtPoint curve diem1))

(wtxt chuoido diemchen1)
(wtxt (strcat "L = " (rtos L 2 0)) diemchen2)

(setq i (1+ i))
(setq ddau diem1)
)
(setq diemchen10 (list (car ddau1) (- (cadr ddau1) (* 1.5 cao)) 0))
(wtxt (strcat "L = " (rtos (vlax-curve-getDistAtPoint curve ddau1) 2 0)) diemchen10)

(setvar "osmode" oldos)
(command "undo" "end")
(princ)
)
;
;

;
(defun wtxt (txt p / sty d h)
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h (cdr (assoc 40 d))
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) (cons 72 1) (cons 73 2)
          (if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

:D

Rất tuyệt bác Tuệ à. chỉ còn một lỗi nhỏ là khi chiều cao text lớn thì hai dòng text gần trùng lên nhau. Nếu có thể bác khắc phục hiện tượng này luôn nhé. Cám ơn tất cả mọi người rất nhiều, có cái này mình giảm được ít nhất 30phút cho mỗi bản vẽ :lol2: :lol2:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2191 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 19 June 2009 - 05:11 PM

sao mình search quài mà ko thấy cái lisp boundbh.lsp này vậy bạn?bạn cho mình link dc ko?thanks!

Xin lỗi, thiep nhầm, nó là hatchb.lsp:
;----Tao boundary cho Hatch
(defun c:hb () (c:hatchb))
; this line can be commented out if there is an existing command called hb
(defun c:hatchb (/ es blay ed1 ed2
loops1 bptf part et noe
plist ic bul nr ang1
ang2 obj *ModelSpace*
*PaperSpace* space cw errexit
undox olderr oldcmdecho ss1 lastent
en1 en2 ss lwp
list->variantArray 3dPoint->2dPoint A2k
ent i ss2 knot-list
controlpoint-list kn cn pos
)
(setq A2k (wcmatch (getvar "ACADVER") "17.0s (LMS Tech)"))
(if A2k
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
)
(if A2k
(defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
)

(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)

(defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)

(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if A2k
(progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
*PaperSpace* (vla-get-PaperSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
)
)
(if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
(progn
(setq i 0)
(while (setq ent (ssname ss2 i))
(setq ed1 (entget ent))
(if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0)))
(princ "\nHatch not in WCS!")
)
(command "._ucs" "_w")
(setq loops1 (cdr (assoc 91 ed1)))
; number of boundary paths (loops)
(if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
(setq space *ModelSpace*)
(setq space *PaperSpace*)
)
(repeat loops1
(setq ed1 (member (assoc 92 ed1) ed1))
(setq bptf (cdr (car ed1))) ; boundary path type flag
(setq ic (cdr (assoc 73 ed1))) ; is closed
(setq noe (cdr (assoc 93 ed1))) ; number of edges
(setq ed1 (member (assoc 72 ed1) ed1))
(setq bul (cdr (car ed1))) ; bulge
(setq plist nil)
(setq blist nil)
(cond
((> (boole 1 bptf 2) 0) ; polyline
(repeat noe
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq plist (append plist (list (cdr (assoc 10 ed1)))))
(setq blist (append blist
(if (> bul 0)
(list (cdr (assoc 42 ed1)))
nil
)
)
)
)
(if A2k
(progn
(setq polypoints
(apply 'append
(mapcar '3dPoint->2dPoint plist)
)
)
(setq VLADataPts (list->variantArray polypoints))
(setq
obj (vla-addLightweightPolyline space VLADataPts)
)
(setq nr 0)
(repeat (length blist)
(if (/= (nth nr blist) 0)
(vla-setBulge obj nr (nth nr blist))
)
(setq nr (1+ nr))
)
(if (= ic 1)
(vla-put-closed obj T)
)
)
(progn
(if (= ic 1)
(entmake '((0 . "LWPOLYLINE") (66 . 1) (70 . 1)))
(entmake '((0 . "LWPOLYLINE") (66 . 1)))
)
(setq nr 0)
(repeat (length plist)
(if (= bul 0)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
)
)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
(cons 42 (nth nr blist))
)
)
)
(setq nr (1+ nr))
)
(entmake '((0 . "SEQEND")))
)
)
)
(t ; not polyline
(setq lastent (entlast))
(setq lwp T)
(repeat noe
(setq et (cdr (assoc 72 ed1)))
(cond
((= et 1) ; line
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(if A2k
(vla-AddLine
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
)
(entmake
(list (cons 0 "LINE")
(assoc 10 ed1)
(assoc 11 ed1)
)
)
)
(setq ed1 (cddr ed1))
)
((= et 2) ; circular arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if (equal ang2 6.28319 0.00001)
(progn
(if A2k
(vla-AddCircle
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
)
(entmake (list (cons 0 "CIRCLE")
(assoc 10 ed1)
(assoc 40 ed1)
)
)
)
(setq lwp nil)
)
(if A2k
(vla-AddArc
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
(if (= cw 0)
(- 0 ang2)
ang1
)
(if (= cw 0)
(- 0 ang1)
ang2
)
)
(entmake (list (cons 0 "ARC")
(assoc 10 ed1)
(assoc 40 ed1)
(cons 50
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(cons 51
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
)
)
)
(setq ed1 (cddddr ed1))
)
((= et 3) ; elliptic arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if A2k
(progn
(setq obj (vla-AddEllipse
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
(cdr (assoc 40 ed1))
)
)
(vla-put-startangle
obj
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(vla-put-endangle
obj
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
(princ "\nElliptic arc not supported!")
)
(setq lwp nil)
)
((= et 4) ; spline
(setq ed1 (member (assoc 94 (cdr ed1)) ed1))
(setq knot-list nil)
(setq controlpoint-list nil)
(setq kn (cdr (assoc 95 ed1)))
(setq cn (cdr (assoc 96 ed1)))
(setq pos (vl-position (assoc 40 ed1) ed1))
(repeat kn
(setq
knot-list (cons (cons 40 (cdr (nth pos ed1)))
knot-list
)
)
(setq pos (1+ pos))
)
(setq pos (vl-position (assoc 10 ed1) ed1))
(repeat cn
(setq controlpoint-list
(cons
(cons 10 (cdr (nth pos ed1)))
controlpoint-list
)
)
(setq pos (1+ pos))
)
(setq knot-list (reverse knot-list))
(setq controlpoint-list (reverse controlpoint-list))
(entmake (append
(list '(0 . "SPLINE"))
(list (cons 100 "AcDbEntity"))
(list (cons 100 "AcDbSpline"))
(list (cons 70
(+ 1
8
(* 2 (cdr (assoc 74 ed1)))
(* 4 (cdr (assoc 73 ed1)))
)
)
)
(list (cons 71 (cdr (assoc 94 ed1))))
(list (cons 72 kn))
(list (cons 73 cn))
knot-list
controlpoint-list
)
)
(setq ed1 (member (assoc 10 ed1) ed1))
(setq lwp nil)
)
) ; end cond
) ; end repeat noe
(if lwp
(progn
(setq en1 (entnext lastent))
(setq ss (ssadd))
(ssadd en1 ss)
(while (setq en2 (entnext en1))
(ssadd en2 ss)
(setq en1 en2)
)
(command "_.pedit" (entlast) "_Y" "_J" ss "" "")
)
)
) ; end t
) ; end cond
) ; end repeat loops1
(setq i (1+ i))
)
)
)
(restore)
(princ)
)

Lisp rất hay ở chỗ khôi phục lại bound cho hatch kể cả đường SPLINE, ARC, CIRCLE...

Không hiểu chiều nay không upload được, bạn copy từ codebox vậy. Nếu có lỗi gì, ngày mai mạng tốt, mình sẽ up vậy.
  • 0

#2192 xuantran15

xuantran15

    biết lệnh ddedit

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

Đã gửi 19 June 2009 - 05:23 PM

Xin lỗi, thiep nhầm, nó là hatchb.lsp:

;----Tao boundary cho Hatch
(defun c:hb () (c:hatchb))
; this line can be commented out if there is an existing command called hb
(defun c:hatchb (/ es blay ed1 ed2
loops1 bptf part et noe
plist ic bul nr ang1
ang2 obj *ModelSpace*
*PaperSpace* space cw errexit
undox olderr oldcmdecho ss1 lastent
en1 en2 ss lwp
list->variantArray 3dPoint->2dPoint A2k
ent i ss2 knot-list
controlpoint-list kn cn pos
)
(setq A2k (wcmatch (getvar "ACADVER") "17.0s (LMS Tech)"))
(if A2k
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
)
(if A2k
(defun 3dPoint->2dPoint (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
)

(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)

(defun undox ()
(command "._ucs" "_p")
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)

(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if A2k
(progn
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
*PaperSpace* (vla-get-PaperSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
)
)
(if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
(progn
(setq i 0)
(while (setq ent (ssname ss2 i))
(setq ed1 (entget ent))
(if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0)))
(princ "\nHatch not in WCS!")
)
(command "._ucs" "_w")
(setq loops1 (cdr (assoc 91 ed1)))
; number of boundary paths (loops)
(if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
(setq space *ModelSpace*)
(setq space *PaperSpace*)
)
(repeat loops1
(setq ed1 (member (assoc 92 ed1) ed1))
(setq bptf (cdr (car ed1))) ; boundary path type flag
(setq ic (cdr (assoc 73 ed1))) ; is closed
(setq noe (cdr (assoc 93 ed1))) ; number of edges
(setq ed1 (member (assoc 72 ed1) ed1))
(setq bul (cdr (car ed1))) ; bulge
(setq plist nil)
(setq blist nil)
(cond
((> (boole 1 bptf 2) 0) ; polyline
(repeat noe
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq plist (append plist (list (cdr (assoc 10 ed1)))))
(setq blist (append blist
(if (> bul 0)
(list (cdr (assoc 42 ed1)))
nil
)
)
)
)
(if A2k
(progn
(setq polypoints
(apply 'append
(mapcar '3dPoint->2dPoint plist)
)
)
(setq VLADataPts (list->variantArray polypoints))
(setq
obj (vla-addLightweightPolyline space VLADataPts)
)
(setq nr 0)
(repeat (length blist)
(if (/= (nth nr blist) 0)
(vla-setBulge obj nr (nth nr blist))
)
(setq nr (1+ nr))
)
(if (= ic 1)
(vla-put-closed obj T)
)
)
(progn
(if (= ic 1)
(entmake '((0 . "LWPOLYLINE") (66 . 1) (70 . 1)))
(entmake '((0 . "LWPOLYLINE") (66 . 1)))
)
(setq nr 0)
(repeat (length plist)
(if (= bul 0)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
)
)
(entmake (list (cons 0 "VERTEX")
(cons 10 (nth nr plist))
(cons 42 (nth nr blist))
)
)
)
(setq nr (1+ nr))
)
(entmake '((0 . "SEQEND")))
)
)
)
(t ; not polyline
(setq lastent (entlast))
(setq lwp T)
(repeat noe
(setq et (cdr (assoc 72 ed1)))
(cond
((= et 1) ; line
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(if A2k
(vla-AddLine
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
)
(entmake
(list (cons 0 "LINE")
(assoc 10 ed1)
(assoc 11 ed1)
)
)
)
(setq ed1 (cddr ed1))
)
((= et 2) ; circular arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if (equal ang2 6.28319 0.00001)
(progn
(if A2k
(vla-AddCircle
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
)
(entmake (list (cons 0 "CIRCLE")
(assoc 10 ed1)
(assoc 40 ed1)
)
)
)
(setq lwp nil)
)
(if A2k
(vla-AddArc
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(cdr (assoc 40 ed1))
(if (= cw 0)
(- 0 ang2)
ang1
)
(if (= cw 0)
(- 0 ang1)
ang2
)
)
(entmake (list (cons 0 "ARC")
(assoc 10 ed1)
(assoc 40 ed1)
(cons 50
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(cons 51
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
)
)
)
(setq ed1 (cddddr ed1))
)
((= et 3) ; elliptic arc
(setq ed1 (member (assoc 10 (cdr ed1)) ed1))
(setq ang1 (cdr (assoc 50 ed1)))
(setq ang2 (cdr (assoc 51 ed1)))
(setq cw (cdr (assoc 73 ed1)))
(if A2k
(progn
(setq obj (vla-AddEllipse
space
(vlax-3d-point (cdr (assoc 10 ed1)))
(vlax-3d-point (cdr (assoc 11 ed1)))
(cdr (assoc 40 ed1))
)
)
(vla-put-startangle
obj
(if (= cw 0)
(- 0 ang2)
ang1
)
)
(vla-put-endangle
obj
(if (= cw 0)
(- 0 ang1)
ang2
)
)
)
(princ "\nElliptic arc not supported!")
)
(setq lwp nil)
)
((= et 4) ; spline
(setq ed1 (member (assoc 94 (cdr ed1)) ed1))
(setq knot-list nil)
(setq controlpoint-list nil)
(setq kn (cdr (assoc 95 ed1)))
(setq cn (cdr (assoc 96 ed1)))
(setq pos (vl-position (assoc 40 ed1) ed1))
(repeat kn
(setq
knot-list (cons (cons 40 (cdr (nth pos ed1)))
knot-list
)
)
(setq pos (1+ pos))
)
(setq pos (vl-position (assoc 10 ed1) ed1))
(repeat cn
(setq controlpoint-list
(cons
(cons 10 (cdr (nth pos ed1)))
controlpoint-list
)
)
(setq pos (1+ pos))
)
(setq knot-list (reverse knot-list))
(setq controlpoint-list (reverse controlpoint-list))
(entmake (append
(list '(0 . "SPLINE"))
(list (cons 100 "AcDbEntity"))
(list (cons 100 "AcDbSpline"))
(list (cons 70
(+ 1
8
(* 2 (cdr (assoc 74 ed1)))
(* 4 (cdr (assoc 73 ed1)))
)
)
)
(list (cons 71 (cdr (assoc 94 ed1))))
(list (cons 72 kn))
(list (cons 73 cn))
knot-list
controlpoint-list
)
)
(setq ed1 (member (assoc 10 ed1) ed1))
(setq lwp nil)
)
) ; end cond
) ; end repeat noe
(if lwp
(progn
(setq en1 (entnext lastent))
(setq ss (ssadd))
(ssadd en1 ss)
(while (setq en2 (entnext en1))
(ssadd en2 ss)
(setq en1 en2)
)
(command "_.pedit" (entlast) "_Y" "_J" ss "" "")
)
)
) ; end t
) ; end cond
) ; end repeat loops1
(setq i (1+ i))
)
)
)
(restore)
(princ)
)

Lisp rất hay ở chỗ khôi phục lại bound cho hatch kể cả đường SPLINE, ARC, CIRCLE...

Không hiểu chiều nay không upload được, bạn copy từ codebox vậy. Nếu có lỗi gì, ngày mai mạng tốt, mình sẽ up vậy.

Thấy cái lisp hay mình test thử và đã xuất hiện lỗi bác à. :lol2:
Thu lisp
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2193 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 22 June 2009 - 09:21 AM

Thấy cái lisp hay mình test thử và đã xuất hiện lỗi bác à. :lol2:
Thu lisp

Vâng xuântran15 nói đúng, lisp này thiep sưu tầm từ tác giả Jimmy Bergmark, ver 2.5
Nó chỉ đúng một cách tương đối, khi biên là 1 curve kín thì lisp này làm việc đúng, khi biên có nhiều curve (có đường cong trơn tham gia) thì lisp sẽ tạo ra nhiều curve không trật tự. Nhưng phải nói: Lisp hatchb này cho ta học hỏi rất nhiều về cách tạo các loại đường phức tạp từ hàm Entmake.
  • 1

#2194 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 22 June 2009 - 09:42 AM

Em cũng biết là các Bác rất bận, nhưng vẫn mong các Bác coi sơ qua và chỉnh dùm em 2 đoạn lisp VC - VE0. Em xin các mơn các Bác trước, em ở TP.HCM ko biết Bác nào ở TP.HCM có thể học tập kinh nghiệm viết lisp của các Bác. :lol2:
  • 0

#2195 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 22 June 2009 - 09:52 AM

Em cũng biết là các Bác rất bận, nhưng vẫn mong các Bác coi sơ qua và chỉnh dùm em 2 đoạn lisp VC - VE0. Em xin các mơn các Bác trước, em ở TP.HCM ko biết Bác nào ở TP.HCM có thể học tập kinh nghiệm viết lisp của các Bác. :lol2:


bạn up lên 2 cái lisp đó và nói lại yêu cầu.
  • 1

#2196 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 22 June 2009 - 10:15 AM

Chào bác gia bạch!
Mình đã thử lisp của bác và thấy nó chạy ra kết quả tương đối tốt. Nhưng có một số ý kiến mong các bác quan tâm.
1/ Một số số đo góc bị nhầm lẫn trong việc lấy góc. Vì góc cần lấy là góc nhỏ hơn trong hai góc. (Góc này luôn bé hơn 180độ)
2/ Bác cho số đo góc chính xác tới giây luôn nhé.
3/ Lisp chạy luôn lấy giá trị dímstyle của standar thì phải, và chiều cao text không thay đổi được bác à.
Cám ơn các bác nhiều :lol2:

Chào xuantran15
Gửi bạn LISP đã cập nhật theo yêu cầu.

............
4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.
..........


;ATP -> Add Text Pline
(defun c:ATP (/ vl ov cEnt cObj param kc_txt dd dg dc vt ang km met)
(vl-load-com)
(setq vl '("CMDECHO" "OSMODE" "AUPREC") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 3)) ; Set new values

(if (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
(eq "AcDbPolyline"
(vla-get-ObjectName
(setq cObj (vlax-ename->vla-object cEnt)))))
(progn
(if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") )
)
(setq param 1
dd (vlax-curve-getStartPoint cObj)
kc_txt (* 1.5 chcao))
(if (< (cadr dd)(cadr (vlax-curve-getPointAtParam cObj (1+ param))))
(setq vt (polar dd (/ pi 2) kc_txt))
(setq vt (polar dd (/ pi -2) kc_txt))
)
(Make_Text vt "K0+000" chcao)
(while (< param (vlax-curve-getEndParam cObj))
(setq len (vlax-curve-getDistAtParam cObj param)
dg (vlax-curve-getPointAtParam cObj param)
dc (vlax-curve-getPointAtParam cObj (1+ param))
ang (abs (- (angle dg dc) (angle dg dd) ) )
km (fix (/ len 1000))
met (- len (* km 1000)))
(if (< ang pi)
(setq ang (angtos ang 1))
(setq ang (angtos (- (* 2 pi)ang) 1))
)
(if (> (cadr dg)(cadr dc))
(setq vt (polar dg (/ pi 2) kc_txt))
(setq vt (polar dg (/ pi -2) kc_txt))
)
(Make_Text vt (strcat "K" (rtos km 2 0) "+"(rtos met 2 0)) chcao)
(Make_Text (polar vt (/ pi -2) kc_txt) (strcat "S" (rtos param 2 0) "=" ang) chcao)
(setq param (1+ param )
dd dg )
)
)
(princ "\n<< No Polyline Selected >>"))
(mapcar 'setvar vl ov) ; reset Sys Vars
(princ))

(defun Make_Text (pt val h)
(entmake (list (cons 0 "TEXT")
(cons 62 2);color
(cons 10 pt);position
(cons 40 h);height
(cons 1 val)
'(71 . 0)
'(72 . 1)
'(73 . 1)
(cons 11 pt)
)))

  • 1

#2197 xuantran15

xuantran15

    biết lệnh ddedit

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

Đã gửi 22 June 2009 - 03:19 PM

Chào xuantran15
Gửi bạn LISP đã cập nhật theo yêu cầu.

;ATP -> Add Text Pline
(defun c:ATP (/ vl ov cEnt cObj param kc_txt dd dg dc vt ang km met)
(vl-load-com)
(setq vl '("CMDECHO" "OSMODE" "AUPREC") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 3)) ; Set new values

(if (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
(eq "AcDbPolyline"
(vla-get-ObjectName
(setq cObj (vlax-ename->vla-object cEnt)))))
(progn
(if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") )
)
(setq param 1
dd (vlax-curve-getStartPoint cObj)
kc_txt (* 1.5 chcao))
(if (< (cadr dd)(cadr (vlax-curve-getPointAtParam cObj (1+ param))))
(setq vt (polar dd (/ pi 2) kc_txt))
(setq vt (polar dd (/ pi -2) kc_txt))
)
(Make_Text vt "K0+000" chcao)
(while (< param (vlax-curve-getEndParam cObj))
(setq len (vlax-curve-getDistAtParam cObj param)
dg (vlax-curve-getPointAtParam cObj param)
dc (vlax-curve-getPointAtParam cObj (1+ param))
ang (abs (- (angle dg dc) (angle dg dd) ) )
km (fix (/ len 1000))
met (- len (* km 1000)))
(if (< ang pi)
(setq ang (angtos ang 1))
(setq ang (angtos (- (* 2 pi)ang) 1))
)
(if (> (cadr dg)(cadr dc))
(setq vt (polar dg (/ pi 2) kc_txt))
(setq vt (polar dg (/ pi -2) kc_txt))
)
(Make_Text vt (strcat "K" (rtos km 2 0) "+"(rtos met 2 0)) chcao)
(Make_Text (polar vt (/ pi -2) kc_txt) (strcat "S" (rtos param 2 0) "=" ang) chcao)
(setq param (1+ param )
dd dg )
)
)
(princ "\n<< No Polyline Selected >>"))
(mapcar 'setvar vl ov) ; reset Sys Vars
(princ))

(defun Make_Text (pt val h)
(entmake (list (cons 0 "TEXT")
(cons 62 2);color
(cons 10 pt);position
(cons 40 h);height
(cons 1 val)
'(71 . 0)
'(72 . 1)
'(73 . 1)
(cons 11 pt)
)))

Cám ơn bác rất nhiều. :lol2: Chúc bác cùng mọi nguời luôn vui vẻ luôn mát mẻ trong những ngày nóng bức thế này :lol2:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2198 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 22 June 2009 - 04:50 PM

bạn up lên 2 cái lisp đó và nói lại yêu cầu.

Em xin nói lại yêu cầu của em:
- Đoạn lisp 1 của Bác SSG dùng để vẽ bảng Toạ Độ Góc Ranh có lệnh : vc

---Yêu cầu 1: thêm hình tròn có tô hatch tại các đỉnh ( nếu được thì mong Bác có thể cho người dùng nhập đường kính vòng tròn)
---Yêu cầu 2: chuyển lại font chữ giũa kích thước và số TT ( số TT cho font chữ nghiêng và kích thước cho font chữ thẳng và tô đậm)
---Yêu cầu 3: mong Bác có thể cho người dùng được chọn save lại hay không save lại bảng TĐGR ngay tại thư mục đã mở bản vẽ ra bằng file excel từng cột để cần thì có thể phục vụ cho công tác sau này.
Dưới đây là đường link file mẫu:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;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)))
)
;;;-------------------------------------------------------------------------------
(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 (* 8 h))
p3 (polar p2 0 (* 12 h))
p4 (polar p3 0 (* 10 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h)
(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 (* 8 h))
p3 (polar p2 0 (* 12 h))
p4 (polar p3 0 (* 10 h))
p4 (polar p4 (* 0.5 pi) (* 1.5 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h)
(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)
;;;Vertex Co-ordinate

;;;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))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
n (length pvL)
p02 (polar p01 (* 1.5 pi) (* n h 3))
oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0
(list(+ (car p0) (* 4 h)) (cadr p0))
(list(+ (car p0) (* 16 h)) (cadr p0))
(list(+ (car p0) (* 28 h)) (cadr p0))
(list(+ (car p0) (* 38 h)) (cadr p0))
""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(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 (cadr pv) 2 ntp) (rtos (car pv) 2 ntp) S))
(txt2 txtL)
(setq p0 (polar p0 (* 1.5 pi) (* 3 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
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(wtxtMC num (polar pv 0 h) h)
(setq j (1+ j))
)

;;;GHI CANH THUA
(ghicanh et)
(command "erase" et "")

;;;FINISH
(setvar "osmode" oldos)
(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 51 (DTR 18))
(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 51 (DTR 18))
(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;
)
;;;--------------------------


http://www.cadviet.c...files/Mau_2.dwg

- Đoạn lisp 2 em là của Bác Nguyen Hoanh viết dùng để đưa các đối tượng từ bản vẽ 3D về 2D có lệnh: ve0

---Yêu cầu: các đối tượng có chiều cao z thì được dời sang trục x hay y 1 khoảng cách mà người thực hiện nhập số vào
Dưới đây là đường link file mẫu:


;Dung chuyen ban ve 3d thanh 2d
(defun c:ve0 ()
(defun suadinhPl(thongtin / index doituong doituongmoi
toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi
(cons 38 0.)
)
(subst doituongmoi doituong
thongtin)
)
(defun suadinh (thongtin / index doituong
doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong
thongtin
(if (and (>= (car doituong) 10)
(<= (car
doituong) 36)
)
(setq doituongmoi
(list (car
doituong)
(cadr doituong)
(caddr
doituong)
0.0
)
)
(setq doituongmoi
doituong)
)
(setq thongtinmoi (append thongtinmoi (list
doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun
tendoituong (ssdt /)
(cdr (assoc '0 (entget
ssdt)))
)
(setq
tapdoituong (ssget)
sodt (sslength tapdoituong)
index 0
ta
(chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta
ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu
nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong
index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+
index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa
stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or
(= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")

(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt)
"ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt)
"ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt)
"DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong
ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong
ssdt) "ATTRIB")
(= (tendoituong ssdt)
"HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin
(suadinh thongtin)
)
(entmod thongtin)
)
)
(if (=
(tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget
ssdt)
thongtin (suadinhPL thongtin)
)
(entmod
thongtin)
)
)
(princ)
)
)

http://www.cadviet.c...les/Mau_2_2.dwg

Do hôm nay Upload file len cadviet ko được nên nếu bài có dài quá thì mong các Bác thông cảm, do em chưa biết cách cho bài vào box
  • 0

#2199 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 22 June 2009 - 09:49 PM

Em xin nói lại yêu cầu của em:
- Đoạn lisp 1 của Bác SSG dùng để vẽ bảng Toạ Độ Góc Ranh có lệnh : vc

---Yêu cầu 1: thêm hình tròn có tô hatch tại các đỉnh ( nếu được thì mong Bác có thể cho người dùng nhập đường kính vòng tròn)
---Yêu cầu 2: chuyển lại font chữ giũa kích thước và số TT ( số TT cho font chữ nghiêng và kích thước cho font chữ thẳng và tô đậm)
---Yêu cầu 3: mong Bác có thể cho người dùng được chọn save lại hay không save lại bảng TĐGR ngay tại thư mục đã mở bản vẽ ra bằng file excel từng cột để cần thì có thể phục vụ cho công tác sau này.


bạn test thử lệnh vc sửa.

;; 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
)

;;;-------------------------------------------------------------------------------
(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 (* 8 h))
p3 (polar p2 0 (* 12 h))
p4 (polar p3 0 (* 10 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 (* 8 h))
p3 (polar p2 0 (* 12 h))
p4 (polar p3 0 (* 10 h))
;;; p4 (polar p4 (* 0.5 pi) (* 1.5 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)
;;;Vertex Co-ordinate

;;;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 p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(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 (reverse (getvert et))
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 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) (* 16 h)) (cadr p0))
(list (+ (car p0) (* 28 h)) (cadr p0))
(list (+ (car p0) (* 38 h)) (cadr p0))
"")
(setq Lkqua 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 (cadr pv) 2 ntp) (rtos (car 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
(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
(ghicanh et)
(command "erase" et "")

;;;FINISH
(initget 1 "Y N")
(setq save (getkword "Save:"))
(if (= save "Y")
(progn
(setq file (open (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)
)
)
(setvar "osmode" oldos)
(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;
)
;;;--------------------------


  • 2

#2200 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 23 June 2009 - 04:05 PM

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
  • 0