Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Настройки поиска
Форумы CADUser → Результаты поиска
Страницы 1
Сообщений найдено 4
1 27 января 2013г. 15:05:55
Re: Помогите переделать программу автоматической нумерации (41 ответов, оставленных в LISP)
2 22 июля 2008г. 17:32:33
Re: Атрибуты: как считать их значения (13 ответов, оставленных в LISP)
1. ATTDIA = 0 ATTREQ = 0
2. Вставляешь блок.
3. Потом программно изменяешь атрибуты
Я выкладывал здесь https://www.caduser.ru/forum/topic35337.html в посте
> VVA
ф-цию mip-block-setattr-bylist Используй ее.
Как пример смотри BINC по ссылке выше
Для тебя здесь важно
(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldSize oldBlock temBl *error* att attr apnum:tag pt) ;==== Local functions ============ ;;[b]Эта и есть нужная тебе функция [/b] ;; obj — Ename or Vla object of block ;; att_list — list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...) ;; Tag_Name — string ;; Value — string (defun mip-block-setattr-bylist (obj att_list / txt lst) (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) (setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) (if (and obj (not(vlax-erased-p obj)) (= (vla-get-ObjectName obj) "AcDbBlockReference") (eq :vlax-true (vla-get-HasAttributes obj)) (vlax-property-available-p obj 'Hasattributes) (vlax-write-enabled-p obj) ) (vl-catch-all-apply (function (lambda () (foreach at (vlax-invoke obj 'Getattributes) (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) (vla-put-TextString at (cdr lst)) ) ) ) ) ) ) ) ;==== Local functions END ============ .... ;;;[b]Это п.1[/b] (setvar "ATTDIA" 0)(setvar "ATTREQ" 0) .... ;;;[b]Это п.2[/b] (command "_-insert" apnum:Block "_s" apnum:Size pause "0") .... ;;;[b]Это п.3[/b] (mip-block-setattr-bylist (entlast) (list(cons (strcase (mip-conv-to-str apnum:tag)) (strcat apnum:Pref(itoa apnum:Num)apnum:Suf)))) .... (setvar "ATTDIA" att)(setvar "ATTREQ" attr) ....
3 29 февраля 2008г. 11:04:16
Re: Помогите переделать программу автоматической нумерации (41 ответов, оставленных в LISP)
> KAI
(initget "Yes No ?? ??? _Yes No Yes No") - это скопированный в буфер русский текст на английской раскладке. Должно выглядеть так
(initget "Yes No Да Нет _Yes No Yes No")
[code]
По поводу apnum для 1-го атрибута и инкремента, у меня есть модифицированный вариант BINC
Правда имя блока и имя тага атрибута пока надо прописывать в программе, но можно прикрутить диалог настройки на блок и имя атрибута
Прока прописывать имена нужно здесь
[code]
(setq apnum:Block "BlockName") ;_Впиши имя блока здесь (Enter a name of the block here )
(setq apnum:tag "Nomer") ;_Впиши имя тага атрибута (Enter a tag name of attribute)
[/code]
Текст команды
[code]
(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldInc
oldSize oldBlock temBl *error* att attr apnum:tag pt)
;====================================================================
(setq apnum:Block "BlockName") ;_Впиши имя блока здесь (Enter a name of the block here )
(setq apnum:tag "Nomer") ;_Впиши имя тага атрибута (Enter a tag name of attribute)
;===================================================================
;==== Local functions ============
(defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
(defun mip-conv-to-str (dat)
(cond ((= (type dat) 'INT)(setq dat (itoa dat)))
((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
((null dat)(setq dat ""))
(t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;; Tag_Name - string
;; Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
(if (and obj
(not(vlax-erased-p obj))
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(eq :vlax-true (vla-get-HasAttributes obj))
(vlax-property-available-p obj 'Hasattributes)
(vlax-write-enabled-p obj)
)
(vl-catch-all-apply
(function
(lambda ()
(foreach at (vlax-invoke obj 'Getattributes)
(if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
(vla-put-TextString at (cdr lst))
)
)
)
)
)
)
)
;==== Local functions END ============
(if(not apnum:Size)(setq apnum:Size 1.0))
(if(not apnum:Num)(setq apnum:Num 1))
(if(not apnum:Inc)(setq apnum:Inc 1))
(if(not apnum:Pref)(setq apnum:Pref ""))
(if(not apnum:Suf)(setq apnum:Suf ""))
(setq oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
oldPref apnum:Pref oldSuf apnum:Suf
apnum:Block (mip-conv-to-str apnum:Block)
apnum:tag (mip-conv-to-str apnum:tag)
oldEcho (getvar "CMDECHO")
att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
(setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
(setvar "CMDECHO" 0)
(setq apnum:Pref
(getstring T
(strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
(if(= "" apnum:Pref)(setq apnum:Pref oldPref))
(if(= " " apnum:Pref)(setq apnum:Pref ""))
(setq apnum:Suf
(getstring T
(strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
(if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
(if(= " " apnum:Suf)(setq apnum:Suf ""))
(setq apnum:Num
(getint
(strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
(if(null apnum:Num)(setq apnum:Num oldStart))
(setq apnum:Inc
(getint
(strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
(if(null apnum:Inc)(setq apnum:Inc oldInc))
(setq apnum:Size
(getreal
(strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
(if(null apnum:Size)(setq apnum:Size oldSize))
(if apnum:Block(setq oldBlock apnum:Block))
;;; (setq temBl
;;; (entsel(strcat "\nSelect block <"
;;; (if apnum:Block apnum:Block "not difined") "> > "))); end setq
(cond
((null (tblsearch "BLOCK" apnum:Block))
(alert (strcat "Block " apnum:Block " not found"))
(setq apnum:Block nil)
); end condition #0
((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
(setq apnum:Block oldBlock)
); end condition #1
((and tembl (= 1 (cdr(assoc 66(entget(car temBl))))))
(setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
); end condition #2
(t
(princ "\nBlock not contains attribute! ")
(setq apnum:Block nil)
); end condition #3
); end cond
(if apnum:Block
(progn
(while T
(princ "\n>>> Pick insertion point or press Esc to quit <<<\n")
(command "_-insert" apnum:Block "_s" apnum:Size pause "0")
(mip-block-setattr-bylist (entlast)
(list(cons (strcase (mip-conv-to-str apnum:tag))
(strcat apnum:Pref(itoa apnum:Num)apnum:Suf))))
(setq apnum:Num (+ apnum:Num apnum:Inc))
); end while
); end progn
); end if
(setvar "ATTDIA" att)(setvar "ATTREQ" attr)
(princ)
)
[/code]
4 8 мая 2007г. 10:12:48
Re: Пожалуйста, помогите автоматизировать вставку блока. (24 ответов, оставленных в LISP)
> Сергей
Модернизированный apnum. Теперь binc
(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldSize oldBlock temBl *error* att attr apnum:tag pt) ;==== Local functions ============ (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error* (defun mip-conv-to-str (dat) (cond ((= (type dat) 'INT)(setq dat (itoa dat))) ((= (type dat) 'REAL)(setq dat (rtos dat 2 12))) ((null dat)(setq dat "")) (t (setq dat (vl-princ-to-string dat))))) ;; obj - Ename or Vla object of block ;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...) ;; Tag_Name - string ;; Value - string (defun mip-block-setattr-bylist (obj att_list / txt lst) (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) (setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) (if (and obj (not(vlax-erased-p obj)) (= (vla-get-ObjectName obj) "AcDbBlockReference") (eq :vlax-true (vla-get-HasAttributes obj)) (vlax-property-available-p obj 'Hasattributes) (vlax-write-enabled-p obj) ) (vl-catch-all-apply (function (lambda () (foreach at (vlax-invoke obj 'Getattributes) (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) (vla-put-TextString at (cdr lst)) ) ) ) ) ) ) ) ;==== Local functions END ============ ;==================================================================== (setq apnum:Block "BlockName") ;_Впиши имя блока здесь (setq apnum:tag "Nomer") ;_Впиши имя тага атрибута ;=================================================================== (if(not apnum:Size)(setq apnum:Size 1.0)) (if(not apnum:Num)(setq apnum:Num 1)) (if(not apnum:Pref)(setq apnum:Pref "")) (if(not apnum:Suf)(setq apnum:Suf "")) (setq oldStart apnum:Num oldSize apnum:Size oldPref apnum:Pref oldSuf apnum:Suf apnum:Block (mip-conv-to-str apnum:Block) apnum:tag (mip-conv-to-str apnum:tag) oldEcho (getvar "CMDECHO") att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq (setvar "ATTDIA" 0)(setvar "ATTREQ" 0) (setvar "CMDECHO" 0) (setq apnum:Pref (getstring T (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :"))) (if(= "" apnum:Pref)(setq apnum:Pref oldPref)) (if(= " " apnum:Pref)(setq apnum:Pref "")) (setq apnum:Suf (getstring T (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :"))) (if(= "" apnum:Suf)(setq apnum:Suf oldSuf)) (if(= " " apnum:Suf)(setq apnum:Suf "")) (setq apnum:Num (getint (strcat "\nSpecify start number <"(itoa apnum:Num)">: "))) (if(null apnum:Num)(setq apnum:Num oldStart)) (setq apnum:Size (getreal (strcat "\nSpecify block scale <"(rtos apnum:Size)">: "))) (if(null apnum:Size)(setq apnum:Size oldSize)) (if apnum:Block(setq oldBlock apnum:Block)) ;;; (setq temBl ;;; (entsel(strcat "\nSelect block <" ;;; (if apnum:Block apnum:Block "not difined") "> > "))); end setq (cond ((null (tblsearch "BLOCK" apnum:Block)) (alert (strcat "Block " apnum:Block " not found")) (setq apnum:Block nil) ); end condition #0 ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block)) (setq apnum:Block oldBlock) ); end condition #1 ((and tembl (= 1 (cdr(assoc 66(entget(car temBl)))))) (setq apnum:Block(cdr(assoc 2(entget(car temBl))))) ); end condition #2 (t (princ "\nBlock not contains attribute! ") (setq apnum:Block nil) ); end condition #3 ); end cond (if apnum:Block (progn (while T (princ "\n>>> Pick insertion point or press Esc to quit <<<\n") (command "_-insert" apnum:Block "_s" apnum:Size pause "0") (mip-block-setattr-bylist (entlast) (list(cons (strcase (mip-conv-to-str apnum:tag)) (strcat apnum:Pref(itoa apnum:Num)apnum:Suf)))) (setq apnum:Num (1+ apnum:Num)) ); end while ); end progn ); end if (setvar "ATTDIA" att)(setvar "ATTREQ" attr) (princ) ) (princ "\nType BINC to run")
В этих строчках
;==================================================================== (setq apnum:Block "BlockName") ;_Впиши имя блока здесь (setq apnum:tag "Nomer") ;_Впиши имя тага атрибута ;===================================================================
вместо BlockName впиши имя блока, вместо Nomer - свое имя тага атрибута
И по прежнему номер-целое число. В твоем случае BTH 1. и BTH 2. нужно задавать как префикс
Сообщений найдено 4
Страницы 1
Форумы CADUser → Результаты поиска
Форум работает на PunBB, при поддержке Informer Technologies, Inc