Đến nội dung


Hình ảnh
* * * * * 1 Bình chọn

[Giúp đỡ] Viết lisp đánh số thứ tự đỉnh,khoảng cách và diện tích


  • Please log in to reply
8 replies to this topic

#1 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 08 January 2013 - 04:12 PM

Em chào diễn đàn CadViet
Hiện tại em đang làm tại 1 đơn vị khảo sát. Trong quá trình làm việc muốn tối ưu hóa thời gian nên nhờ các bác giúp đỡ em viết lisp cho 2 bài toán sau ạ:

Bài toán 1:
Giả sử em có 1 lô đất khép kín 13 cạnh như hình vẽ . Mong các anh giúp em viết 1 lisp khi kích vào các đỉnh lô đất sẽ hiện số thứ tự và khoảng cách giữa các đỉnh và nghiêng theo cạnh ở giữa như hình vẽ
Hình đã gửi
Bài toán 2:
Vẫn là lô đất đó, giả sử có một dự án đi qua (đường đỏ). Mong các anh giúp em viết 1 lisp tính tổng diện tích , diện tích thu hồi , diện tích còn lại. Đại loại lisp chạy theo trình tự sau:
+ Chọn lô đất
+ Chọn đường dự án
+ Diện tích thu hồi ở bên trái hay bên phải đường dự án [T/P]?
Kết quả thu được là sẽ tạo 3 dòng như hình vẽ

- Tổng diện tích khu đất

- Diện tích thu hồi

- Diện tích


Nếu xuất ra bảng dạng table thì tốt quá ạ (cái này là em có voi đòi Hai Bà Trưng ạ)
Hình đã gửi

File cad mô tả : http://www.cadviet.c...baitoan1va2.dwg

Em xin chân thành cảm ơn ạ!


  • 1

#2 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 08 January 2013 - 04:38 PM

cái này hay ah, nếu đc nhoc xin đc xài ké :D
Theo mình chỗ diện tích thu hồi, còn lại nên nói thế này thì dể hơn cho mấy anh.
pick giữa tâm khu đất nó sẽ chạy hết như bạn yêu cầu, xong sẽ hỏi chọn điểm đặt text tổng diện tích, xong bước 1 sẽ có thêm lựa chọn, bạn có mún tính tiếp ko [y/n], nếu chọn [n] kết thúc lsp. Nếu chọn [y] lsp sẽ hỏi thêm pick phần diện tích thu hồi, xong lại chọn điểm đặt text, hỏi pick tip diện tích còn lại, pick xong lại như trên, nếu ko có enter kết thúc lệnh. Hơi dài dòng nhưng mình nghĩ như vậy sẽ linh động hơn trong cách bố trí và chọn lựa phần diện tích nào đc thu hồi hay còn lại. :D
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#3 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 09 January 2013 - 08:10 AM

cái này hay ah, nếu đc nhoc xin đc xài ké :D
Theo mình chỗ diện tích thu hồi, còn lại nên nói thế này thì dể hơn cho mấy anh.
pick giữa tâm khu đất nó sẽ chạy hết như bạn yêu cầu, xong sẽ hỏi chọn điểm đặt text tổng diện tích, xong bước 1 sẽ có thêm lựa chọn, bạn có mún tính tiếp ko [y/n], nếu chọn [n] kết thúc lsp. Nếu chọn [y] lsp sẽ hỏi thêm pick phần diện tích thu hồi, xong lại chọn điểm đặt text, hỏi pick tip diện tích còn lại, pick xong lại như trên, nếu ko có enter kết thúc lệnh. Hơi dài dòng nhưng mình nghĩ như vậy sẽ linh động hơn trong cách bố trí và chọn lựa phần diện tích nào đc thu hồi hay còn lại. :D

Làm sao tối ưu hóa thời gian là được bác ạ!
Mong các bác giúp đỡ em ạ.
  • 0

#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 09 January 2013 - 11:22 AM

Làm sao tối ưu hóa thời gian là được bác ạ!
Mong các bác giúp đỡ em ạ.

Hề hề hề,
1/- Các lisp dạng này trên diễn đàn đã có rồi, kể cả việc thống kê diện tích. Hãy chịu khó tìm kiếm về dùng thử rồi hãy post những điều chưa như ý lên, mọi người sẽ giúp bạn bổ sung phần chưa đạt. Như vậy có lẽ sẽ tốt hơn cho bạn và nhanh có kết quả hơn. Không ai muốn làm lại những điều đã có sẵn cả.
2/- Khi yêu cầu nên có cả bản vẽ trước và sau khi chạy lisp để người viết lisp biết rõ và test kiểm tra lisp, đồng thời so sánh với yêu cầu đặt ra. Tránh kiểu làm chỉ post ảnh yêu cầu còn bắt người viết lisp phải tự đoán mò. hoặc chỉ đưa file yêu cầu mà không rõ đầu vào và đầu ra của lisp ra sao.
3/- Có thể quá trình tìm kiếm cho ra các kết quả hoàn toàn không như ý các bạn nhưng ít nhất cũng có chỗ được và chưa được. Các bạn cần hiểu một chút về nó để có thể phân tích và đặt yêu cầu sửa chữa cho phù hợp. Cũng có thể có 2 hay nhiều kết quả cho các yêu cầu của các bạn đặt ra thì hãy chọn cái gần với yêu cầu của các bạn nhất để sửa sẽ nhanh hơn vì chỉ có các bạn mới biết chính xác mình cần gì.
Hề hề hề,..
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 09 January 2013 - 01:45 PM

Hề hề hề,
1/- Các lisp dạng này trên diễn đàn đã có rồi, kể cả việc thống kê diện tích. Hãy chịu khó tìm kiếm về dùng thử rồi hãy post những điều chưa như ý lên, mọi người sẽ giúp bạn bổ sung phần chưa đạt. Như vậy có lẽ sẽ tốt hơn cho bạn và nhanh có kết quả hơn. Không ai muốn làm lại những điều đã có sẵn cả.
2/- Khi yêu cầu nên có cả bản vẽ trước và sau khi chạy lisp để người viết lisp biết rõ và test kiểm tra lisp, đồng thời so sánh với yêu cầu đặt ra. Tránh kiểu làm chỉ post ảnh yêu cầu còn bắt người viết lisp phải tự đoán mò. hoặc chỉ đưa file yêu cầu mà không rõ đầu vào và đầu ra của lisp ra sao.
3/- Có thể quá trình tìm kiếm cho ra các kết quả hoàn toàn không như ý các bạn nhưng ít nhất cũng có chỗ được và chưa được. Các bạn cần hiểu một chút về nó để có thể phân tích và đặt yêu cầu sửa chữa cho phù hợp. Cũng có thể có 2 hay nhiều kết quả cho các yêu cầu của các bạn đặt ra thì hãy chọn cái gần với yêu cầu của các bạn nhất để sửa sẽ nhanh hơn vì chỉ có các bạn mới biết chính xác mình cần gì.
Hề hề hề,..

Thân bác phamthanhbinh,
Đúng là em có chút sơ suất khi đã không giải thích cụ thể. Lô đất của em ban đầu như thế này ạ!
Hình đã gửi
Em đã có xem một vài lisp về thống kê đỉnh nhưng đều không đạt yêu cầu. Em thấy có mỗi 1 lisp đánh số thứ tự bằng tay như thế này thôi ạ.

(defun c:stt (/ oldPref oldSuf oldStart curStr newNum
actDoc actSp oldEcho oldSize *error*)
(defun *error* (msg)
(setvar "CMDECHO" oldEcho)
(princ)
); end *error*

(vl-load-com)
(if(not num:Size)(setq num:Size(getvar "DIMTXT")))
(if(not num:Pref)(setq num:Pref ""))
(if(not num:Suf)(setq num:Suf ""))
(if(not num:Num)(setq num:Num 1))
(setq oldPref num:Pref
oldSuf num:Suf
oldStart num:Num
oldSize num:Size
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
oldEcho(getvar "CMDECHO")
); end setq
(setvar "CMDECHO" 0)
(if(=(vla-get-ActiveSpace actDoc)1)
(setq actSp(vla-get-ModelSpace actDoc))
(setq actSp(vla-get-PaperSpace actDoc))
); end if
(setq num:Size
(getreal
(strcat "\nText size <"(rtos num:Size)">: ")))
(if(null num:Size)(setq num:Size oldSize))
(setq num:Pref
(getstring T
(strcat "\nPrefix: <"num:Pref">: ")))
(if(= "" num:Pref)(setq num:Pref oldPref))
(if(= " " num:Pref)(setq num:Pref ""))
(setq num:Suf
(getstring T
(strcat "\nSuffix: <"num:Suf">: ")))
(if(= "" num:Suf)(setq num:Suf oldSuf))
(if(= " " num:Suf)(setq num:Suf ""))
(setq num:Num
(getint
(strcat "\nStarting number <"(itoa num:Num)">: ")))
(if(null num:Num)(setq num:Num oldStart))
(princ "\n<<< Insert numbers or press Esc to quit >>> ")
(while T
(setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
newNum(vla-AddText actSp
curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size))
(vla-put-Alignment newNum acAlignmentMiddleCenter)
(command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq num:Num(1+ num:Num))
); end while
(princ)
); end of c:stt
(princ "\n***Lenh STT.*** ")
Mong bác giúp em bổ sung thêm yêu cầu về chiều dài và diện tích ạ.
Em cảm ơn bác ạ!
  • 0

#6 ro88

ro88

    biết vẽ arc

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

Đã gửi 09 January 2013 - 05:59 PM

Thân bác phamthanhbinh,
Đúng là em có chút sơ suất khi đã không giải thích cụ thể. Lô đất của em ban đầu như thế này ạ!
Hình đã gửi
Em đã có xem một vài lisp về thống kê đỉnh nhưng đều không đạt yêu cầu. Em thấy có mỗi 1 lisp đánh số thứ tự bằng tay như thế này thôi ạ.


(defun c:stt (/ oldPref oldSuf oldStart curStr newNum
actDoc actSp oldEcho oldSize *error*)
(defun *error* (msg)
(setvar "CMDECHO" oldEcho)
(princ)
); end *error*

(vl-load-com)
(if(not num:Size)(setq num:Size(getvar "DIMTXT")))
(if(not num:Pref)(setq num:Pref ""))
(if(not num:Suf)(setq num:Suf ""))
(if(not num:Num)(setq num:Num 1))
(setq oldPref num:Pref
oldSuf num:Suf
oldStart num:Num
oldSize num:Size
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
oldEcho(getvar "CMDECHO")
); end setq
(setvar "CMDECHO" 0)
(if(=(vla-get-ActiveSpace actDoc)1)
(setq actSp(vla-get-ModelSpace actDoc))
(setq actSp(vla-get-PaperSpace actDoc))
); end if
(setq num:Size
(getreal
(strcat "\nText size <"(rtos num:Size)">: ")))
(if(null num:Size)(setq num:Size oldSize))
(setq num:Pref
(getstring T
(strcat "\nPrefix: <"num:Pref">: ")))
(if(= "" num:Pref)(setq num:Pref oldPref))
(if(= " " num:Pref)(setq num:Pref ""))
(setq num:Suf
(getstring T
(strcat "\nSuffix: <"num:Suf">: ")))
(if(= "" num:Suf)(setq num:Suf oldSuf))
(if(= " " num:Suf)(setq num:Suf ""))
(setq num:Num
(getint
(strcat "\nStarting number <"(itoa num:Num)">: ")))
(if(null num:Num)(setq num:Num oldStart))
(princ "\n<<< Insert numbers or press Esc to quit >>> ")
(while T
(setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
newNum(vla-AddText actSp
curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size))
(vla-put-Alignment newNum acAlignmentMiddleCenter)
(command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq num:Num(1+ num:Num))
); end while
(princ)
); end of c:stt
(princ "\n***Lenh STT.*** ")
Mong bác giúp em bổ sung thêm yêu cầu về chiều dài và diện tích ạ.
Em cảm ơn bác ạ!



bạn dùng thử cái này xem sao

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=213751&st=0&#entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0&#entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; 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 - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)
;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------
;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:TD (/ h p et p0 p00 p01 p02 pt pvL pvL1 n j pv num txtL ss bn ntp p11 p12 p13 p14)
(setvar "cmdecho" 0)
;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")
;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))
;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))
;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))
;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = M1): " )
)
;(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(initget "T t N n")
(setq chieu (getkword "\nLua chon chieu ghi toa do < T/N >"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 "")
(setq Lkqua nil)
(command "style" "CadViet" ".VnArialH" "" "" "" "" "")
(wtxtMC "B&#182;ng k&#170; t&#228;a &#174;&#233; v&#181; kho&#182;ng c&#184;ch"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
(* 1.2 h) nil)
(wtxtMC "H&#214; t&#228;a &#174;&#233; VN - 2000"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "Y (m)" "X (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
;;;MAKE RECORDS
(if (or (= chieu "N") (= chieu "n")) (setq pvL (reverse pvL)) )
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p11 (polar p0 (* 1.5 pi) (* 2.5 h)))
(setq P12 (polar p11 0 (* 25 h)))
(setq P13 (polar p11 0 (* 31 h)))
(setq P14 (polar p11 0 (* 32 h)))
(command "LINE" p11 p12 "")
(command "LINE" p13 p14 "")
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)
(command "LINE" p11 p14 "")
(linepy p00 (- (distance p00 (polar p0 (* 1.5 pi) (* 0.5 h)) )))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "HATCH" "solid" "L" "")
(command "erase" vtron "")
(setq j (1+ j))
)
;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)
;;;FINISH
(savef)
(setvar "osmode" oldos)
;(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
;;; )
(setvar "cmdecho" 1)
(princ)
)
;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)
;;;PHAN BO SUNG
;;;------------------------------------------------------------------------------------
(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 2)
(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 2)
(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 (/ i k p1 p2 dist rad x_mp y_mp mp mp1)
(setq
i 0
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 mp1 (polar mp (angle p mp) (* 2 h)) )
(command "DIMALIGNED" p1 p2 mp1)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------


cái này mình tìm trên diễn đàn và có nhờ Thiep sửa lại đôi chút bạn xem có được ko
  • 1

#7 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 09 January 2013 - 06:16 PM

cái này mình tìm trên diễn đàn và có nhờ Thiep sửa lại đôi chút bạn xem có được ko

Dạ em dùng thử rồi nhưng không đúng ý em ạ...Tạo điểm M1 mà cứ có mũi tên gì làm mất đỉnh thế ạ? Em cần là cần tên điểm và chiều dài cạnh thể hiện trên lô đất đó.
Cảm ơn bác rất nhiều.
Mong các Mod giúp em ạ!
  • 0

#8 Trà Đá

Trà Đá

    biết vẽ line

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

Đã gửi 10 January 2013 - 11:06 AM

@phamthanhbinh : Mong bác giúp em ạ!
  • 0

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 10 January 2013 - 12:43 PM

@phamthanhbinh : Mong bác giúp em ạ!

Muốn bỏ mũi tên bạn hãy thử làm một trong các cách như sau:
1/- Vào dimention style chọn lại kiểu đặt mũi tên cho phù hợp ý bạn.
2/- Thay dòng code : (command "DIMALIGNED" p1 p2 mp1) bằng dòng code :
(Text_canh_BCA (rtos dist 2 2) mp1 rad)
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.