Помогу бесплатно разработать любую программу на autolisp.

Пробуйте.

 

Спасибо огромное!!!!!! Все работает

 

Лайк поставьте.

 

А пример чертежа можно? В версии AC2007 желательно.

 

Здравствуйте! В некоторых чертежах Лисп работает некорректно. Тест_2 - линии "прикрепляются" не всегда к ближайшим блокам, иногда перескакивает на соседний блок, который находится на расстоянии 15 см (выделены красным цветом)
Тест_3 - большинство линий не корректируются (выделены красным цветом).

Спасибо за помощь!

 

Пользуй команду "_WBLOCK", а то в твоих "чертежах" слишком много кала.

 

Спасибо за совет, но мою проблему он не решает и я не совсем понимаю, зачем мне это.
Для чистки чертежа пользуюсь командой Purge

 

Тогда почему говна в твоих "чертежах" больше, чем чертежей?

 

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

 

В порядке вещей выкладывать "грязь"?

 

Простите, что оскорбила Ваше чувство прекрасного. Впредь постараюсь таких ошибок не допускать.
Интересно, когда у Вас на улице спрашивают дорогу, Вы всегда даете оценку внешнему виду человека?
Позвольте и Вам дать совет: иногда лучше промолчать. И в этой теме просят помощи с лиспами, а не оценку чертежей.
Можете помочь, буду благодарна. Нет - другого совета я не просила. Хорошего дня.

 

Типа рыночные отношения? Но мне с вас ничего не надобно.

 

Здравствуйте. С лиспом не дружу. Много лет назад для своих целей взял в интернете код и переделал под свои цели. Теперь уже не вспомню, как это делал.
Работает следующим образом. В автокаде выделяю полилинию, в командную строку ввожу команду "1". В итоге в буфер обмена попадает список координат полилинии, а перед этим списком идет строка #ClipDataForOfficeApp. (Далее другая программа, отслеживающая изменение буфера обмена подхватывает этот список и конвертирует нужным для меня образом).

Если выделены несколько полилиний, то данный код поместит в буфер обмена координаты сплошным списком, без разделителей. Мне сейчас понадобилось, чтобы в буфер обмена попадал список координат всех выделенных полилиний, при этом необходимо разделить координаты разных полилиний пустой строкой.
Помогите, пожалуйста, переделать этот код, чтобы он работал следующим образом:
- выделяю полилинии в автокаде
- в командную строку пишу "1" (имя команды можно оставить)
- в буфер обмена попадает список координат полилиний, список координат каждой полилинии разделен между собой пустой строкой
- в список координат в первую строку НЕ выводить слово #ClipDataForOfficeApp
Итоговой список, копируемый в буфер обмена, имеет следующий вид (я не помню, как этот список выводится сейчас, через пробел или через запятую; сначала Х, потом Y, или наоборот, это не важно, менять формат вывода координат не надо, только добавить пустую строку в качестве разделителя):

Раскрыть Спойлер Свернуть Спойлер

100 200
101 201
102 202

200 301
201 302
202 303

303 404
304 405
305 406
и т.д. сколько выделено полилиний - столько блоков с координатами в списке

Код, который использую сейчас

Код (раскрыть) Код (свернуть)

Код:

;|
Экспорт координат выбранных полилиний в Excel.
Округление координат в соответствии с текущими настройками команды _UNITS (переменная LUPREC !!!)
!!!!!!!!!!!!!
Набрать в командной строке LUPREC и установить нужную точность округления.
!!!!!!!!!!
|;
(vl-load-com)
 
(defun clipboard (Data-list / iz_listo html result str)
(setq str "#ClipDataForOfficeApp")
(repeat (length Data-list)
(setq iz_listo (car Data-list))
(setq str (strcat str
"\n"
(strcat
(car iz_listo)
" "
(cadr iz_listo)
)
)
)
(setq Data-list (cdr Data-list))
)
;;; (princ str)
(setq html (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" str)
)
(vlax-release-object html)
)
 
 
 
 
 
(defun c:1 (/ cFile curPt filPath objSet oFlag oldMode ptLst sFlag lw
isRus)
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num) 0)
(progn (setq ls nil)
(repeat (/ (length lst) num)
(repeat num
(setq ls (cons (car lst) ls)
lst (cdr lst)
)
)
(setq ret (append ret (list ls))
ls nil
)
)
)
)
ret
)
(defun PLCollect (SelSet / ret)
(foreach lw (mapcar
'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex SelSet)))
)
(cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
(setq ret
(append ret
(group-by-num
(vlax-get lw 'Coordinates)
(if (= (vla-get-ObjectName lw) "AcDbPolyline")
2
3
)
)
)
)
)
((= (vla-get-ObjectName lw) "AcDbSpline")
(setq
ret (append
ret
(group-by-num
(vlax-safearray->list
(vlax-variant-value (vla-get-controlpoints lw))
)
3
)
)
)
)
(t nil)
)
)
ret
)
(vl-load-com)
(setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
(if (not ptcol:mode)
(setq ptcol:mode "poLyline")
)
(setq oldMode ptcol:mode
ptLst nil
)
(if (null ptcol:mode)
(setq ptcol:mode oldMode)
)
(cond
((= "Pick" ptcol:mode)
(setq curPt T)
(while curPt
(setq
curPt (getpoint (if IsRus
"\nУкажите точку или Enter завершения > "
"\nPick point or Enter to continue > "
)
)
)
(if curPt
(setq ptLst (append ptLst (list (trans curPt 1 0))))
)
)
) ; end condition #1
((= "pOints" ptcol:mode)
(if (not (setq objSet (ssget "_I" '((0 . "POINT")))))
(progn
(if IsRus
(princ "\nВыберите точки и нажмите Enter ")
(princ "\nSelect points and press Enter ")
)
(setq objSet (ssget '((0 . "POINT"))))
)
)
(if objSet
(setq ptLst (PtCollect objSet))
)
) ; end condition #2
((= "Blocks" ptcol:mode)
(if (not (setq objSet (ssget "_I" '((0 . "INSERT")))))
(progn
(if IsRus
(princ "\nВыберите блоки и нажмите Enter ")
(princ "\nSelect blocks and press Enter ")
)
(setq objSet (ssget '((0 . "INSERT"))))
)
)
(if objSet
(setq ptLst (PtCollect objSet))
)
) ; end condition #3
((= "poLyline" ptcol:mode)
(if (not (setq objSet (ssget "_I" '((0 . "*POLYLINE,SPLINE")))))
(progn
(if IsRus
(princ "\nВыберите полилинии и нажмите Enter ")
(princ "\nSelect polyline and press Enter ")
)
(setq objSet (ssget '((0 . "*POLYLINE,SPLINE"))))
)
)
(if objSet
(setq ptLst (PLCollect objSet))
)
) ; end condition #4
) ; end cond
(if ptLst
(progn
(if (null sFlag)
(setq sFlag "Excel")
)
(cond ((and (= "Text" sFlag)
(setq filPath
(getfiled (if IsRus
"Сохранение координат в текстовый файл"
"Save Coordinates to Text File"
)
"Coordinates.txt"
"txt;csv"
33
)
)
)
(setq cFile (open filPath "w"))
(foreach ln ptLst
(write-line
(strcat (rtos (cadr ln))
","
(rtos (car ln))
(if (= 999 (length ln))
(strcat "," (rtos (nth 2 ln)))
)
)
cFile
)
)
(close cFile)
(initget "Yes No")
(setq oFlag (getkword (if IsRus
"\nОткрыть файл? [Yes/No] <No> : "
"\nOpen text file? [Yes/No] <No> : "
)
)
)
(if (= oFlag "Yes")
(startapp "notepad.exe" filPath)
)
) ; end condition #1
((= "Excel" sFlag)
;;; (princ ptlst)
(clipboard (mapcar '(lambda (x) (mapcar 'rtos x)) ptLst))
) ; end condition #2
(t nil)
)
)
)
(princ)
) ; end
(princ)

Если есть готовые решения для подобной задачи, дайте ссылку. Заранее спасибо.

 

Оффтоп

Будучи не программистом, предположу, что в какое-то место (офицеры, молчать!) нужно вставить "\n" или "\n\n".

 

Лиспа у меня нема (DraftSight). Поэтому я даже близко к "такому" коду подходить не буду. Для начала вам надобно применить "Оформление кода lsp" (проверить как я уже сказал не могу). Это для того, чтобы даже "такие как я" могли чем то помочь. Ну а уже после "этого" можно и поговорить.

 

Код отредактированный есть. При вставке в сообщение он "поехал". Приложу текстовый файл. В нем код отредактирован. Или подскажите, как этот код вставить в сообщение в отредактированном виде.

 

(отредактированныйформатированный)
Уже менее плохо. Но всё-равно достаточно коряво - явно правился много раз и каждый раз в своём стиле. Я бы всё-таки использовал #1275, хотя бы чисто из профилактики (ну коли всё-равно приходится "таким" заниматься).

Единого рецепта нет. Иногда помогает повторная вставка.

 

А вот сейчас вставилось нормально. Теперь в понедельник буду на работе, попробую отформатировать нормально

Раскрыть Спойлер Свернуть Спойлер

Код:

;|
 
Экспорт координат выбранных полилиний в Excel.
 
Округление координат в соответствии с текущими настройками команды _UNITS (переменная LUPREC !!!)
 
!!!!!!!!!!!!!
 
Набрать в командной строке LUPREC и установить нужную точность округления.
 
!!!!!!!!!!
 
|;
 
(vl-load-com)
 
 
 
(defun clipboard (Data-list / iz_listo html result str)
 
  (setq str "#ClipDataForOfficeApp")
 
  (repeat (length Data-list)
 
    (setq iz_listo (car Data-list))
 
    (setq str (strcat str
 
      "\n"
 
      (strcat
 
(car iz_listo)
 
" "
 
(cadr iz_listo)
 
      )
 
      )
 
    )
 
    (setq Data-list (cdr Data-list))
 
  )
 
;;;  (princ str)
 
  (setq html   (vlax-create-object "htmlfile")
 
        result (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" str)
 
  )
 
  (vlax-release-object html)
 
)
 
 
 
 
 
 
 
 
 
 
 
(defun c:1 (/ cFile curPt filPath objSet oFlag oldMode ptLst sFlag lw
 
    isRus)
 
  (defun group-by-num (lst num / ls ret)
 
    (if (= (rem (length lst) num) 0)
 
      (progn (setq ls nil)
 
     (repeat (/ (length lst) num)
 
       (repeat num
 
 (setq ls  (cons (car lst) ls)
 
       lst (cdr lst)
 
 )
 
       )
 
       (setq ret (append ret (list ls))
 
     ls  nil
 
       )
 
     )
 
      )
 
    )
 
    ret
 
  )
 
  (defun PLCollect (SelSet / ret)
 
    (foreach lw (mapcar
 
  'vlax-ename->vla-object
 
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex SelSet)))
 
)
 
      (cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
 
     (setq ret
 
    (append ret
 
    (group-by-num
 
      (vlax-get lw 'Coordinates)
 
      (if (= (vla-get-ObjectName lw) "AcDbPolyline")
 
2
 
3
 
      )
 
    )
 
    )
 
     )
 
    )
 
    ((= (vla-get-ObjectName lw) "AcDbSpline")
 
     (setq
 
       ret (append
 
     ret
 
     (group-by-num
 
       (vlax-safearray->list
 
 (vlax-variant-value (vla-get-controlpoints lw))
 
       )
 
       3
 
     )
 
   )
 
     )
 
    )
 
    (t nil)
 
      )
 
    )
 
    ret
 
  )
 
  (vl-load-com)
 
  (setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
 
  (if (not ptcol:mode)
 
    (setq ptcol:mode "poLyline")
 
  )
 
  (setq oldMode ptcol:mode
 
ptLst nil
 
  )
 
  (if (null ptcol:mode)
 
    (setq ptcol:mode oldMode)
 
  )
 
  (cond
 
    ((= "Pick" ptcol:mode)
 
     (setq curPt T)
 
     (while curPt
 
       (setq
 
 curPt (getpoint (if IsRus
 
   "\nУкажите точку или Enter завершения > "
 
   "\nPick point or Enter to continue > "
 
 )
 
       )
 
       )
 
       (if curPt
 
 (setq ptLst (append ptLst (list (trans curPt 1 0))))
 
       )
 
     )
 
    ) ; end condition #1
 
    ((= "pOints" ptcol:mode)
 
     (if (not (setq objSet (ssget "_I" '((0 . "POINT")))))
 
       (progn
 
 (if IsRus
 
   (princ "\nВыберите точки и нажмите Enter ")
 
   (princ "\nSelect points and press Enter ")
 
 )
 
 (setq objSet (ssget '((0 . "POINT"))))
 
       )
 
     )
 
     (if objSet
 
       (setq ptLst (PtCollect objSet))
 
     )
 
    ) ; end condition #2
 
    ((= "Blocks" ptcol:mode)
 
     (if (not (setq objSet (ssget "_I" '((0 . "INSERT")))))
 
       (progn
 
 (if IsRus
 
   (princ "\nВыберите блоки и нажмите Enter ")
 
   (princ "\nSelect blocks and press Enter ")
 
 )
 
 (setq objSet (ssget '((0 . "INSERT"))))
 
       )
 
     )
 
     (if objSet
 
       (setq ptLst (PtCollect objSet))
 
     )
 
    ) ; end condition #3
 
    ((= "poLyline" ptcol:mode)
 
     (if (not (setq objSet (ssget "_I" '((0 . "*POLYLINE,SPLINE")))))
 
       (progn
 
 (if IsRus
 
   (princ "\nВыберите полилинии и нажмите Enter  ")
 
   (princ "\nSelect polyline and press Enter ")
 
 )
 
 (setq objSet (ssget '((0 . "*POLYLINE,SPLINE"))))
 
       )
 
     )
 
     (if objSet
 
       (setq ptLst (PLCollect objSet))
 
     )
 
    ) ; end condition #4
 
  ) ; end cond
 
  (if ptLst
 
    (progn
 
      (if (null sFlag)
 
(setq sFlag "Excel")
 
      )
 
      (cond ((and (= "Text" sFlag)
 
  (setq filPath
 
 (getfiled (if IsRus
 
     "Сохранение координат в текстовый файл"
 
     "Save Coordinates to Text File"
 
   )
 
   "Coordinates.txt"
 
   "txt;csv"
 
   33
 
 )
 
  )
 
     )
 
     (setq cFile (open filPath "w"))
 
     (foreach ln ptLst
 
       (write-line
 
 (strcat (rtos (cadr ln))
 
 ","
 
 (rtos (car ln))
 
 (if (= 999 (length ln))
 
   (strcat "," (rtos (nth 2 ln)))
 
 )
 
 )
 
 cFile
 
       )
 
     )
 
     (close cFile)
 
     (initget "Yes No")
 
     (setq oFlag (getkword (if IsRus
 
     "\nОткрыть файл? [Yes/No] <No> : "
 
     "\nOpen text file? [Yes/No] <No> : "
 
   )
 
 )
 
     )
 
     (if (= oFlag "Yes")
 
       (startapp "notepad.exe" filPath)
 
     )
 
    ) ; end condition #1
 
    ((= "Excel" sFlag)
 
;;;      (princ ptlst)
 
     (clipboard (mapcar '(lambda (x) (mapcar 'rtos x)) ptLst))
 
    ) ; end condition #2
 
    (t nil)
 
      )
 
    )
 
  )
 
  (princ)
 
) ; end
 
(princ)

 

Из того, что я "вижу" defun PLCollect составляет общий список, а не список списков. После чего основная функция defun c:1 работает именно со списком, а не списком списков. Но я могу ошибаться (проверить то негде). В силу сказанного ваша "хотелка" для данного лиспа не применима. Вам нужен другой лисп. :)))

 

Как создать геоточку (Геоникс) средствами LISP ? Через entmake, например. Что у ней за тип объекта? Через (entget(entsel)) выдаёт ошибку.