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

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

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

Theo ý bạn đây :

 (defun C:TL3( / ss L te p1 p2 textmau P)(while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) (setq p2 (getpoint p1 "\n Chon diem thu hai :")))(setq L (distance p1 p2))(initget "T")(setq p (getpoint "\nPick diem chen hoac go T de chon Text :")) (if (/= p "T")  (progn     (if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))    (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau))   (cons 10 p) (cons 11 p) (assoc 7 (entget textmau))     ))  )  (progn  (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)  ))))

Nếu như có thể thêm vào tỉ lệ cho bản vẽ thì tốt anh Tue_NV ơi.

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

Theo ý bạn đây :


Theo ý bạn đây :


Mới trả lời xong cho bạn ở chủ đề bên kia rồi. Lần sau nhớ search trước khi post bài nhé

Em mới sử dụng Cad, loát lisp của bác về và App rồi nhưng khi gõ lệnh lại không được bác ah

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

 

- 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 "''"))
)

BẠN CÓ THỂ BỔ SUNG VẺ GÓC CẠNH TRÊN SƠ ĐỒ LƯỚI THÌ TUYỆT LUÔN

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


×