dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,952
Отправить сообщение для Red Nova с помощью Skype™

Red Nova вне форума Вставить имя

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.


Код:
[Выделить все]
(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .
__________________
Блог

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1226412
 
Непрочитано 28.07.2017, 23:05
#3381
gnuvse


 
Регистрация: 13.04.2017
Сообщений: 3


Спасибо большое за помощь.

Пожалуйста, если вас не затруднит, где я могу прочитать об этих vla функциях подробно?

Скажите, правильно ли я понимаю, если я буду использовать vla-get-любое_название_из_свойств, то я получу эти данные?

Цитата:
Сообщение от skkkk Посмотреть сообщение
skkkk
gnuvse вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 21.08.2017, 17:23
#3382
AMDen

Инженер-проектировщик
 
Регистрация: 07.07.2016
Санкт-Петербург
Сообщений: 154


Здравствуйте!
В лиспе практически не разбираюсь.
По примерам и наитию смог сделать простенький код (не судите строго).
Код:
[Выделить все]
(defun c:RBV_IE ( / )
(command "._draworder" (ssget "_x" '((0 . "DIMENSION"))) "" "_f")
(command "._draworder" (ssget "_x" '((0 . "INSERT")(8 . "Блоки"))) "" "_f")
(command "._draworder" (ssget "_x" '((0 . "*LEADER"))) "" "_f")
(princ))
В общем, код работает как надо. Но если в чертеже нет мультивыноски, все делает как надо, но пишет "Неизвестная команда".
Специалисты, помогите пожалуйста сделать адекватную программу.
AMDen вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 21.08.2017, 17:35
#3383
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,552
Отправить сообщение для gomer с помощью ICQ Отправить сообщение для gomer с помощью Skype™


Код:
[Выделить все]
 ((lambda (ss) (if ss (command "._draworder" ss "" "_f"))) (ssget "_x" '((0 . "DIMENSION"))))
gomer вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 22.08.2017, 10:16
#3384
AMDen

Инженер-проектировщик
 
Регистрация: 07.07.2016
Санкт-Петербург
Сообщений: 154


gomer, Большое Спасибо! Так действительно лучше.
AMDen вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 10:02
#3385
Maksim7enov


 
Регистрация: 25.05.2016
Сообщений: 31


Здравствуйте! Сначала самое главное, я еще полный чайник в ЛИСПе))
Не так давно начал заниматься ЛИСПом и прошу Вашей помощи. Решил начать с малого, а именно построения трубы по уклону с заданным масштабом для помощи мне строить продольный профиль сетей водоснабжения и водоотведения.
В принципе работает, но накосячил с отключением привязки (для повторения использовал while, после того как завершаю выполнение программы привязка не возвращается. Понимаю почему но не могу понять как можно вернуть старую привязку old_value).
Так же решил, чтобы не вводить в ручную выбор 1-ой отметки применить выбор текста в котором эта отметка пишется на профиле. Тут проблема в том, что есть вариант того что можно просто промахнуться при выборе текста. Пытался воспользоваться if, но не получается. Думаю надо написать условие: если промахнулся то вводи в ручную. Пробовал но выдает ошибку.
Проблема с текстом тоже бывает всплывает. В другом файле текст вставляет не отметку которую я рассчитал а 90 т.е угол на который я хочу поворачивать.

Код:
[Выделить все]
(Defun C:Profil ()
    (prompt "\nРасcчитаем и построим трубу по уклону ")
(setq old_value (getvar 'osmode))
  		(setvar 'osmode 32)
(setq otm_V (getdist "\nВводи отметку вычита: <32> " ))
    		(if (= otm_V nil) (setq otm_V 32))				;при применении надо менять на ту которая по факту
  (while
(setq otm_Z (atof (cdr (assoc 1 (entget (car (entsel "\nВыбирай отметку : "))))))) ;выбираем текст с отметкой, чтобы не вводить в ручную
(setq p1 (getpoint " \nВводи расстояния между участками: ")) 		           ;выбираем расстояние участка трубопровода проложенного по 1 уклону
(setq p3 (getpoint ""))
 		(setq rasst (DISTANCE p1 p3 ))					   ;Узнаем расстояние участка
(setq uklon (getdist "\nВведи уклон трубы: " ))					   ;вводим уклон
(setq rasch1 (* (/ (- otm_Z otm_V) 2) 10))
  	(setvar 'osmode 0)
(setq p2 (mapcar '+ p1 (list 0 rasch1)))
(setq rasch2 (- otm_Z (* uklon rasst)))
(setq rasch3 (* (/ (- rasch2 otm_V) 2) 10))
(setq p4 (mapcar '+ p3 (list 0 rasch3)))
	(command "_line" p2 p4 "")
		(setvar 'osmode old_value)
(setq p4 (mapcar '- p1 (list 0 3.75)))
(setq p5 (mapcar '- p3 (list 0 3.75)))

 	(command "_text" "В" "НЦ"  p5 '1.25 '90 (rtos (+ (/ (* rasch3 2) 10) otm_V) 2 2) "")
 )
)

Последний раз редактировалось Maksim7enov, 25.08.2017 в 10:27.
Maksim7enov вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 10:29
1 | #3386
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 34,813


Цитата:
Сообщение от Maksim7enov Посмотреть сообщение
В другом файле текст вставляет не отметку которую я рассчитал а 90 т.е угол на который я хочу поворачивать.
Значит в это файле другие настройки текущего текстового стиля.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 10:46
#3387
Maksim7enov


 
Регистрация: 25.05.2016
Сообщений: 31


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Значит в это файле другие настройки текущего текстового стиля.
У меня есть динамический блок для профилей, в нем текст сделаю со стилем который будет работать нормально с лиспом. Зашел в файл вставил свой блок и выбрал стиль свой.
Все бьюсь с условием если промахнулся мимо выбора текста в данными о первой отметке. пробовал сделать так :
(if (= otm_Z nil) (getdist "\nВводи отметку вручную " ))
В итоге ошибка: неверный тип аргумента: lentityp nil
Maksim7enov вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 10:52
1 | #3388
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 34,813


Если промахнулся, то entsel возвращает nil. (car nil) -> nil. А entget nil - ошибка.
Пройдись пошагово (http://autolisp.ru/2009/09/10/vlide-misc-01/ + http://autolisp.ru/2009/09/12/vlide-misc-02/)
И твой код с минимальными исправлениями - только отлов "промаха выбора".
Код:
[Выделить все]
 (defun c:profil (/ old_value otm_v otm_z p1 p2 p3 p4 p5 rasch1 rasch2 rasch3 rasst uklon)
  (prompt "\nРасcчитаем и построим трубу по уклону ")
  (setq old_value (getvar 'osmode))
  (setvar 'osmode 32)
  (setq otm_v (getdist "\nВводи отметку вычита: <32> "))
  (if (= otm_v nil)
    (setq otm_v 32)
    ) ;_ end of if
  ;; при применении надо менять на ту которая по факту
  (while (and (setq otm_z (car (entsel "\nВыбирай отметку : ")))
              (setq otm_z (atof (cdr (assoc 1 (entget otm_z)))))
              ) ;_ end of and
    ;; выбираем текст с отметкой, чтобы не вводить в ручную
    (setq p1 (getpoint " \nВводи расстояния между участками: "))
    ;; выбираем расстояние участка трубопровода проложенного по 1 уклону
    (setq p3 (getpoint ""))
    (setq rasst (distance p1 p3))
    ;; Узнаем расстояние участка
    (setq uklon (getdist "\nВведи уклон трубы: "))
    ;; вводим уклон
    (setq rasch1 (* (/ (- otm_z otm_v) 2) 10))
    (setvar 'osmode 0)
    (setq p2 (mapcar '+ p1 (list 0 rasch1)))
    (setq rasch2 (- otm_z (* uklon rasst)))
    (setq rasch3 (* (/ (- rasch2 otm_v) 2) 10))
    (setq p4 (mapcar '+ p3 (list 0 rasch3)))
    (command "_line" p2 p4 "")
    (setvar 'osmode old_value)
    (setq p4 (mapcar '- p1 (list 0 3.75)))
    (setq p5 (mapcar '- p3 (list 0 3.75)))
    (command "_text" "В" "НЦ" p5 '1.25 '90 (rtos (+ (/ (* rasch3 2) 10) otm_v) 2 2) "")
    ) ;_ end of while
  ) ;_ end of Defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 10:58
#3389
Maksim7enov


 
Регистрация: 25.05.2016
Сообщений: 31


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Спасибо! Сейчас начну изучать. Я так понял у меня и по оформлению 2)))

----- добавлено через ~2 ч. -----
Очень полезные ссылки. По оформлению понял [Ctrl]+[Shift]+[f] помогает.
Про промах при выборе делаю вывод, что на данном этапе изучения промах=расстрелу)
Так же хотелось бы узнать, может кто-то готов потратить свои силы и время на еще одного чайника?)))
Maksim7enov вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 12:51
#3390
Inferi


 
Регистрация: 14.05.2015
Сообщений: 30


День добрый, помогите решить проблему:
1) применяю mapcar для извлечения из списка мультивыносок свойство "TextString" >
2) для некоторых из них вылетает ошибка: Ошибка Automation. Отсутствует описание. в связи с этим все крешится
3) дамп выноски выдающей ошибку:
; IAcadMLeader: Интерфейс мультивыносок AutoCAD
; Значения свойств:
; Application (RO) = #<VLA-OBJECT IAcadApplication 000000013f803318>
; ArrowheadBlock = "_Open"
; ArrowheadSize = 300.0
; ArrowheadType = 6
; BlockConnectionType = 0
; BlockScale = 1.0
; ContentBlockName = ""
; ContentBlockType = 6
; ContentType = 0
; Document (RO) = #<VLA-OBJECT IAcadDocument 00000000291e89d8>
; DogLegged = -1
; DoglegLength = 0.0
; EntityTransparency = "ПоСлою"
; Handle (RO) = "9205A"
; HasExtensionDictionary (RO) = 0
; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 00000000433cba98>
; LandingGap = 2.0
; Layer = "АР лестница"
; LeaderCount (RO) = 1
; LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 00000000433cbd90>
; LeaderLinetype = "ByBlock"
; LeaderLineWeight = -2
; LeaderType = 1
; Linetype = "ByLayer"
; LinetypeScale = 50.0
; Lineweight = -1
; Material = "ByLayer"
; ObjectID (RO) = 95928
; ObjectID32 (RO) = 95928
; ObjectName (RO) = "AcDbMLeader"
; OwnerID (RO) = 116635
; OwnerID32 (RO) = 116635
; PlotStyleName = "ByLayer"
; ScaleFactor = 1.0
; StyleName = "Копия(4) Standard"
; TextAttachmentDirection = 0
; TextBackgroundFill = Ошибка
; TextBottomAttachmentType = 0
; TextDirection = Ошибка
; TextFrameDisplay = 0
; TextHeight = 4.0
; TextJustify = Ошибка
; TextLeftAttachmentType = 1
; TextLineSpacingDistance = Ошибка
; TextLineSpacingFactor = Ошибка
; TextLineSpacingStyle = Ошибка
; TextRightAttachmentType = 3
; TextRotation = Ошибка
; TextString = Ошибка
; TextStyleName = Ошибка
; TextTopAttachmentType = 0
; TextWidth = Ошибка
; TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000000433cbbb0>
; Visible = -1
4) какого типа функции стоит применить для решения проблемы?
Inferi вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2017, 13:33
#3391
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 34,813


У тебя на выноске - блок. См.свойство ContentType
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.09.2017, 19:38
#3392
100k

Tekla.Structures.Model.Beam
 
Регистрация: 31.01.2010
Сообщений: 1,783


https://openedu.ru/course/ITMOUniversity/FPBC/
Функциональное программирование: базовый курс
В курсе изучаются основы функционального подхода к программированию и практические вопросы программирования на языке Lisp. Функциональные языки обладают множеством интересных особенностей, знакомство с которыми расширяет кругозор программиста. Курс содержит видеолекции, опросы и практические задания по программированию. Материал курса рассчитан на 10 недель обучения.
100k вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.09.2017, 22:15
#3393
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 3,876


только это Common Lisp, а не AutoLisp - насколько понимаю.
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.09.2017, 22:17
#3394
Maksim7enov


 
Регистрация: 25.05.2016
Сообщений: 31


Цитата:
Сообщение от 100k Посмотреть сообщение
https://openedu.ru/course/ITMOUniversity/FPBC/
Функциональное программирование: базовый курс
В курсе изучаются основы функционального подхода к программированию и практические вопросы программирования на языке Lisp. Функциональные языки обладают множеством интересных особенностей, знакомство с которыми расширяет кругозор программиста. Курс содержит видеолекции, опросы и практические задания по программированию. Материал курса рассчитан на 10 недель обучения.
Цена вопроса не указана
Maksim7enov вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.09.2017, 22:20
#3395
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 3,876


Maksim7enov,
Цитата:
Все курсы, размещенные на Платформе, доступны бесплатно и без формальных требований к базовому уровню образования
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.09.2017, 22:36
#3396
Maksim7enov


 
Регистрация: 25.05.2016
Сообщений: 31


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Maksim7enov,
Ну тогда я говорю спасибо!
Maksim7enov вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.09.2017, 18:03
#3397
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Offtop: "Не учите меня жить, помогите материально! ©"

Товарищи знатоки, есть такая хорошая программка, "меняющая" выбранные примитивы на выбранный пользователем (код ниже), работает беспроблемно автокада что ль с 2000 у меня.. А нельзя ли ея модернизировать так, что бы у вставляемых примитивов назначалась координата Z, взятая из заменяемого примитива? Хотя бы только для блоков?

Код:
[Выделить все]
 ;Программа меняет набор примитивов на выбранный примитив.
;Примеры применения:

;Замена одних блоков другими.
;Замена точек блоками или окружностями.
;Замена одних надписей другими.


;Сначала надо выбрать заменяемые объекты и нажать Enter, затем указать заменяющий объект. ;Вставка производится в центр ограничевающего (габаритного) прямоугольника старых объектов. ;Новые объекты вставляются в слои которые к которым пренадлежали старые объекты. ;Поддерживается предварительный выбор.



(defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
       EXTSET FROMCEN LAYCOL MAXPT CURLAY
       MINPT OBJLAY OKCOUNT OLAYST
       SCLAY TOCEN TOOBJ VLAOBJ *ERROR*)

  (vl-load-com)

  (defun *ERROR*(msg)
    (if olaySt
      (vla-put-Lock objLay olaySt)
      ); end if
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of *ERROR*


  (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
      (setq blPt(vlax-safearray->list minPt)
      trPt(vlax-safearray->list maxPt)
      cnPt(vlax-3D-point
      (list
            (+(car blPt)(/(-(car trPt)(car blPt))2))
            (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
         0.0
            ); end list
     ); end vlax-3D-point
    ); end setq
  ); end of GetBoundingCenter

  (if(not(setq extSet(ssget "_I")))
    (progn
      (princ "\n+++ Выберите заменяемые объекты <- ")
      (setq extSet(ssget))
      ); end progn
    ); end if
  (if(not extSet)
    (princ "\nDistination objects isn't selected!")
    ); end if
  (if
    (and
    extSet
    (setq toObj(entsel "\n+++ Выберите заменяющий объект -> "))
    ); and and
    (progn
      (setq actDoc
       (vla-get-ActiveDocument
         (vlax-get-Acad-object))
      layCol
       (vla-get-Layers actDoc)
      extLst
       (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex extSet))))
      vlaObj(vlax-ename->vla-object(car toObj))
      objLay(vla-Item layCol
          (vla-get-Layer vlaObj))
      olaySt(vla-get-Lock objLay)
      fromCen(GetBoundingCenter vlaObj)
      errCount 0
      okCount 0
      ); end setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
  (setq toCen(GetBoundingCenter obj)
        scLay(vla-Item layCol
           (vla-get-Layer obj))
           );end setq
  (if(/= :vlax-true(vla-get-Lock scLay))
    (progn
    (setq curLay(vla-get-Layer obj))
    (vla-put-Lock objLay :vlax-false)
    (setq copObj(vla-copy vlaObj))
    (vla-Move copObj fromCen toCen)
    (vla-put-Layer copObj curLay)
    (vla-put-Lock objLay olaySt)
    (vla-Delete obj)
    (setq okCount(1+ okCount))
    ); end progn
    (setq errCount(1+ errCount))
    ); end if
  ); end foreach
      (princ
  (strcat "\n" (itoa okCount) " were changed. "
    (if(/= 0 errCount)
      (strcat (itoa errCount) " were on locked layer! ")
      ""
      ); end if
    ); end strcat
  ); end princ
      (vla-EndUndoMark actDoc)
      ); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
  (princ)
  ); end of c:frto
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 29.09.2017, 08:49
1 | #3398
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 34,813


Код:
[Выделить все]
 ;|
*    Программа меняет набор примитивов на выбранный примитив.
*    Примеры применения:
   - Замена одних блоков другими.
   - Замена точек блоками или окружностями.
   - Замена одних надписей другими.
   
*    Сначала надо выбрать заменяемые объекты и нажать Enter, затем указать заменяющий объект.
* Вставка производится в центр ограничевающего (габаритного) прямоугольника старых объектов.
* Новые объекты вставляются в слои которые к которым пренадлежали старые объекты.
* Поддерживается предварительный выбор.
|;

(defun c:frto (/ actdoc copobj errcount extlst extset fromcen laycol maxpt curlay minpt objlay okcount olayst sclay tocen toobj vlaobj *error*)
  (vl-load-com)
  (defun *error* (msg)
    (if olayst
      (vla-put-lock objlay olayst)
      )   ; end if
    (vla-endundomark actdoc)
    (princ)
    )     ; end of *ERROR*
  (defun getboundingcenter (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (setq minpt (vlax-safearray->list minpt)
          maxpt (vlax-safearray->list maxpt)
          ) ;_ end of setq
    (mapcar '(lambda (a b) (* 0.5 (+ a b))) minpt maxpt)
    ) ;_ end of defun
  (if (not (setq extset (ssget "_I")))
    (progn (princ "\n+++ Выберите заменяемые объекты <- ") (setq extset (ssget)))
    )     ; end if
  (if (not extset)
    (princ "\nDistination objects isn't selected!")
    )     ; end if
  (if (and extset (setq toobj (entsel "\n+++ Выберите заменяющий объект -> ")))
    (progn (setq actdoc   (vla-get-activedocument (vlax-get-acad-object))
                 laycol   (vla-get-layers actdoc)
                 extlst   (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex extset))))
                 vlaobj   (vlax-ename->vla-object (car toobj))
                 objlay   (vla-item laycol (vla-get-layer vlaobj))
                 olayst   (vla-get-lock objlay)
                 fromcen  (getboundingcenter vlaobj)
                 errcount 0
                 okcount  0
                 ) ; end setq
           (vla-startundomark actdoc)
           (foreach obj extlst
             (setq tocen (getboundingcenter obj)
                   sclay (vla-item laycol (vla-get-layer obj))
                   ) ;end setq
             (if (/= :vlax-true (vla-get-lock sclay))
               (progn (setq curlay (vla-get-layer obj))
                      (vla-put-lock objlay :vlax-false)
                      (setq copobj (vla-copy vlaobj))
                      (vla-move copobj fromcen tocen)
                      (vla-put-layer copobj curlay)
                      (vla-put-lock objlay olayst)
                      (vla-delete obj)
                      (setq okcount (1+ okcount))
                      ) ; end progn
               (setq errcount (1+ errcount))
               ) ; end if
             ) ; end foreach
           (princ (strcat "\n"
                          (itoa okcount)
                          " were changed. "
                          (if (/= 0 errcount)
                            (strcat (itoa errcount) " were on locked layer! ")
                            ""
                            ) ; end if
                          ) ; end strcat
                  ) ; end princ
           (vla-endundomark actdoc)
           ) ; end progn
    (princ "\nSource object isn't selected! ")
    )     ; end if
  (princ)
  )       ; end of c:frto
Код не чистил и не проверял.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 20.10.2017, 05:08
#3399
Titli-pytli


 
Регистрация: 23.10.2013
Сообщений: 21


Помогите пожалуйста. Есть ли возможность получать (выбирать точку в пространстве модели автокада) с привязкой (угловой и размерной) от предыдущей выбранной точки (getpoint) ? Желательно так же, как при построении полилинии.


з.ы. Как выудить координату конца обычного цилиндра (_cylinder)?
Миниатюры
Нажмите на изображение для увеличения
Название: Привязка.jpg
Просмотров: 22
Размер:	65.5 Кб
ID:	194910  

Последний раз редактировалось Titli-pytli, 20.10.2017 в 12:28.
Titli-pytli вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 22.10.2017, 11:40
#3400
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,542
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Titli-pytli Посмотреть сообщение
Есть ли возможность получать (выбирать точку в пространстве модели автокада) с привязкой (угловой и размерной) от предыдущей выбранной точки (getpoint)
Titli-pytli, polar?
Для пользователя читать про Относительные координаты в Автокаде
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Инженерные консультации
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 256 07.08.2017 11:53
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||


Размещение рекламы