[LISP程序]：对齐标注转线性标注

xiagood

大家好!
最近做了一个“对齐标注转线性标注”的小程序和大家分享一下。
通常对齐标注夹点编辑时很不方便。线型标注却很好用。
希望对大家的工作有一些小小的帮助。谢谢！
;;;  ==================****************===========================
;;;    CHVDim.LSP                             
;;;    Write by : xiagood            
;;;    Email:xiatian3639@sina.com
==========================================================

;;;---------------------对齐标注转线性标注------------------------
(Defun ErrorCHVDim(msg)
    (command "._UNDO" "E")
    (prin1)
)

(Defun C:CHVDim(/ AcadObject AcadDocument mSpace DimSS  L M DimGet DimEle DimLay Dimcon DimStyle pt10 pt13 pt14)
   (vl-load-com)
   (setq *error* ErrorCHVDim)
   (setvar "cmdecho" 0)   
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
         mSpace (vla-get-ModelSpace AcadDocument))
   (setq DimSS (ssget '((0 . "DIMENSION")
                        (100 . "AcDbAlignedDimension"))))
   (if (= DimSS nil)
       (progn
          (princ "\n没有对齐标注被选上!")
          (exit)
        )
    )
    (command "._UNDO" "BE")
  
    (setq L (sslength DimSS))
    (setq M 0)
    (while (< M L)
        (setq DimGet (ssname DimSS M))
        (setq DimEle (entget DimGet))
        (if (=  (vl-position (cons 100 "AcDbRotatedDimension") DimEle) nil)
            (progn
               ;;;获取图层、颜色
               (setq DimLay  (cdr (assoc 8  DimEle)))
             
               (setq pt10 (cdr (assoc 10 DimEle)))
               (setq pt13 (cdr (assoc 13 DimEle)))
               (setq pt14 (cdr (assoc 14 DimEle)))
               (setq Dimcon   (cdr (assoc 1 DimEle)))
               (setq DimStyle (cdr (assoc 3 DimEle)))
                            
               (GnHdg_AddDimAlign pt13 pt14 pt10 Dimcon DimStyle)

               (command "._CHANGE" (entlast) "" "P" "LA" DimLay "")
               (command "._ERASE" DimGet "")
             )
         )
         (Setq M (+ M 1))
     )

     (command "._UNDO" "E")
     (prin1)
)


;;;建立线性标注
(defun GnHdg_AddDimAlign (GnHdg_Pt1 GnHdg_Pt2 GnHdg_Pt3 GnHdg_DimCon GnHdg_DimStyle / Ent)
  (if (setq ent        (entmake (list '(0 . "DIMENSION")
                               '(100 . "AcDbEntity")
                               '(100 . "AcDbDimension")
                               (cons 10 GnHdg_Pt3)
                               '(11 0. 0. 0.)
                               '(70 . 32)
                               (cons 1 GnHdg_DimCon)
                               (cons 3 GnHdg_DimStyle)
                               '(100 . "AcDbAlignedDimension")
                               (cons 13 GnHdg_Pt1)
                               (cons 14 GnHdg_Pt2)
                               (cons 50 (angle GnHdg_Pt1 GnHdg_Pt2))
                               '(100 . "AcDbRotatedDimension")
                         )
                )
      )
    ent
  )
)

sony2000

能否做个演示看来

xiagood

详附件。

tanle2020

楼主，我用dimscale、dimlfac改变标注的特性对齐标注然后用你的程序一刷会改回到原来的特性，能不能改一下。

xiantan

厉害呀

xiagood

一般的不会发生太大的改变。除标注文字的插入点有可能会不同。

2443725

谢谢，这个东东不错~

甲子元

很多工具都集成勒

lmt112233

問題存在很久，謝謝樓主把問題解決。