Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Доработать лисп автоматической нумерации (AutoCad 2014)

Доработать лисп автоматической нумерации (AutoCad 2014)

Ответ
Поиск в этой теме
Непрочитано 12.12.2016, 14:49 #1
Доработать лисп автоматической нумерации (AutoCad 2014)
Integra33rus
 
Регистрация: 12.12.2016
Сообщений: 10

Дорогой дедушка мороз! В этом году я был примерным проектировщиком, хорошо себя вел. И знаешь, мне не нужны квартиры, машины, зарплаты высокие - нет.
Я хочу от тебя, дорогой дедушка, лисп.
Сейчас я пользуюсь таким:
Код:
[Выделить все]
 (defun c:num (/ oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error*)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size(getreal(strcat "\nSpecify text size <"(rtos num:Size)">: ")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref(getstring(strcat "\nEnter prefix <"num:Pref">: ")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (setq num:Suf(getstring(strcat "\nEnter suffix <"num:Suf">: ")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (setq num:Num(getint(strcat "\nEnter start number <"(itoa num:Num)">: ")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  (setq newNum(vla-AddText actSp
        curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase" "0,0" (entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num
Он в достаточной степени причиняет мне неудобства и мне бы хотелось, чтоб продуктом выходил многострочный текст, а не одинарный (как сейчас).

И это. Если уж тебя совсем не затруднит, то в идеале он должен выглядеть так:

масштаб текста - аннотативный (автоматически подстраиваемый под тот лист, в котором работаем)
скрытие заднего плана - да;
использовать цвет фона чертежа - да;
коэффициент перекрытия - 1.1;
выравнивание - середина по центру.
Просмотров: 1653
 
Непрочитано 12.12.2016, 15:56
#2
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Дедушка давно на .net пересел.
Profan вне форума  
 
Непрочитано 14.12.2016, 12:40
1 | #3
valerik88


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


Батя починил.

Код:
[Выделить все]
  (defun c:num (/ oldPref oldSuf oldStart curStr newNum
	        actDoc actSp oldEcho oldSize *error* mtext ed)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
	oldSize num:Size
	actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	oldEcho(getvar "CMDECHO")
	); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size(getreal(strcat "\nSpecify text size <"(rtos num:Size)">: ")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref(getstring(strcat "\nEnter prefix <"num:Pref">: ")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= "#" num:Pref)(setq num:Pref ""))
  (setq num:Suf(getstring(strcat "\nEnter suffix <"num:Suf">: ")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= "#" num:Suf)(setq num:Suf ""))
  (setq num:Num(getint(strcat "\nEnter start number <"(itoa num:Num)">: ")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf))
    (while(vl-string-search "#" curStr)
      (setq curStr(vl-string-subst " " "#" curStr))
      ); end while
  ;(setq newNum(vla-AddText actSp curStr (vlax-3d-point'(0.0 0.0 0.0))num:Size))
  (setq newNum(vla-AddMText actSp (vlax-3d-point'(0.0 0.0 0.0)) num:Size curStr))  
  ;(vla-put-Alignment newNum acAlignmentMiddleCenter)
  (setq mtext (entlast))
  (setpropertyvalue mtext "TextHeight" num:Size)
	;(vlax-dump-object newNum)  
	(setq ed (entget mtext))
	(setq ed (subst (cons 71 5) (assoc 71 ed) ed ))
	(if (assoc 90 ed)
		(setq ed (subst (cons 90 3) (assoc 90 ed) ed ))
		(setq ed (reverse (cons '(90 . 3) (reverse ed) )))
	);end if
	(if (assoc 45 ed)
		(setq ed (subst (cons 45 1.1) (assoc 45 ed) ed ))
		(setq ed (reverse (cons '(45 . 1.1) (reverse ed) )))
	);end if

	(entmod ed)
	(setpropertyvalue mtext "Annotative" 1)
	
  ;(vlax-put-property newNum "AttachmentPoint" 5)
  (command "_.copybase" "0,0" mtext "")
  (command "_.erase" mtext "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num

Последний раз редактировалось valerik88, 14.12.2016 в 13:17.
valerik88 вне форума  
 
Автор темы   Непрочитано 15.12.2016, 10:03
#4
Integra33rus


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




В пространстве модели (картинка 1) неплохо получается, просит выбрать высоту шрифта, получаем масштаб 1:1 и указанную нами высоту.
Проблема в том, что работаю в пространстве листа с аннотативными масштабами. На второй картинке изображены плоды двух команд NUM
при первом запуске лиспа был выбран размер шрифта 40.
при втором запуске лиспа был выбран размер шрифта 2.5.

На выходе работы лиспа (по одному клику мышки) получается два текста - один в пространстве листа, другой вне (на второй картинке изображен слева).
Тот текст что вне пространства листа, при повторении команды лиспа (щелчок мышью) накладывается на предыдущий текст и изменяет параметр цифры на +1. Т.к. идет скрытие заднего плана, предыдущий текст невидно. (нам этот текст ненужен вообще).
А тот текст, который мы получаем в пространстве листа (который нам и нужен, вообще говоря) копируется без изменений. (При этом масштаб текста 1:1 (что плохо) и высота текста в пространстве листа та, которую задаешь при запуске лиспа (что плохо)).

Было бы круто, если при запуске лиспа он просил:
1. размер текста в пространстве модели;
2. аннотативный масштаб. (по умолчанию стиль текста должен быть "аннотативный текст").
Integra33rus вне форума  
 
Автор темы   Непрочитано 26.12.2016, 13:27
#5
Integra33rus


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


А все равно неплохо получилось!
После ряда танцев с бубнами качественный продукт получаем на выходе.
И эти танцы меньше времени занимают, чем прописывать огромное количество адресов в ручную.
Спасибо большое, с наступающим!!!
Integra33rus вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Доработать лисп автоматической нумерации (AutoCad 2014)

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
В AutoCAD 2016 некорректно открываются файлы, созданные в AutoCAD 2014 Nadija_arh AutoCAD 4 11.01.2016 22:09
Не находит команду Flatten в AutoCAD 2014 rtyu AutoCAD 3 11.07.2014 09:26
Отображение выбора в Autocad 2015 как в Autocad 2014 aso3 AutoCAD 2 19.06.2014 09:21