Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
huykhanh_xd

Nhờ Chỉnh Để Lisp Ghi Kích Thước Kiểu Dimlinear Thay Vì Dimaligned

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

http://www.upsieutoc.com/image/Wmx2
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69127-giup-minh-lisp-dim-chia-doan-thang/

;Chia Dim doan thang (03/03/2013).
(defun C:DFF (/ i pts act end line pt1 pt2 ss sta n cd x)
(defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
 (defun list->3pair (old / new)
 (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
 (setq i -1)
 (while (setq e (ssname ss (setq i (1+ i))))
 (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
  (setq lst_pt (append (list->3pair pts) lst_pt))))
 (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
(vl-load-com)
(setq cd (getreal "\nPanel Module (900 or 1000): "))
(if
 (and
 (setq pt1 (getpoint "\nStart point: "))
 (setq pt2 (getpoint pt1 "\nEnd point: "))
 (setq pt3 (getpoint "\nDim line location: ")))
 (progn
 (setq ssc (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))<span></span>
 (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
 (repeat (1+ n)
  (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pxt (polar px (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar px (- (angle pt1 pt2) (* 0.5 pi)) 100))
  (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
<span></span>(setq ss1 (ssadd (entlast) ss1))
<span></span>(setq x (1+ x)))
 (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
  (progn
  (setq pxt (polar pt2 (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar pt2 (- (angle pt1 pt2) (* 0.5 pi)) 100))
  (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
<span></span> (setq ss1 (ssadd (entlast) ss1))))
 (setq ssm (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))<span></span>
 (defun TRUSS (ssm ssc / i) (repeat (setq i (sslength ssc)) (ssdel (ssname ssc (setq i (1- i))) ssm)))
 (setq ss (TRUSS ssm ssc))
 (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
    line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
 (setq pts (Get_pts_ss_inter_obj ss line))
 (if (> (vl-list-length pts) 1)
  (progn
  (setq sta (car pts) i 1)
  (repeat (- (vl-list-length pts)1)
   (setq end (nth i pts) i (1+ i))
   (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
   (setq sta end))))
 (vla-delete line)))
(command "erase" ss1 "")
(princ))


Em có một đoạn lisp do anh "Dao Van Ha" gửi trên diễn đàn như sau. Nó chia đoạn thẳng thành các đoạn với kích thước cho trước nhập vào, phần dư còn lại được ghi đúng kích thước của nó. Mỗi tội kích thước mà lisp ghi ra là dạng DIMALIGNED nên khi chỉnh sửa phải kéo đúng 90 độ thì kích thước mới chạy được còn không là nó xoay theo đường kéo. Các anh chỉnh giùm em sao cho lisp nó ghi kích thước theo kiểu DIMLINEAR được không ạ?

 

  • Vote giảm 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
Thay dòng :
(vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))

bằng dòng :        

(vla-AddDimRotated act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3) (angle pt1 pt2))

Các phát sinh khác (nếu có) liên hệ chính chủ nhé.

 

gia_bach_zpsva3egrrn.png

 

(ghi chú: vì chữ không hiển thị, nên em đăng ảnh lên tạm. em đã copy lại chữ và gửi lại vào tin nhắn cho anh gia_bach. Em svba1608)

Chỉnh sửa theo svba1608
lý do chỉnh sửa: chữ không hiển thị

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  

×