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

Lisp Dim tự động

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

Bạn chọn trong option

(defun C:DIMTUDONG ( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        dim (getvar 'dimstyle)
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
  (setq opt (mapcar
              '(lambda (a b)
                 (cond
                   ((getdictvar "AD_otions" a))
                   ((setdictvar "AD_otions" a b))
                   )
                 )
              '("Linear" "Arc" "p3")
              '("b0" "c0" "0")
              )
        )
  (initget "Options")
  (if
    (eq (getkword "\nPress enter to continue or [Options]: ") "Options")
    (setq opt (AD_options opt))
    )
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if (= (caddr opt) "1")
		   p2
		   (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 2.5 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 2.5 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 2.5 ht)))
                   )
                 )
		   )
               )
        (if
          (equal rad 0.0 1e-8)
          (vla-adddimaligned space (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
          (vla-adddimarc space (vlax-3d-point pc) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
          )
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)
  )

(defun AD_options (old / a1 a2 b1 b2 dcl dcl_id file r)
  (setq
    a1 (car old)
    a2 (cadr old)
    a3 (caddr old)
    dcl (open (setq file (vl-filename-mktemp "AD" (getvar 'dwgprefix) ".dcl")) "w")
  )
  (write-line
    "AD: dialog { label = \"Tùy ch\U+1ECDn kích th\U+01B0\U+1EDBc Polyline\" ;
    : boxed_radio_column { label = \"Linear dimension position\" ; key = \"a1\";
    : radio_button { label = \"Above line\" ; key = \"b0\";}
    : radio_button { label = \"Below line\" ; key = \"b1\";}}
    : boxed_radio_column { label = \"Arc dimension position\" ; key = \"a2\";
    : radio_button { label = \"Inside arc\" ; key = \"c0\";}
    : radio_button { label = \"Outside arc\" ; key = \"c1\";}
    : radio_button { label = \"As for lines\" ; key = \"c2\";}}
    : toggle{label = \"Dim at objects\";key = \"dap\";}
    ok_cancel ;}"
    dcl)
  (close dcl)
  (if
    (< 0 (setq dcl_id (load_dialog file)))
    (if
      (new_dialog "AD" dcl_id)
      (progn
        (action_tile "a1" "(setq b1 $value)")
        (action_tile "a2" "(setq b2 $value)")
	(action_tile "dap" "(setq b3 $value)")
        (set_tile "a1" (setq b1 a1))
        (set_tile "a2" (setq b2 a2))
	(set_tile "dap" (setq b3 a3))
        (setq r (start_dialog))
        (unload_dialog dcl_id)
        )
      )
    )
  (if (findfile file) (vl-file-delete file))
  (if
    (= r 1)
    (mapcar 'setdictvar 
      '("AD_otions" "AD_otions" "AD_otions")
      '("Linear" "Arc" "p3")
      (list b1 b2 b3)
    )
    (list a1 a2 a3)
  )
)
    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)
  

 

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
Vào lúc 16/9/2022 tại 14:11, tien2005 đã nói:

Bạn chọn trong option


(defun C:DIMTUDONG ( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
        dim (getvar 'dimstyle)
        ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
        )
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nADError: " msg))
      )
    (vla-endundomark acdoc)
    (princ)
    )
  
  (setq opt (mapcar
              '(lambda (a b)
                 (cond
                   ((getdictvar "AD_otions" a))
                   ((setdictvar "AD_otions" a b))
                   )
                 )
              '("Linear" "Arc" "p3")
              '("b0" "c0" "0")
              )
        )
  (initget "Options")
  (if
    (eq (getkword "\nPress enter to continue or [Options]: ") "Options")
    (setq opt (AD_options opt))
    )
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i)))
            o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
            )
      (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
        (setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
              u  (angle p1 p2)
              pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
              sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
              rad (distance '(0 0 0) sd)
              d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
              pc (mapcar (if d '+ '-) pm sd)
              p3 (if (= (caddr opt) "1")
		   p2
		   (if
                   (or (equal rad 0.0 1e-8) (eq (cadr opt) "c2"))
                   (if
                     (eq (car opt) "b0")
                     (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                     (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 2.5 ht))
                     )
                   (if
                     (eq (cadr opt) "c0")
                     (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 2.5 ht) ht))
                     (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 2.5 ht)))
                   )
                 )
		   )
               )
        (if
          (equal rad 0.0 1e-8)
          (vla-adddimaligned space (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
          (vla-adddimarc space (vlax-3d-point pc) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
          )
        (setq a (1+ a))
        )
      )
    )
  (vla-endundomark acdoc)
  (princ)
  )

(defun AD_options (old / a1 a2 b1 b2 dcl dcl_id file r)
  (setq
    a1 (car old)
    a2 (cadr old)
    a3 (caddr old)
    dcl (open (setq file (vl-filename-mktemp "AD" (getvar 'dwgprefix) ".dcl")) "w")
  )
  (write-line
    "AD: dialog { label = \"Tùy ch\U+1ECDn kích th\U+01B0\U+1EDBc Polyline\" ;
    : boxed_radio_column { label = \"Linear dimension position\" ; key = \"a1\";
    : radio_button { label = \"Above line\" ; key = \"b0\";}
    : radio_button { label = \"Below line\" ; key = \"b1\";}}
    : boxed_radio_column { label = \"Arc dimension position\" ; key = \"a2\";
    : radio_button { label = \"Inside arc\" ; key = \"c0\";}
    : radio_button { label = \"Outside arc\" ; key = \"c1\";}
    : radio_button { label = \"As for lines\" ; key = \"c2\";}}
    : toggle{label = \"Dim at objects\";key = \"dap\";}
    ok_cancel ;}"
    dcl)
  (close dcl)
  (if
    (< 0 (setq dcl_id (load_dialog file)))
    (if
      (new_dialog "AD" dcl_id)
      (progn
        (action_tile "a1" "(setq b1 $value)")
        (action_tile "a2" "(setq b2 $value)")
	(action_tile "dap" "(setq b3 $value)")
        (set_tile "a1" (setq b1 a1))
        (set_tile "a2" (setq b2 a2))
	(set_tile "dap" (setq b3 a3))
        (setq r (start_dialog))
        (unload_dialog dcl_id)
        )
      )
    )
  (if (findfile file) (vl-file-delete file))
  (if
    (= r 1)
    (mapcar 'setdictvar 
      '("AD_otions" "AD_otions" "AD_otions")
      '("Linear" "Arc" "p3")
      (list b1 b2 b3)
    )
    (list a1 a2 a3)
  )
)
    
(defun getdictvar (dict var / dict_ename)
  (if
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (cdr (assoc 1 (dictsearch dict_ename var)))
  )
)

(defun setdictvar (dict var val / dict_name record)
  (or
    (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
    (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
    )
  (if
    (setq record (dictsearch dict_ename var))
    (entmod (subst (cons 1 val) (assoc 1 record) record))
    (dictadd
      dict_ename
      var
      (entmakex
        (list
          '(0 . "DICTIONARYVAR")
          '(100 . "DictionaryVariables")
          '(280 . 0)
          (cons 1 val)
        )
      )
    )
  )
  val
)
  

 

 

Vào lúc 16/9/2022 tại 14:27, quangcda đã nói:

 

thử xem bạn!

33.Dim tu dong (DIMTD).LSP

Thiết nghĩ, hai bạn đã suy tầm lisp của Stefan M. (10.11.2015 - KimProjects.com) đó thì cũng nên tôn trọng nêu tên tác giả của lisp một chút.

  • Like 2
  • 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

@thiep lisp này chủ thớt đưa lên nhờ sửa, trong lisp không có ghi nguồn và tác giả thì làm sao tôi biết để mà ghi tên tác giả trong lisp đã sửa

  • Like 3
  • Vote tăng 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

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  

×