Здравствуйте! В некоторых чертежах Лисп работает некорректно. Тест_2 - линии "прикрепляются" не всегда к ближайшим блокам, иногда перескакивает на соседний блок, который находится на расстоянии 15 см (выделены красным цветом) Тест_3 - большинство линий не корректируются (выделены красным цветом). Спасибо за помощь!
Спасибо за совет, но мою проблему он не решает и я не совсем понимаю, зачем мне это. Для чистки чертежа пользуюсь командой 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) Если есть готовые решения для подобной задачи, дайте ссылку. Заранее спасибо.
Оффтоп (Move your mouse to the spoiler area to reveal the content) Будучи не программистом, предположу, что в какое-то место (офицеры, молчать!) нужно вставить "\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)) выдаёт ошибку.