Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
Trà Đá

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

Các bài được khuyến nghị

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ẽ

c8784972a061998d1fc254ff9053836a_52410712.1.700x0.jpg

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

27c0343477e36934abb12f250a607942_52410716.2.700x0.jpg

File cad mô tả :

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

 

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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ề,..

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ!

3582aa41af1fd9ef3d9c337448014f65_52433831.1.700x0.jpg

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 ạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ!

3582aa41af1fd9ef3d9c337448014f65_52433831.1.700x0.jpg

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=0entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0entry199638
;; 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¶ng kª täa ®é vµ kho¶ng c¸ch"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
  (* 1.2 h) nil)
 (wtxtMC "HÖ täa ®é 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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×