Đến nội dung


Hình ảnh
- - - - -

Lisp ghi chiều dài đoạn thẳng theo Scale factor của Dimstyle hiện thời


  • Please log in to reply
26 replies to this topic

#21 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 10 March 2011 - 08:24 AM

đã edit. cảm ơn ketxu đã test hộ tớ
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#22 843824

843824

    biết vẽ circle

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

Đã gửi 10 March 2011 - 11:24 PM

Ô - thanks các pro trước hé .

Giờ e chưa về tới nhà nên chưa test đc - Nhưng mà chắc ok rồi đây . Hà hà.
  • 0

#23 trieubb

trieubb

    biết vẽ ellipse

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

Đã gửi 16 September 2013 - 02:46 PM

Chào bạn Thaistreetz,
Bạn dùng thử cái này nha:

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(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)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

Đoạn lisp này mình chỉnh sửa lại từ cái lisp của bác SSG và bác Tue_nv do mình nghĩ có thể bác Tue_NV hiểu nhầm ý bạn. Bạn muốn lấy các độ dài của từng đoạn chứ không phải lấy tổng độ dài, vả lại bạn cũng muốn kết quả ghi theo tỷ lệ của dimstyle hiện tại chứ không phải là kết quả đo được nữa. Ở lisp này mình cũng để bạn chọn phương án nhap kết quả , nhưng bạn lưu ý là khi lisp hỏi bạn chỉ cần gõ 1 hoặc enter là đủ bạn nhé. Bạn xài thử xem nhé. Nếu có gì trục trặc xin báo lại vì mình cũng chưa kiểm nghiệm nó do chưa có thời gian bạn ạ. Thực ra mình cũng chưa ưng ý với lisp này do nếu như bạn chọn khá nhiều đối tượng thì việc nhớ được trật tự khi lựa chọn đối tượng không hề dễ. Theo ý mình thì nên mỗi lần chỉ chọn một đối tượng và sau khi chạy xong thi lisp sẽ hỏi bạn có muốn tiếp tục hay không, nếu có thì chọn đối tượng tiếp, còn nếu không thì kết thúc sẽ thuận lợi cho việc chỉnh sửa trên bản vẽ của bạn hơn.
Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.
Chúc bạn vui.

@ Bác Tue_NV: Mạn phép bác sửa lại chút xíu cái lisp của bác cho gần với yêu cầu của bạn Thaistreetz hơn. Mong bác không giận.

Bác viết thêm là thể hiện thứ tự các đoạn cần điền chiều dài (theo thứ tự mà lisp nhận được) chứ không biết đâu mà ghi chiều dài được bác ạ. Mong bác giúp đỡ


  • 0

#24 unbroken

unbroken

    biết vẽ arc

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

Đã gửi 20 September 2013 - 05:25 PM

Bác tue viết lisp đó gần hợp với cái mà em cần. ai đó có thể sửa 1 chút đi giúp em được không. em muốn text hiển thị nằng trên đoạn thẳng được pick bởi 2 điểm.Với tỷ lệ chiểu cao text như dimension hiện tại.( còn nếu giá trị của text mà được như tỷ lệ scale của dim hiện tại thì càng tốt)!!
  • 0

Giaminh19@gmail.com


#25 thienthantk103

thienthantk103

    Chưa sử dụng CAD

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

Đã gửi 26 November 2013 - 10:40 AM

Đây là đoạn Lisp của bác ssg, mình có chỉnh lại một chút cho phù hợp với yêu cầu thứ nhất của bạn.
Riêng yêu cầu 2 trong bản vẽ bạn ghi : thực hiện lệnh, chọn đối tuong cần đo và nếu không
chọn text để gán kết quả thì Enter và pick 1 điểm trên màn hình để xuất kết quả bằng số theo style text hiện thời.
Kết quả bằng số là kết quả gì vậy bạn ? bạn hãy nói rõ.

;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)


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

Cái lisp này có thể thêm phần đổi màu chữ của text được chọn không ạ.

Xin cảm ơn


  • 0

#26 hieuhx68

hieuhx68

    biết vẽ circle

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

Đã gửi 11 March 2015 - 07:52 PM

 Các bác giúp em bổ sung thêm tính năng đo nhanh tất cả các đường line hay PLine có đường gióng như mình đo bình thường được ko ạ. nó sẽ là lệnh tắt của cách đo D1, D3. Mình gõ lệnh đo rồi quét tất cả các đường đó, nó sẽ cho kết quả với kiểu đo của dim hiện tại. Em chân thành cảm ơn


  • 0

#27 chauthituyet

chauthituyet

    Chưa sử dụng CAD

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

Đã gửi 13 April 2016 - 01:15 AM

topic của mình đây mà. cũng là bài viết thứ 2 trên cadviet của mình. hồi đó đuợc bác PhamThanhBinh viết cho cái lisp này mừng cả 1 ngày.
Mình sửa lại 1 chút lisp của bác Bình cho fù hợp với nhu cầu của bạn đây.

(defun C:TL( / Length1 SSdelete MakePoint GET-M2P MakeText
HT I K LST LST1 LSTL LSTP OSMLAST OTHLAST PT PT0 PT1 SS SSMOVE SSNX SSP TBSS)
(vl-load-com)
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= 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)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst))
(defun SSdelete (SS / )	(setq SS (acet-ss-to-list SS))(foreach SSN SS (entdel SSN)))
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun GET-M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end
(defun MakePoint (point layer color)
(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbPoint")(cons 10 point))))
(setq lst '() lst1 '() lstL '() k (getvar "dimlfac") ssmove (ssadd))
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))) i 0)
(repeat (sslength ss)
(if (= 1 (car (setq ssnx (car(ssnamex ss i)))))
(if lst1(progn
(setq ssp (ssadd))
(foreach ssn lst1	(setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))
(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)
(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(< (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(> (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))) ;;; cot
(setq lst (append (list (cadr ssnx)) lst1) lst1 '()))
(setq lst (append (list (cadr ssnx)) lst)))
(setq lst1 (append (list (cadr ssnx)) lst1)))
(setq i (1+ i)))
(if lst1 (progn
(setq ssp (ssadd))
(foreach ssn lst1	(setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))
(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)
(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(> (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(< (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))))) ;;; cot
(if (setq lst(append lst1 lst)) (progn
(setq ht (getreal "nhap chieu cao text: ") pt (cadr (grread 't 15 0)) pt0 pt i 0)	
(foreach ll (reverse lst)
(setq ssmove (ssadd (maketext pt (itoa(setq i (1+ i))) ht 0 "C" nil nil nil nil) ssmove)
ssmove (ssadd (maketext (polar pt 0 (* 5 ht)) (rtos (* k(length1 ll)) 2 3) ht 0 "R" nil nil nil nil) ssmove)
pt (list (car pt) (- (cadr pt) (* 1.5 ht)))))
(acet-ss-redraw ssmove 2)
(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
(if (setq pt1 (acet-ss-drag-move ssmove pt0 "\nChon diem dat bang"))
(progn (vl-cmdf "move" ssmove "" pt0 pt1) (setvar "orthomode" OTHLAST))
(ssdelete ssmove))))
(print "free lisp from cadviet.com") (princ))
Bạn chú ý:
- sau khi gõ lệnh bạn có thể chon theo cả 2 cách như bạn yêu cầu. nghĩa là bạn có thể chọn kiểu như thế này: ...chọn 1 tập hợp -> rồi pick...pick -> rồi lại chọn tập hợp -> rồi lại pick pick...rồi...rồi...
- Chương trình sẽ tự nhận diện tập hợp đối tượng của bạn, nhóm đối tượng nào chọn trước, nhóm đối tượng nào chọn sau, các phần tử trong 1 tập hợp là hàng hay là cột để tự sắp xếp theo X hoặc Y.
- mình ngại kẻ bảng nên kết quả nhìn hơi xấu. thôi, cái này bạn tự làm đê.
@Ketxu: ai lại dich tên tớ thế dry.gif. dịch là Thái bụi cậu ạ laugh.gif

 

ai giúp kẻ bảng cho lisp này không ạ, thêm phần tính tổng nửa được không? em cảm ơn các bác nhiều


  • 0