Đến nội dung


Hình ảnh
- - - - -

[Nhờ Chỉnh Sửa] Đo khoảng cách hai điểm và ghi kết quả ra nơi minh chọn


  • Please log in to reply
49 replies to this topic

#41 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 November 2014 - 09:11 AM

Nút thank ở dưới bài viết nhoclangbat kìa bạn :)


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#42 trangnhung

trangnhung

    biết vẽ pline

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

Đã gửi 11 November 2014 - 07:18 AM

bác nhoclangbat ơi bác chỉnh giúp em là khi xuất ra bảng kết quả thì phần góc hiện số đo bằng độ đc không ạ: nghĩa là góc về dạng 120 độ, 55'55''. e xin chân thành cảm ơn !
  • 0

#43 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 11 November 2014 - 04:09 PM

- hi bạn thông cảm, sáng giờ bị sếp dí chưa kip sữa cho bạn ^^, giờ mới rãnh xem, bạn xem nhoc sữa vậy vừa ý chưa hì  :P

;===============================================================================================================
(defun K:style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;;
;============================
;;--------------------------------------
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;;;;;;;;;;-------------------------------------------
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
;end;=================================
;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;ham tao text 2
(defun taotext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 (if layer layer (getvar "clayer")))
							  (cons 7 (if textstyle textstyle (getvar 'textstyle)))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  );end mktext
;--------------------------------------
(alert "LSP xuat bang thong ke goc canh , lenh: KKP")
;;----------------------------------------------------------------------------------------------
(defun c:kkp(/ ss ename lst lstcanh lstgoc dem p1 p2 p3 d ang1 ang2 goc kdo dau i k m f j pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 goc270 pt tt ll gg ptt pll pgg old canh kgoc)
  (vl-load-com)
  (setq old (getvar 'osmode))
  (setvar 'osmode 0)
  (if (null (tblsearch "style" "ARIAL-bang")) (K:style "ARIAL-bang" "arial.ttf"))
  (K:layer "bang-goccanh" 4)
  (prompt "chon PLine:")
  (setq ss (ssget "+.:E:S" '((0 . "*POLYLINE"))))
(if ss
(progn
;--------------------------------------------------------------------
  (setq ename (ssname ss 0))
  (setq lst (acet-geom-vertex-list ename))
  (setq lstcanh nil
	     lstgoc nil)
;================================================
  (setq p1 (car lst)
	dem 1)
;===============================================================
  (while (< dem  (length lst))
    (setq p2 (nth dem lst))
    (setq d (distance p1 p2))
    (setq lstcanh (append lstcanh (list d)))
    (setq p1 p2
	  dem (1+ dem))
    (princ)
    )
(setq bdau 1)
(foreach x lst
 (taotext (polar x (/ pi 2) 0.5) 0.8 (itoa bdau) "M" "bang-goccanh" "ARIAL-bang" 1)
 (setq bdau (1+ bdau))
 )
;==================================================================================
  (setq p1 (car lst)
	dem 1)
;===============================================================================
  (while (< dem  (1- (length lst)))
    (setq p2 (nth  dem lst))
    (setq p3 (nth  (1+ dem) lst))
    (setq ang1 (angle p2 p1)
	  ang2 (angle p2 p3))
    (setq goc (abs (- ang1 ang2)))
    (if (> goc PI)
      (setq goc (- (* 2 pi) goc))
      )
;================================================================================
    (setq kdo (* (/ goc pi) 180.0))
    (setq lstgoc (append lstgoc (list kdo)))
;====================================================================================
    (setq p1 p2
	  dem (1+ dem))
   )
;========================================================================================
(setq pt (getpoint "\nChon diem dat bang:"))
(if (/= pt nil)
(progn
(setq pt1 (mapcar '+ pt (list 45.0 0.0 0.0))
      pt2 (mapcar '+ pt (list 0.0 -4.0 0.0))
      pt3 (mapcar '+ pt (list 45.0 -4.0 0.0))
	  pt4 (mapcar '+ pt (list 5.0 0.0 0.0))
	  pt5 (mapcar '+ pt (list 25.0 0.0 0.0)))
;--------------------------------------------------
(taotext (mapcar '+ pt (list 2.5 -2.0 0.0)) 1.8 "TT" "M" "bang-goccanh" "ARIAL-bang" nil)
(taotext (mapcar '+ pt (list 15.0 -2.0 0.0)) 1.8 "L" "M" "bang-goccanh" "ARIAL-bang" nil)
(taotext (mapcar '+ pt (list 35.0 -2.0 0.0)) 1.8 "GOC" "M" "bang-goccanh" "ARIAL-bang" nil)
(makeline pt2 pt3 nil nil nil nil)
;-----------------------------------------------------
(setq i 1)
(while (<= i (length lst))
(progn
;--------------------------
(setq tt (list 2.5 (- (* -5.0 i) 2.0) 0.0))
(setq ptt (mapcar '+ pt tt))
;--------------------------------
;------------------------------
(taotext ptt 1.8 (itoa i) "M" nil nil 4)
(setq i (1+ i))
)
) ; end while
;===============================================
(setq k 0 m 1)
(repeat (- (length lst) 1)
(setq ll (list 15.0 (- (* -5.0 m) 4.5) 0.0))
(setq pll (mapcar '+ pt ll))
(setq canh (nth k lstcanh))
(taotext pll 1.8 (rtos canh 2 3) "M" "bang-goccanh" "ARIAL-bang" nil)
(setq m (1+ m))
(setq k (1+ k))
)
;==============================================
(setq f 0 j 1)
(repeat (- (length lst) 2)
(setq gg (list 35.0 (- (* -5.0 j) 7.0) 0.0))
(setq pgg (mapcar '+ pt gg))
(setq kgoc (nth f lstgoc))
(taotext pgg 1.8 (chuyendo kgoc) "M" "bang-goccanh" "ARIAL-bang" nil)
(setq f (1+ f))
(setq j (1+ j))
)
;----------------------------------------
(setq goc270 (- 0 (/ PI 2)))
(setq pt6 (polar pt goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
      pt7 (polar pt1 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
	  pt8 (polar pt5 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
	  pt9 (polar pt4 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))))
(makeline pt4 pt9 nil nil nil nil)
(makeline pt5 pt8 nil nil nil nil)
(makepline (list pt pt1 pt7 pt6) 1 nil nil nil nil)
;=============================================
) ;end progn if
) ; end if pt
); end progn ss
(alert "ban chua chon Pline nao")
) ;end if ss	  
;========================================================================================
(alert "Xong ^^")
(setvar 'osmode old)
(princ)
); end Kkp
;===================================================================================
;========================chuyen sang do phut giay
(defun chuyendo(so / done kphgiay kphut kgiay xong)
(setq done (fix so))
(setq kphgiay (* (- so done) 60)) ;14,76
(setq kphut (fix kphgiay)) ; 14
(setq kgiay (rtos (* (- kphgiay kphut) 60) 2 0)) ;46"
(setq xong (strcat (itoa done) "%%d" (itoa kphut) "'" kgiay "''"))
)


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#44 namvn007

namvn007

    biết vẽ line

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

Đã gửi 11 November 2014 - 10:24 PM

Tiện đây cho e hỏi e muốn học viết lisp thì phải bắt đầu từ đâu ạ


  • 0

#45 nhantony

nhantony

    biết vẽ line

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

Đã gửi 19 November 2014 - 08:19 AM

(defun C:TL3( / ss L te p1 p2)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
	(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
 
 
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)

Nhờ các bác sửa lệnh này tính theo khoảng cách dùm mình được không :)


  • 0

#46 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 19 November 2014 - 08:38 AM

Không khoảng cách thì là gì kia bạn ?
(setq L (distance p1 p2))


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#47 nhantony

nhantony

    biết vẽ line

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

Đã gửi 19 November 2014 - 03:13 PM

Không khoảng cách thì là gì kia bạn ?
(setq L (distance p1 p2))

Chết mình viết thiếu :) Tính khoảng cách theo tỉ lệ bản vẽ =D


  • 0

#48 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 19 November 2014 - 05:38 PM

-tỉ lệ của bạn quy định thế nào nhỉ như bên nhoc vd line đo l=5 thì in ra đúng 5 với tl 1/1000 nếu line đo đc phóng lên 5 lần tương đuong tile = 1/200 đo thực tế đc 25 nhưng in ra text vẫn là 5 ^^
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#49 nhantony

nhantony

    biết vẽ line

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

Đã gửi 20 November 2014 - 02:27 PM

-tỉ lệ của bạn quy định thế nào nhỉ như bên nhoc vd line đo l=5 thì in ra đúng 5 với tl 1/1000 nếu line đo đc phóng lên 5 lần tương đuong tile = 1/200 đo thực tế đc 25 nhưng in ra text vẫn là 5 ^^

Ví dụ như bản vẽ mình tỉ lệ ngang 1/500 khi sử dụng lisp này nó sẽ tính theo tỉ lệ 1/500 và xuất ra kết quả. Còn với lisp trên là tính theo tỉ lệ 1:1 


  • 1

#50 bqtuanks

bqtuanks

    biết zoom

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

Đã gửi 10 October 2015 - 06:42 PM

 

(defun C:TL3( / ss L te p1 p2)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
	(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
 
 
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
Bác cho em hỏi giờ em muốn đo theo phương X thì sửa lệnh như thế nào ạ 

 

  • 0