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

[huykhanh_xd 1]

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

 

[gia_bach 1.551]

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

 

 

(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 Tháng 11 17, 2015 theo svba1608
lý do chỉnh sửa: chữ không hiển thị

[huykhanh_xd 1]

Cảm ơn anh gia-bach nhiều ạ. Hình như đoạn lisp này là của anh và anh Hà sửa lại cho hợp yêu cầu của em rồi anh đấy ạ.