(defun c:test (/ CEN DICTIONARY DIMASSOC DIMENSION LWPOLY P1 P2 P3 X1)
;;************************************************************************************************************************
;; Программа написана и протестирована в AutoCAD 2015
;;
;;В программе создается тестовая полилиния и проставляются на ней радиальные размеры.
;;
;;************************************************************************************************************************
(defun eea-test-regapp (/ flag)
;;************************************************************************************************************************
;; Подпрограмма проверяет загрузку надстройки "ACAD_DSTYLE_DIMRADIAL_EXTENSION"
;;************************************************************************************************************************
(vlax-for a (vla-get-RegisteredApplications (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (= "ACAD_DSTYLE_DIMRADIAL_EXTENSION" (vla-get-name a))
(setq flag t)
)
)
flag
)
(defun eea-add-dictionary (lst a)
;;************************************************************************************************************************
;; Подпрограмма добавляет дополнительные поля - словари в DXF объектов
;; программа не универсальная и вставляет список сразу после метки (HANDEL) объекта.
;;************************************************************************************************************************
(entmod (append (reverse (member (assoc 5 lst) (reverse lst))) a (cdr (member (assoc 5 lst) lst))))
)
(if (eea-test-regapp)
(progn (defun eea-add-dictionary (lst a)
(entmod (append (reverse (member (assoc 5 lst) (reverse lst))) a (cdr (member (assoc 5 lst) lst))))
)
;;************************************************************************************************************************
;; создаем полилинию, как в примере задания.
;;************************************************************************************************************************
(setq LWPOLY (entmakex '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(90 . 9) ; количество вершин
(70 . 1) ; замкнутая
(10 20.0 20.0) ; первая вершина
(10 80.0 20.0) ; вторая вершина
(42 . 0.414214) ; кривизна второго сегмента
(10 100.0 40.0)
(10 100.0 60.0)
(42 . -1.0)
(10 100.0 100.0)
(10 100.0 120.0)
(42 . 0.414214)
(10 80.0 140.0)
(10 60.0 140.0)
(42 . -0.5)
(10 20.0 100.0)
)
)
)
(foreach par '(1.6 3.5 5.5 7.5) ;(setq par 1.6)
;;************************************************************************************************************************
;; par - в этой переменной будет храниться параметр точки на полилинии, через которую необходимо провести размер.
;; параметры по умолчанию начинаются с нуля и каждое целое число обозначает вершин полилинии.
;; например 0,5 обозначает середину первого сегмента.
;; 0,25 - четверть длины первого сегмента вдоль него.
;;************************************************************************************************************************
(setq p1 (vlax-curve-getPointAtParam LWPOLY (fix par)) ;начало указанного сегмента
p2 (vlax-curve-getPointAtParam LWPOLY par) ;точка на которую указывает PAR
p3 (vlax-curve-getPointAtParam
LWPOLY
(if (= (1+ (fix par)) (vlax-curve-getEndParam LWPOLY)) ; конец сегмента.
;; если полилиния замкнутая то используется нулевой параметр.
;; код не предусматривает незамкнутые полилинии.
0
(1+ (fix par))
)
) ; точка в конце сегмента
cen (polar p3
(+ (angle p3 p2) (setq x1 (- (angle p1 p3) (angle p1 p2))) (* pi -0.5))
(/ (distance p2 p3) (sin x1) 2.)
)
;; центр дуги сегмента. Математику можно посмотреть по ссылке:
;; http://elpanov.com/index.php?id=35
)
;;************************************************************************************************************************
;; создаем объект размер
;;************************************************************************************************************************
(setq DIMENSION (entmakex (list '(0 . "DIMENSION") ; размер
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "0")
'(100 . "AcDbDimension")
'(280 . 0)
(cons 10 cen) ; центр
(cons 11 p2) ; точка на дуговом сегменте
'(12 0.0 0.0 0.0)
'(70 . 36)
'(1 . "")
'(71 . 5)
'(72 . 1)
'(41 . 1.0)
'(42 . 20.0)
'(73 . 0)
'(74 . 0)
'(75 . 0)
'(52 . 0.0)
'(53 . 0.0)
'(54 . 0.0)
'(51 . 0.0)
'(210 0.0 0.0 1.0)
'(3 . "ISO-25")
'(100 . "AcDbRadialDimension")
'(13 0.0 0.0 0.0)
'(14 0.0 0.0 0.0)
(cons 15 p2) ; точка на дуговом сегменте
'(16 0.0 0.0 0.0)
'(40 . 0.0)
'(50 . 0.0)
(list -3
'("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 288) (1070 . 1) (1002 . "}"))
(list "ACAD_DSTYLE_DIMRADIAL_EXTENSION"
'(1070 . 387)
'(1070 . 1)
'(1070 . 388)
(cons 1040 (angle cen p1))
'(1070 . 390)
(cons 1040 (angle cen p3))
)
)
)
)
)
;;************************************************************************************************************************
;; создаем реактор на изменение размера после изменения полилинии
;;************************************************************************************************************************
(setq DIMASSOC (entmakex (list '(0 . "DIMASSOC") ; реактор
'(100 . "AcDbDimAssoc")
(cons 330 DIMENSION) ; размер
'(90 . 2)
'(70 . 0)
'(71 . 0)
'(1 . "AcDbOsnapPointRef")
'(72 . 3)
(cons 331 LWPOLY) ; полилиния
'(73 . 2)
(cons 91 (1+ (fix par))) ; номер сегмента
'(40 . 0.0)
'(10 0.0 0.0 0.0)
'(75 . 0)
)
)
)
;;************************************************************************************************************************
;; создаем словарь, где хранятся все ассоциативные связи
;;************************************************************************************************************************
(setq DICTIONARY
(entmakex (list '(0 . "DICTIONARY") ; словарь
(cons 330 DIMENSION) ; размер
'(100 . "AcDbDictionary")
'(280 . 1)
'(281 . 1)
'(3 . "ACAD_DIMASSOC")
(cons 360 DIMASSOC) ; реактор
)
)
)
;;************************************************************************************************************************
;; Во время создания объектов мы не записали в них все связи, поскольку невозможно записать в связь объект до его создания.
;; Теперь прописываем во все объекты все связи.
;;************************************************************************************************************************
;;
;; Изменяем реактор и прописываем в него словарь
;;
;;************************************************************************************************************************
(entmod (subst (cons 330 DICTIONARY) (assoc 330 (entget (HANDENT "1"))) (entget DIMASSOC)))
(eea-add-dictionary
(entget DIMASSOC)
(list '(102 . "{ACAD_REACTORS") (cons 330 DICTIONARY) '(102 . "}"))
)
;;************************************************************************************************************************
;; изменяем размер, прописываем в него словарь
;;************************************************************************************************************************
(eea-add-dictionary
(entget DIMENSION)
(list '(102 . "{ACAD_XDICTIONARY")
(cons 360 DICTIONARY)
'(102 . "}")
'(102 . "{ACAD_REACTORS")
(cons 330 DIMASSOC)
'(102 . "}")
)
)
;;************************************************************************************************************************
;; изменяем саму полилинию
;;************************************************************************************************************************
(eea-add-dictionary
(entget LWPOLY)
(list '(102 . "{ACAD_XDICTIONARY")
(cons 360 DICTIONARY)
'(102 . "}")
'(102 . "{ACAD_REACTORS")
(cons 330 DIMASSOC)
'(102 . "}")
)
)
;;************************************************************************************************************************
;; обновляем полилинию и размер
;;************************************************************************************************************************
(entupd LWPOLY)
(entupd DIMENSION)
(princ)
)
)
(alert
"\nПеред работой программы создайте хотя бы один радиальный размер,\n для подгрузки необходимых библиотек в AutoCAD.\nЭтот размер далее не нужен."
)
)
)
