[wpww]

Добрый день. Написал ЛИСП. Суть в следующем:
1) выбираем полилинию
2) поверх полилинии создается временная полилиния, далее она размечается блоком с интервалом 60
3) на начальнйо точке полилинии ставится блок
4) удаляется временная полилиния
5) так происходит со всеми участками полилинии.
Ниже приведен текст лиспа:

Код:

[Выделить все]

 (defun c:plz ( / )
  (setq oldpline (car (entsel))) 
  (setq pline (entget oldpline))
  (setq pline (member (assoc 10 pline) pline))
  (setq x1 (car pline)) 
  (setq pline (cdr pline))
  (while (assoc 10 pline) 
    (setq pline (member (assoc 10 pline) pline))
    (setq x2 (car pline)) 
    (setq ygol (* (angle (cdr x1) (cdr x2)) (/ 180 pi)))
    (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 2) x1 x2))
    (setq xyz (entlast))
    (command "_-insert" "bk" (cdr x1) "" "1" ygol) 
    (command "_.measure" xyz "á" "BK" "ä" "60")
    (entdel xyz) 
    (setq x1 x2) 
    (setq pline (cdr pline)) 
  )
)

Помогите разобраться в следующих моментах:
1) как это реализовать с применением ActiveX. у меня получилось выдернуть координаты вершин полилинии,

(setq pline (vla-get-coordinates (vlax-ename->vla-object (car (entsel)))))

но они записывались ввиде варианта, а как с ним работать дальше я не понял.

2) как вставлять блок с атрибутам? в свойствах атребуты нигде не прописаны. в DXF коде их тоже нет.

[wpww]

и снова добрый день.
Я решил вопрос с тем, как расставить камеры, с тем как сделать их нумерацию и привязать ее к камерам.... но встал другой вопрос.
в данный момент я имею код вида:

(defun begin_activex ( / ) ) (defun rasstanovka ( / ) ) (defun numeration ( / ) ) (defun c:cctv ( / ) (begin_activex) (rasstanovka) (numeration) )

Но программа не работает так как я хочу. Я хочу чтобы при запуске программы сначала запускался блок по расстановке видеокамер, потом производилась нумерация...
при структуре программы выше у меня производится расстановка камер и все. но если заменить строку
(rasstanovka)
закомментировать, то камеры без проблем про нумеруются. В чем проблема?

[ProPeller]

Сообщение от wpww и снова добрый день. Я решил вопрос с тем, как расставить камеры, с тем как сделать их нумерацию и привязать ее к камерам.... но встал другой вопрос. в данный момент я имею код вида: Но программа не работает так как я хочу. Я хочу чтобы при запуске программы сначала запускался блок по расстановке видеокамер, потом производилась нумерация... при структуре программы выше у меня производится расстановка камер и все. но если заменить строку (rasstanovka) закомментировать, то камеры без проблем про нумеруются. В чем проблема?

Ну по всей видимости в конце цикла "rasstanovka" у вас вылетает ошибка и дальше дело не идет. Включите в меню "отладка"->"прервать на ошибке" и смотрите где у вас ошибка. Ctrl+F9 выделит вам ошибку.

[gomer]

Сообщение от wpww (begin_activex)

Уж не ты ли тот горе-писака, который обманул одного моего клиента?

[wpww]

Сообщение от gomer Уж не ты ли тот горе-писака, который обманул одного моего клиента?

нет, это был кто-то другой. за деньги я не пишу. пока )))

Сообщение от ProPeller Ну по всей видимости в конце цикла "rasstanovka" у вас вылетает ошибка и дальше дело не идет. Включите в меню "отладка"->"прервать на ошибке" и смотрите где у вас ошибка. Ctrl+F9 выделит вам ошибку.

именно в этом была проблема. спасибо за совет

----- добавлено через ~5 ч. -----
Внимание, новый вопрос:
как работает выравнивание в ActiveX?
мне нужно чтобы текст был выделен по центру, за это отвечает свойство alignment
я имею код такого вида:

Код:

[Выделить все]

 (defun numeration ( / )
  (setq nabor (ssget "_X" '((2 . "ASG")))) 
  (setq dlina_nabora (sslength nabor)) 
  (setq i 0)
  (repeat dlina_nabora
    (setq object_block (ssname nabor i)) 
    (setq block (vlax-ename->vla-object object_block)) 
    (setq nomer (vlax-lData-get block "nomer")) 
    (setq coordinata_block (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint block)))) 
    (setq coordinata_nomer (list (nth 0 coordinata_block) (+ (nth 1 coordinata_block) 5.7) (nth 2 coordinata_block))) 
    (vla-AddText model_space (strcat "ASG" (itoa nomer)) (vlax-3D-point coordinata_nomer) 2.5)
    (vla-put-alignment text acAlignmentCenter)
    (setq i (1+ i))
  )
)

на русском языке описание использования этого свойства я не нашел.
на зарубежном форуме было написано, что выравнивание связано со свойством textAlignmentPoint, но я не понял каким образом. По факты, судя по свойсвам моих текстов, значение TextAlignmentPoint становится равным значению InsertionPoint, а InsertionPoint на новое.
Вопрос, как мне сделать выравнивание текста по центру?

----- добавлено через ~5 ч. -----

Сообщение от wpww нет, это был кто-то другой. за деньги я не пишу. пока ))) именно в этом была проблема. спасибо за совет ----- добавлено через ~5 ч. ----- Внимание, новый вопрос: как работает выравнивание в ActiveX? мне нужно чтобы текст был выделен по центру, за это отвечает свойство alignment я имею код такого вида: Код: [Выделить все] (defun numeration ( / ) (setq nabor (ssget "_X" '((2 . "ASG")))) (setq dlina_nabora (sslength nabor)) (setq i 0) (repeat dlina_nabora (setq object_block (ssname nabor i)) (setq block (vlax-ename->vla-object object_block)) (setq nomer (vlax-lData-get block "nomer")) (setq coordinata_block (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint block)))) (setq coordinata_nomer (list (nth 0 coordinata_block) (+ (nth 1 coordinata_block) 5.7) (nth 2 coordinata_block))) (vla-AddText model_space (strcat "ASG" (itoa nomer)) (vlax-3D-point coordinata_nomer) 2.5) (vla-put-alignment text acAlignmentCenter) (setq i (1+ i)) ) ) на русском языке описание использования этого свойства я не нашел. на зарубежном форуме было написано, что выравнивание связано со свойством textAlignmentPoint, но я не понял каким образом. По факты, судя по свойсвам моих текстов, значение TextAlignmentPoint становится равным значению InsertionPoint, а InsertionPoint на новое. Вопрос, как мне сделать выравнивание текста по центру?

проблема выравнивания у меня была связана с тем, что я сначала указывал точку выравнивания, а потом тип выравнивания, а надо было наоборот, т.к. свойство TextAlignmentPoint имеет параметр read only при выравниванию по левому краю, и по факту корректировать это свойство можно только после корректировки самого типа выравнивания, а не наоборот!

[Vladimir_Sergeevich]

Что то я ничего не понимаю. В 12-ой строке есть (vla-put-alignment text acAlignmentCenter), но нигде не вижу (setq text...)
Работая с activeX надо указатель на объект запомнить, если есть желание его потом подредактировать. Например в 11 строке (setq text (vla-AddText...))

[wpww]

Сообщение от Vladimir_Sergeevich Что то я ничего не понимаю. В 12-ой строке есть (vla-put-alignment text acAlignmentCenter), но нигде не вижу (setq text...) Работая с activeX надо указатель на объект запомнить, если есть желание его потом подредактировать. Например в 11 строке (setq text (vla-AddText...))

Да, это у меня есть в тексте, почему то криво скопировал, когда сюда переносил...
вопрос. а как при помощи ActiveX создать новый слой? пока есть идея как это сделать через (entmake ...)

[Кулик Алексей aka kpblc]

(vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "LayerName")
Только потом его надо будет настраивать: http://autolisp.ru/2014/03/05/base-s...rs-anf-styles/

[VVA]

Сообщение от wpww а как при помощи ActiveX создать новый слой?

Сообщение от Кулик Алексей aka kpblc Только потом его надо будет настраивать

Есть же готовые функции
_kpblc-layer-create (например здесь )
или
_dwgru-layer-create (например здесь)

[wpww]

Сообщение от VVA Есть же готовые функции _kpblc-layer-create (например здесь ) или _dwgru-layer-create (например здесь)

просто хочется чтобы все было в ActiveX.

в данный момент имею такой код

Код:

[Выделить все]

 
(defun GetTrueColor (r g b / )
  (+ (lsh r 16) (lsh g 8) b)
)

(defun NewLayer (name r g b line_weight line_type / ) 
  (setq layer (vla-add (vla-get-layers active_document) name)) 
  (vla-put-TrueColor layer (GetTrueColor r g b)) 
  (vla-put-LineWeight layer line_weight)
  (vla-put-LineType layer line_type)
)

GetTrueColor пересчитывает RGB в TrueColor
Но чтобы применить его на слой, необходимо чтобы значение vla-put-TrueColor было в виде vla объекта.
Как это сделать? уже всю голову сломал.

[VVA]

Сообщение от wpww просто хочется чтобы все было в ActiveX.

Ну так там все как раз таки активХ
А у тебя как раз таки и нет. GetTrueColor нужна для создания entmake'ом

Сообщение от wpww Но чтобы применить его на слой, необходимо чтобы значение vla-put-TrueColor было в виде vla объекта.

Код:

[Выделить все]

(setq active_document (vla-get-activedocument (vlax-get-acad-object)))  

(defun NewLayer (name r g b line_weight line_type / TrueColor ) 
  (setq layer (vla-add (vla-get-layers active_document) name))
  (setq TrueColor (vla-get-truecolor layer))
  (vla-setrgb TrueColor r g b)
  (vl-catch-all-apply (function vla-put-Truecolor) (list layer TrueColor))
  (vla-put-LineWeight layer line_weight)
  (vla-put-LineType layer line_type)
)
;;;Use
;;; (NewLayer "TestLayer" 213 20 136 50 "Continuous")

Тип линии, отличный от "Continuous" должнен быть загружен

[wpww]

Сообщение от VVA Ну так там все как раз таки активХ А у тебя как раз таки и нет. GetTrueColor нужна для создания entmake'ом Код: [Выделить все] (setq active_document (vla-get-activedocument (vlax-get-acad-object))) (defun NewLayer (name r g b line_weight line_type / TrueColor ) (setq layer (vla-add (vla-get-layers active_document) name)) (setq TrueColor (vla-get-truecolor layer)) (vla-setrgb TrueColor r g b) (vl-catch-all-apply (function vla-put-Truecolor) (list layer TrueColor)) (vla-put-LineWeight layer line_weight) (vla-put-LineType layer line_type) ) ;;;Use ;;; (NewLayer "TestLayer" 213 20 136 50 "Continuous") Тип линии, отличный от "Continuous" должнен быть загружен

отлично, спасибо!
единственное что, я заменил строчку

Код:

[Выделить все]

 (vl-catch-all-apply (function vla-put-Truecolor) (list layer TrueColor))

на

Код:

[Выделить все]

 (vla-put-TrueColor layer TrueColor)

для меня так понятней смысл написанного

[ProPeller]

Сообщение от wpww отлично, спасибо! единственное что, я заменил строчку Код: [Выделить все] (vl-catch-all-apply (function vla-put-Truecolor) (list layer TrueColor)) на Код: [Выделить все] (vla-put-TrueColor layer TrueColor) для меня так понятней смысл написанного

потом опять начнете говорить, что где-то не работает, а где не знаю.