Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Программная инженерия > CAD проектирование
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.05.2018, 22:00   #1
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию используемые иногда мной LISP и МЫ

используемые иногда мной LISP и МЫ

в данной теме и ещё на 5-ти форумах
размещу как есть только тексты:

используемые иногда мной LISP и МЫ

entlen.lsp = длины
gakson.lsp = аксонометрия

zam.lsp = массовая замена текстов
tfind2fun.lsp = массовая замена текстов

acad table to excel.lsp = таблицы линиями в excel

bcount = из экспресс: подсчёт блоков

https://www.youtube.com/watch?v=OEaTYjJBNcE

по теме плэйлист 10 ютюб:
https://www.youtube.com/watch?v=rN0q...-9lHhK&index=6
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую

Последний раз редактировалось сфинкс; 12.05.2018 в 22:05.
сфинкс вне форума Ответить с цитированием
Старый 12.05.2018, 22:09   #2
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Цитата:
Сообщение от сфинкс Посмотреть сообщение
в данной теме и ещё на 5-ти форумах
Точно на 5?
На 1 же уже забанили за этот неотформатированный поток наркомании.
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 12.05.2018, 22:16   #3
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

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

задумано чтобы lisp были в новых сообщениях
и до сих пор новое сообщение добавлялось
и только сейчас могу продолжить

entlen.lsp = длины

использую для подсчёта длин
особенно обосабливая по слоям
и реально подсчитывать раздельно разные диаметры

а также применяется в подсчёте всех площадей помещений
ориентируясь на периметр помещения и высоту стен

entlen.lsp = длины

Код:
;======================================================================
;entLen_moss.lsp — Подсчёт суммы длин выбранных примитивов
;Моя корректировка программы entLen взятой по URL'у:
;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21732rf
;======================================================================
 
(vl-load-com)
(defun C:ENTLEN (/
                  NABOR                ;Набор примитивов
                  i                    ;Счётчик
                  ENT_i                ;i-й примитив из набора NABOR
                  LEN_all              ;Суммарная длина примитивов
                  LEN_i                ;Длина i-го примитива
                )
 
 
  (princ "\nПодсчёт суммы длин выбранных примитивов. ")
  (princ "\nВыберите примитивы: ")
 
  ;--------------------------------------------------------------------
  ;Выбор примитивов [выбираем нужные, отфильтровываем ненужные]
  ;--------------------------------------------------------------------
  (setq NABOR (ssget
                '((-4 . "<OR")
                    (0 . "*LINE")
                    (0 . "CIRCLE")
                    (0 . "ARC")
                    (0 . "ELLIPSE")
                  (-4 . "OR>")
                 )
              );end ssget
  );end setq
 
 
  ;--------------------------------------------------------------------
  ;Сообщение о количестве выбранных примитивов
  ;--------------------------------------------------------------------
  (princ (strcat "\nВсего выбрано примитивов: " (itoa (sslength NABOR))))
  (princ "\n-------------------------")
 
  ;--------------------------------------------------------------------
  ;Установка начальных значений
  ;--------------------------------------------------------------------
  (setq i 0)
  (setq LEN_all 0.0)
 
 
  ;--------------------------------------------------------------------
  ;Цикл по набору NABOR
  ;--------------------------------------------------------------------
  (while (< i (sslength NABOR))
 
    ;..................................................................
    ;Определяем Имя i-го примитива из набора NABOR
    ;..................................................................
    (setq ENT_i (ssname NABOR i))
 
    ;..................................................................
    ;Определяем Длиу i-го примитива из набора NABOR
    ;..................................................................
    (setq LEN_i  (vlax-curve-getDistAtParam
                    (vlax-ename->vla-object ENT_i)
                    (vlax-curve-getEndParam ENT_i)
                 );end vlax-curve-getDistAtParam
    );end setq
 
    (princ (strcat "\n"(itoa (1+ i)) "-й примитив = " (rtos LEN_i) "м"))
 
    ;;;Отладка
    ;;;(redraw ENT_i 3)
    ;;;(read-line)
 
    ;..................................................................
    ;Наращиваем суммарную длину всех выбранных примитивов
    ;..................................................................
    (setq LEN_all  (+ LEN_all  LEN_i))
 
    (setq i (1+ i))
  );end while
 
  (princ "\n-------------------------")
  (princ (strcat
           "\nОбщая длина " (itoa (sslength NABOR)) " выбранных примитивов = "
           (rtos LEN_all)
           "м"
         );end  strcat
  );end princ
 
  (prin1)
);end defun C:ENTLEN
;**********************************************************************
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую
сфинкс вне форума Ответить с цитированием
Старый 08.06.2018, 17:04   #4
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

новое слово: живые картинки
малого размера и только ключевые кадры


bcount
подсчёт блоков


miniblock
мини блоки и говорящие названия


gakson
аксонометрия

живые картинки малого размера
т.к. мои исходные экранки
у меня без сжатия и без искажений
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую
сфинкс вне форума Ответить с цитированием
Старый 09.06.2018, 10:24   #5
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

вновь живые картинки
малого размера и ключевые кадры


слои вносятся с вставляемого чертежа


entlen
подсчёт длин элементов

и только у кого исходные экранки
без сжатия те могут создавать живые картинки
малого размера по 100 кб ... 360 кб
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую
сфинкс вне форума Ответить с цитированием
Старый 23.06.2018, 21:36   #6
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

OTMETКА БЛОК NanoCAD AutoCAD GstarCAD ZwCAD Danilin 2016
https://www.youtube.com/watch?v=OEhVusldcA8

ПРОФИЛЬ ОТМЕТКИ NanoCAD AutoCAD GstarCAD ZwCAD Danilin 2017
https://www.youtube.com/watch?v=AVErmUboHCw
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую
сфинкс вне форума Ответить с цитированием
Старый 19.06.2019, 13:31   #7
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

накануне в другой теме мной

создана экспорт ориентированная импорт замещающая
система VyshivCAD ВышивКАД
совместимая с АвтоКАД AutoCAD NanoCAD ZWCAD GStarCAD

составляющая узоры из блоков клеток
цепляя клетки за углы и приставляя к углам других клеток
причём цвета управляются через слои

и реально создать клетки любых цветов
и из клеток формируется узор как в VyshivCAD.pdf

причём перекрашивая слой
меняются все клетки слоя
и вдобавок сетка включается и вЫключается
да и всё управляемо

экспорториентированная импортзамещающая
система VyshivCAD ВышивКАД
Изображения
Тип файла: gif VyshivCAD.gif (116.2 Кб, 105 просмотров)
Тип файла: png VyshivCAD.PNG (15.2 Кб, 106 просмотров)
Вложения
Тип файла: rar VyshivCAD-DWG.rar (8.6 Кб, 20 просмотров)
Тип файла: pdf VyshivCAD.pdf (17.5 Кб, 22 просмотров)
Тип файла: rar VyshivCAD-AVI-750.rar (552.5 Кб, 22 просмотров)
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую
сфинкс вне форума Ответить с цитированием
Старый 22.06.2019, 04:31   #8
Nif-naf
Форумчанин
 
Аватар для Nif-naf
 
Регистрация: 05.09.2016
Сообщений: 131
По умолчанию

Р°.Ecmb B KoMnace lisp?
Немного о GoAsm.
Nif-naf вне форума Ответить с цитированием
Старый 16.08.2019, 18:36   #9
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

автокад autocad массовая замена текста. часть 1-я из 2-х: tfind2fun.lsp
Код:
;-============-;
;- Text Find -;
;- *~* -;
; Written by -;
; Mark Mercier ;
; 05-06-09 ;
;-============-;

(defun tfind2fun (inputF inputR caseSn / goto goWhile strinF strinR selSet selTxt searep case count error)
; 01 Create selection set. GOTO 02 if success, or GOTO 08 if fail
; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 06. If both strings, GOTO 07. Otherwise, return error and GOTO 08
; 03 Display menus and obtain data from user. If Search, GOTO 04. If Replace, GOTO 05
; 04 Search option selected. Prompt user for single search term. GOTO 06
; 05 Replace option selected. Prompt user for search term and replace term. GOTO 07
; 06 One string has been passed. Assume automatic search. GOTO FINISH
; 07 Two strings have been passed. Assume automatic replace. GOTO FINISH
; 08 FINISH. Return errors or messages if needed.
(vl-load-com)
(setq goTo 1)
(setq goWhile 1)
(setq count 0)
(if (not (mlml (list caseSn) (list 0 1)))
(progn (setq goWhile nil) (princ "\nCase selection not recognized."))
) ;_ end of if
(if (= caseSn 0)
(setq case "N")
(setq case "Y")
) ;_ end of if
(while goWhile
(cond
((= goTo 1)
(if (setq selSet (extTxtPt (ssget "X")))
(setq goTo 2)
(setq error "\nSelection set not found."
goTo 8
) ;_ end of setq
) ;_ end of if
)
((= goTo 2)
; Check input, pass to whatever.
(cond
((and (= inputF nil) (= inputR nil))
(setq goTo 3)
)
((and (= (type inputF) 'STR) (= inputR nil))
(setq strinF inputF)
(setq goTo 6)
)
((and (= (type inputF) 'STR) (= (type inputR) 'STR))
(setq strinF inputF)
(setq strinR inputR)
(setq goTo 7)
)
(t
(setq error "\nPassed arguments are not accepted.")
(setq goTo 8)
)
) ;_ end of cond
)
((= goTo 3)
; Obtain desired option from user
(while (not
(mlml (list (setq searep (strcase (getstring nil "\nSelect option [Find/Replace/Quit/Case]: "))))
(list "F" "FIND" "R" "REPLACE" "Q" "QUIT" "C" "CASE")
) ;_ end of mlml
) ;_ end of not
) ;_ end of while
(cond
((mlml (list searep) (list "F" "FIND"))
(setq goTo 4)
)
((mlml (list searep) (list "R" "REPLACE"))
(setq goTo 5)
)
((mlml (list searep) (list "Q" "QUIT"))
(setq goTo 8)
)
((mlml (list searep) (list "C" "CASE"))
(while (not (mlml (list (setq case (strcase (getstring nil "\nCase sensitive? [Yes/No]: "))))
(list "Y" "YES" "N" "NO")
) ;_ end of mlml
) ;_ end of not
) ;_ end of while
)
) ;_ end of cond
)
((= goTo 4)
; Obtain search string from user, set to strinF
(while (eq "" (setq strinF (getstring t "\nEnter search term: "))))
(setq goTo 6)
)
((= goTo 5)
; Obtain search string and replace string from user, set to strinF and strinR respectively
(while (eq "" (setq strinF (getstring t "\nEnter find term: "))))
(while (eq "" (setq strinR (getstring t "\nEnter replace term: "))))
(setq goTo 7)
)
((= goTo 6)
; Search drawing for strinF
(cond
((mlml (list case) (list "Y" "YES"))
; Compare using (vl-string-search strinF input), view selection
; use "while" to get all search occurances
(foreach selVar selSet
(if (vl-string-search strinF (nth 0 selVar))
(progn
(setq count (1+ count))
(if (/= (getvar "ctab") (caddr selVar))
(command "ctab" (caddr selVar))
) ;_ end of if
(command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
(getstring "\nPress 'Enter' to continue: ")
) ;_ end of progn
) ;_ end of if
) ;_ end of foreach
)
((mlml (list case) (list "N" "NO"))
; Compare using (vl-string-search (strcase strinF) (strcase input)), view selection
; use "while" to get all search occurances
(foreach selVar selSet
(if (vl-string-search (strcase strinF) (strcase (nth 0 selVar)))
(progn
(setq count (1+ count))
(if (/= (getvar "ctab") (caddr selVar))
(command "ctab" (caddr selVar))
) ;_ end of if
(command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
(getstring "\nPress 'Enter' to continue: ")
) ;_ end of progn
) ;_ end of if
) ;_ end of foreach
)
) ;_ end of cond
(if (= count 0)
(setq error "\nNo matches found.")
(setq error (strcat (itoa count) " matches found."))
) ;_ end of if
(setq goTo 8)
)
((= goTo 7)
; Replace strinF with strinR
(cond
((mlml (list case) (list "Y" "YES"))
; Compare using (vl-search-string strinF input), modify using (vl-string-subst) within a while loop
(foreach selVar selSet
(setq selTxt (nth 0 selVar))
(setq seaLoc 0)
(while (setq seaLoc (vl-string-search strinF selTxt seaLoc))
(setq selTxt (vl-string-subst strinR strinF selTxt seaLoc))
(setq seaLoc (+ seaLoc (strlen strinR)))
(setq count (1+ count))
) ;_ end of while
(vla-put-textstring (vlax-ename->vla-object (nth 4 selVar)) selTxt)
) ;_ end of foreach
)
((mlml (list case) (list "N" "NO"))
; Compare using (vl-string-search (strcase strinF) (strcase input)), modify using (vl-string-subst) within a while loop
(foreach selVar selSet
(setq selTxt (nth 0 selVar))
(setq seaLoc 0)
(while (setq seaLoc (vl-string-search (strcase strinF) (strcase selTxt) seaLoc))
(setq selTxt (strcat (substr selTxt 1 seaLoc) strinR (substr selTxt (+ 1 seaLoc (strlen strinF)))))
(setq seaLoc (+ seaLoc (strlen strinR)))
(setq count (1+ count))
) ;_ end of while
(vla-put-textstring (vlax-ename->vla-object (nth 4 selVar)) selTxt)
) ;_ end of foreach
)
) ;_ end of cond
(if (= count 0)
(setq error "\nNo occurances found.")
(setq error (strcat (itoa count) " occurances modified."))
) ;_ end of if
(setq goTo 8)
)
((= goTo 8)
(if error
(princ error)
) ;_ end of if
(setq goWhile nil)
)
) ;_ end of cond
) ;_ end of while
(princ)
) ;_ end of defun

(defun mlml (inSMLChar inSMLStri / returnVarMS toCheck chkWith)
(setq returnVarMS nil)
(if (and (= (type inSMLChar) 'list)
(= (type inSMLStri) 'list)
) ;_ end of and
(progn
(foreach toCheck inSMLStri
(foreach chkWith inSMLChar
(if (eq toCheck chkWith)
(setq returnVarMS t)
) ;_ end of if
) ;_ end of foreach
) ;_ end of foreach
) ;/progn
) ;_ end of if
returnVarMS
) ; Checks a list to see if a member of that list is the same as a member of another list. Returns T or nil

(defun extTxtPt (ssList / subVar getEnt entTyp entTxt entPnt entLay entHgt grp66 entAtt getEntAtt entAttTyp uniLst)
(setq uniLst nil)
(setq subVar 0)
(if ssList
(repeat (sslength ssList)
(setq getEnt (entget (cadr (car (ssnamex ssList subVar)))))
(setq entTyp (cdr (assoc 0 getEnt)))
(cond
((or (= entTyp "TEXT") (= entTyp "MTEXT"))
(setq entTxt (cdr (assoc 1 getEnt)))
(setq entPnt (cdr (assoc 10 getEnt)))
(setq entHgt (cdr (assoc 40 getEnt)))
(setq entLay (cdr (assoc 410 getEnt)))
(setq entNam (cdr (assoc -1 getEnt)))

(setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))
)
((= entTyp "INSERT")
(setq grp66 (assoc 66 getEnt))
(if grp66
(progn
(setq entAtt (entnext (cdr (assoc -1 getEnt))))
(setq getEntAtt (entget entAtt))
(setq entAttTyp (cdr (assoc 0 getEntAtt)))
) ;_ end of progn
) ;_ end of if
(while (= entAttTyp "ATTRIB")
(setq entTxt (cdr (assoc 1 getEntAtt)))
(setq entPnt (cdr (assoc 10 getEntAtt)))
(setq entHgt (cdr (assoc 40 getEntAtt)))
(setq entLay (cdr (assoc 410 getEntAtt)))
(setq entNam (cdr (assoc -1 getEntAtt)))

(setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

; Get next entity.
(setq entAtt (entnext (cdr (assoc -1 getEntAtt))))

; Get ent and ent type
(setq getEntAtt (entget entAtt))
(setq entAttTyp (cdr (assoc 0 getEntAtt)))
) ;_ end of while
)
(t
)
) ;_ end of cond
(setq subVar (1+ subVar))
) ;_ end of repeat
) ;_ end of if
uniLst
) ; Return list of all text-based objects (Text, MText, Attribute) in the current drawing
копируем код и вставляем в блокнот и называем
tfind2fun.lsp
и помещаем в корень c: чтоб не искать
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую

Последний раз редактировалось сфинкс; 16.08.2019 в 18:40.
сфинкс вне форума Ответить с цитированием
Старый 16.08.2019, 18:37   #10
сфинкс
Форумчанин
 
Аватар для сфинкс
 
Регистрация: 17.06.2012
Сообщений: 953
По умолчанию

автокад autocad массовая замена текста. часть 2-я из 2-х: zam.lsp
Код:
(defun c:zam ()
(tfind2fun "dn 300 A" "%%c300" 1)
(tfind2fun "dn 250 A" "%%c250" 1)
(tfind2fun "dn 200 A" "%%c200" 1)
(tfind2fun "dn 150 A" "%%c150" 1)
(tfind2fun "dn 125 A" "%%c250" 1)
(tfind2fun "dn 100 A" "%%c100" 1)
(tfind2fun "dn 80 A" "%%c80" 1)
(tfind2fun "dn 65 A" "%%c65" 1)
(tfind2fun "dn 50 A" "%%c50" 1)
(tfind2fun "dn 40 A" "%%c40" 1)
(tfind2fun "dn 32 A" "%%c32" 1)
(tfind2fun "dn 25 A" "%%c25" 1)
(tfind2fun "dn 20 A" "%%c20" 1)
(tfind2fun "dn 15 A" "%%c15" 1)
(tfind2fun "dn 10 A" "%%c20" 1)
(tfind2fun "dn 0 A" "расчет" 1)
(tfind2fun "L " "Lm " 1)
)
и рядом помещаем данный лисп ZAM.lsp
в автозагрузку AutoCAD добавляем оба лиспа

и отныне именно в zam.lsp привязанном к блокноту
набираем строки замены и сохраняем

AutoCAD загружаясь считывает оба лиспа
и всё по списку само заменяет команда zam
Случайные и Массивы https://programmersforum.ru/showthread.php?t=344371 Учим C# & basic & excel & python https://programmersforum.ru/showthre...=327446&page=5 ничего нерекомендую

Последний раз редактировалось сфинкс; 16.08.2019 в 18:41.
сфинкс вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Pattern'ы, используемые классом Regex Mixim Общие вопросы .NET 2 01.11.2012 13:48
Рассчитать общие затраты на используемые материалы. Катя369919407 Паскаль, Turbo Pascal, PascalABC.NET 7 30.01.2012 22:04
Сколько байт занимают переменные, используемые в программе Эндрю Помощь студентам 2 10.05.2011 13:36