Chuyển đến nội dung
Diễn đàn CADViet

huykhanh_xd

Thành viên
  • Số lượng nội dung

    6
  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi 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 ạ?

     

    • Vote giảm 1

  2. có một cách thật đơn giản nhưng về mặt thẩm mĩ thì nó không được gọi là ổn lắm.Các bạn vào format/text style../width factor ->ở đây không để là 1.0000 nữa mà hãy rửa lại là 1.0001 chẳng hạn,miễn là nó không phải là tròn 1.0000 là ok.

    nhưng nếu để cho vào word để in thì làm như thế này cũng ổn thôi không có gì là xấu cả.

×