Занимавам се от близо 20 години с програмиране в ACAD
Имам много програми в областта на електропроектирането
Интересува ме има ли други хора, които работят в тази област и имат ли желание да обменяме идеи и разработки

Искам да попитам от позицията на ПОТРЕБИТЕЛ .
Съществува ли в България реална възможност при формулиране на конкретен проблем , да се поръчва разработка на допълнения към AutoCAD (или МS Excel/Word) . Става въпрос за малки автоматизации или обвързване със съществуващи приложения ... нямам конкретна Идея , но на мен ми се струва Логично , ако някой се замисли ...

Точно за това повдигам тази тема
Имам контакти с хора, които правят точно такива по-малки или по-значителни разработки за конкретни проблими.
Идеята ми е да се обособи форум, в който да се обменя опит именно в такава насока - програми или модули, които вършат точно определена работа (например програмите ми за проектиране на вътрешни електроинсталации ускоряват проектирането поне 10-20 пъти).
Проблемът е че прябва да се намери начин трудът на такива хора да се овъзмездява по някакъв начин (не е задължително с пари). И това може би е първата тема - как може да се направи така, че и двете страни да имат полза.
Колективният опит и разум може да намери решението.

Браво за идеята StSt ! Искренно се надявам да се осъществи !
Имам известни познания по Auto-Lisp и считам че подобен форум би
могъл да бъде полезен.

От Мен главно Морална подкрепа
StSt ако може пиши ми e-mail или нещо друго на ki_ko_ko@abv.bg ,
ако се наложи да мога да те "притеснявам" лично ?
Нямам идея да ли в този Форум е удачно ... , но Хората в България са малко и ... де да знам

За да предизвикам все пак някакъв интерес към темата предлагам една програмка, която връща координатите на точка симетрична на две посочени точки. Тя е полезна при чертане на ос на път (например).

;Връща точка симетрична спрямо две точки в 2D чертеж
(defun simi (p1 / p2)
;р1 - точка или списък от две точки
;р2 - точка
(if (= (type (cadr p1)) 'REAL); ако първият елемент от р1 е реално число - р1 е точка
(setq p2 (getpoint p1 "\nEnter second point ") ); въвеждане на втора точка
(setq p2 (cadr p1) p1 (car p1)); отделяне на двете точки от списъка р1
);if
(polar p1 (angle p1 p2) (* (distance p1 p2) 0.5)); връща координатите на симетричната точка
);simi
; въвеждане на две точки за изчисляване на координатата
(defun sim(/ p1 p2)
(setq
p1 (getpoint "\nEnter fist point ");първа точка
p2 (getpoint p1 "\nEnter second point ");втора точка
)
(simi (list p1 p2));извиква функция 'SIMI със списък от две точки
);sim


Тя може да се прикачи към бутон от тулбар (например "Object Snap") и да се ползва като особена точка (като "EndPoint" "MidPoint" ...).
Ос на улица или на детайл се чертае като се избере команда "LINE" (примерно), натиска се бутон "Симетрала", посочват се двете точки, на които ще бъде симетрична началната точка, след това процеса се повтаря за следващата точка и т.н.

Аз продължавам да натискам по въроса

Предлагам ви програмка за прекъсване (TRIM) на обекти извън някаква затворена полилиния

;TRIM на обекти извън полилиния
(defun trimf (/ plrim plf plf1 p1 p2 nn)
(if (and
(setq plrim (entsel "\nИзберете полилиния за граница"))
(= "LWPOLYLINE" (cdr(ASSOC 0 (entget (car plrim)))))
);and
(progn
(COMMAND "zoom" "e")
(setq plrim (car plrim))
(COMMAND "offset" 1 plrim (getvar "extmin")(COMMAND))
(setq plf (entlast)
p1 (cdr(ASSOC 10 (entget plf)))
plf1 (entget plf)
plf1 (append plf1 (list (cons 10 p1))))
(FOREACH nn (cdr(member (cons 10 p1) plf1))
(if (= 10 (car nn))
(progn
(setq p2 (cdr nn)
);nab (csel1 plrim)
(COMMAND "trim" plrim """f" p1 p2 ""(COMMAND))
(setq p1 p2)
);progn
);if vertex
);FOREACH
(entdel plf)
(COMMAND "zoom" "p")
(princ)
);progn
);if LWPOLYLINE
);trimf

Програмката трябва да се копира във файл (например "TRIMF.LSP") в някоя директория, описана в SEARCH FILE PATH (например SUPPORT), зарежда се, като в командния ред се пише

(LOAD "TRIMF")

и се стартира като в командия ред се пише

(TRIMF)


посочва се полилинията, по която се изрязва и това е.

Не се изрязват блокове, текстове и др.

А бе хора!
Някой интересува ли се от това ACAD да върщи работа вместо него?
Ако има такъв ще му помогна с каквото мога.
За да тръгне работата предлагам да направя програма на всеки, който опише достатъчно разбираемо проблема си.

Имам едно въпросче относно Auto Lisp-a.
Имам plug-in написан на protected AutoLisp.
Същесгвува ли софт, който отстранява
защитата и позволяващ редактирането
му с цел приспособяване на въпросния
plug-in към конретните условия?

Има няколко начина за защита на LISP файлове - чрез компилиране, чрез т.н. "келвиниране" и др.
Съществува доста програми за целта.
Идеята им е предотвратят промяна на съдържанието и затова е трудно да се пробият. Преди време бях чел нещо по въпроса за криптиране и разкриптиране на такива файлове, но сега не ми идва на ум къде.
До този момент не съм разкриптирал LISP файл - по ми е лесно да напиша програма, която върши подобна работа

В отговор на:

---

А бе хора!

---

DCL фала е файл с описание на диалогови прозорци в LISP.
Това е обикновен ASCII файл но има собствен език

Ако е писана на AutoLisp (.lsp)- има доста програми, които декодират. Проблемът е обаче, че освен кодиране, фаилът най-вероятно е и компресиран - т.е. няма да има никакви коментари, нови редове, интервали и пр. и доста често е по-лесно да напишеш наново такава програма, отколкото да си играеш да я хакваш и да я преправяш. Ако обаче е писана на visuallisp и е компилирана (.vlx) - аз поне не съм виждал да има нещо като дисассемблер (ама не съм се и интересувал де)

Autolisp e най-удобния и лесен език за програмиране на AutoCAD, но е малко ограничен не подържа масиви, a и при рабата с текстови файлови има съвсем малко команди.Хората , които програмират AutoCAD обикновено след Autolisp минават на Visual Basic в среда AutoCAD или пък на Visula C.

Ето една програма и от мен, която променя височината на текстоветe в определено ниво

(defun c:changehigh()
(setq nivo(getstring "\n Input layer:"))
(setq vis(getreal "\n Input hight:"))
(setq ss (ssget "X" (list (cons 8 nivo) (cons 0 "TEXT"))))
(setq len (sslength ss))
(setq n 0)
(repeat len
(setq spis (entget(ssname ss n)))

(setq spis (subst (cons 40 vis) (assoc 40 spis) spis))
(setq n (1+ n))
(entmod spis)
)
)

LISP (List Processor) работи със списъци, а списъците могат да бъдат организирани по най-различен начин и да имат структура далече по-сложна от многомерните масиви и средствата му за работа със списъците са напълно достатъчно.

Педлагам програмка за изчертаване на рамка на чертежа в LAYOUT в зависимост от размера на предварително настроен PAGE SETUP, като оставя свободно поле, рамката е с опашка за прикачване към папка с машинка и знаци за сгъване



(DEFUN GET-LAYOUT (/ OLSOMODE LAY PT1 PT2 PTI ROT INCH LW LH DL DR DB DT ENTLAY br br1 dob ptend )
(VL-LOAD-COM)
(SETQ OLSOMODE (GETVAR "OSMODE"))
(SETVAR "OSMODE" 16845)
(setq LAY(HANDENT(vla-get-Handle(vla-get-layout(vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))))))
ENTLAY (ENTGET LAY)
);setq
(if(not(VL-STRING-SEARCH "NONE" (STRCASE(cdr(ASSOC 2 ENTLAY)))))
(PROGN
(setq
PT1 (CDR(ASSOC 10 ENTLAY))
PTI (LIST (CDR(ASSOC 46 ENTLAY))(CDR(ASSOC 47 ENTLAY)))
ROT (CDR(ASSOC 73 ENTLAY))
INCH(CDR(ASSOC 72 ENTLAY))
LW(CDR(ASSOC 44 ENTLAY))
LH(CDR(ASSOC 45 ENTLAY))
DL(CDR(ASSOC 40 ENTLAY))
DB(CDR(ASSOC 41 ENTLAY))
DR(CDR(ASSOC 42 ENTLAY))
DT(CDR(ASSOC 43 ENTLAY))
)
(IF (= INCH 0)(SETQ INCH 2.54))
(COND
((= ROT 1)
(SETQ PT2 (MAPCAR '+ PTI (LIST (- LH DT DB)(- LW DR DL))))
);=1
((= ROT 0)
(SETQ PT2 (MAPCAR '+ PTI (LIST (- LW DR DL) (- LH DT DB))))
);=0
((= ROT 3)
(SETQ PT2 (MAPCAR '+ PTI (LIST (* -1(- LH DT DB))(* -1(- LW DR DL)))))
);=3
);COND
(if (and
(setq nab (ssget"c" PTI (MAPCAR '+ PTI '(0.1 0.1) )))
);and
(COMMAND "erase" nab (COMMAND))
);if
(COMMAND "RECTANGLE" (MAPCAR '+ PTI '(25 10)) (MAPCAR '+ PTI PT2 '(-10 -10)))
;(COMMAND "RECTANGLE" PTI (MAPCAR '+ PTI PT2 ))
;÷åðòàå ðàìêà íà ÷åðòåæà
; (COMMAND "RECTANGLE" (MAPCAR '+ PTI '(20 10)) (MAPCAR '+ PTI PT2 '(-10 -10)))
(if (> (cadr pt2) 297.0)
(PROGN
(COMMAND "pline" pti
(MAPCAR '+ pti '(0 295.0))
(MAPCAR '+ pti '(20.0 295.0))
(MAPCAR '+ pti (list 20 (cadr pt2)))
(MAPCAR '+ PTI PT2 )
(MAPCAR '+ pti (list (car pt2) 0))
pti
"")

);PROGN
(COMMAND "RECTANGLE" PTI (MAPCAR '+ PTI PT2 ))
);if
(COMMAND "line" (mapcar '+ pti (list 0 (/ 295.0 2)))
(mapcar '+ pti (list 0 (/ 295.0 2))'(25 0))"")
(COMMAND "solid" '(-2 0) '(0 5) '(2 0) "" "")
(setq solid (entlast)dll 190)
(cond
((> (car pt2)(+ 210 dll))
(setq br (fix(* 2(/(fix(/ (-(car pt2) 210)dll))2.0)))
dop (-(car pt2)(* br dll)210)
i 1
ptend (list(+ (car pti)(car pt2)) (cadr pti))
br1 -2.0
)
(if (< dop 100)(setq br (1- br) dop (-(car pt2)(* br dll)210) ) )
(setq br1 (- br1 (rem br 2))nab (ssadd))
(REPEAT br
(COMMAND "copy" solid "" '(0 0) (MAPCAR '- ptend (list (* i dll) 0)))
(setq i (1+ i)
nab (ssadd (entlast)nab))
);REPEAT
(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0))
(setq nab (ssadd (entlast)nab))
(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0))
(setq nab (ssadd (entlast)nab))
(if (= br1 -3.0)(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0)))
(setq nab (ssadd (entlast)nab))
(COMMAND "mirror" nab "" (mapcar '+ pti (mapcar '/ pt2 '(2 2)))
(mapcar '+ pti (mapcar '/ pt2 '(2 2))'(2 0))
"N")
); L> 395
);cond
(entdel solid)
(if (> (cadr pt2)295)
(PROGN
(COMMAND "solid" (MAPCAR '+ ptend '(0 -2))
(MAPCAR '+ ptend '(-5 0))
(MAPCAR '+ ptend '(0 2)) "" "")
(setq solid (entlast))
(COMMAND "array" solid "" "R"
(1+(fix (/ (cadr pt2)295.0)))
1
295.0
)
(entdel solid)
);PROGN
);if H>295
);PROGN
(ALERT "НЯМА ИЗБРАН ПЛОТЕР
\nОТ \"PAGE SETUP\" ИЗБЕРЕТЕ ПЛОТЕР, РАЗМЕР И ОРИЕНТАЦИЯ НА СТРАНИЦАТА \n
И СТАРТИРАЙТЕ ОТНОВО '(GET-LAYOUT)'")
);if not None plotter
(SETVAR "OSMODE" OLSOMODE)
);GET-LAYOUT

Запишете програмата като файл "GET-LAYOUT.LSP" в директория "SUPPORT", заредете го с
(lLOAD "GET-LAYOUT")

Изберете LAYOUT, изберете плотер, размер на страницата (може и CUSTOM), ориентация (Portrait или Landscape) след това стартирайте програмата с

(GET-LAYOUT)

това е всичко

Аз познавам няколко човека ,който пишата програми за улесняване на работта на тях и на техните колеги, но не познажам някой на които му оценяват този труд и му плащат за Autolisp. По тази причина много хора се отказаха от програмиране на AutoCAD.Ще съм ти благодарена , ако се намери някой ,който плаща.

И на мене никой не ми плаща.
Обаче ми доставя голямо удоволствие да правя програми, които ми улеснавят работата.

Проблема с оценяването си е Постоянен , една от Основните причини е НЕУК масов потребител ... Т.Е. даже не се сеща , че може и по-лесно !
Приключвам с философстването
БЕЗ ДА ОБИЖАМ НИКОЙ !
Аз съм склонен да плащам .
Примерна ситуация при Мен :
1т. Налага ми се периодично да пресмятам DeltaY / (DeltaX*10) на линия .
2т. Потенциална екстра е изчислената стойност да се присвои на DText .
Какво ми минава през Тиквата Проста на 10-тият път от Хамалогията ...
- Брей няма ли някакъв трик ?
- Хъм , ако ползвам Калкулатора в 2006 , май ... не , не е работа !
- Сигурно с Lisp-че или VBA Макрос ще стане или като ползвам едно Приложение+Diesel ... ?
След "цигара време" ...
- Майната му ... не е работа за мен , че си го смятам на ръка ... ако не ме домързи може да поровя в Internet или да питам някой ... то и без това , аз го правя щото другите ме набутват по тоя начин ... иначе Аз вече да съм си ги сметнал в Excel (то и от там идвам) и да продължавам нататък
Такаааа ...
За 1т. Аз Скомният веднага давам ~5лв. , т.е. числото се появява в командният ред . При положение , че навия колегите че е много идейно цената може да варира ...
За 2т. е т'ва според мен си е по-Голяма екстра , трябва да се навиват колегите че си заслужава , но цената почва от 10лв. нагоре (в зависимост от ...)
Ако пък нещата се вкарат в меню и бутон-че , ще се плаща повече .... и т.н. и т.н.
Да не вземете да правите нещо !!! Казах , че минавам първо през Excel и там мога да си ги сметна ... и тези цифри служат само за ориентир ! Няма да си остават в чертежа !Тези неща са главно за "Другите от Острова"
Това е накратко Фабулата .
Определено има много процедурни Неуредици ... пък и за 10-15лв. ... по-добре човек да почива .
Повтарям , БЕЗ ДА ОБИЖАМ НИКОЙ !

може да се вземе подробна информация за програмиране на LISP.

Ще е добре да се позанимавам и аз , хем интересно, хем полезно

Прекомерната употреба на LINUX води до пристрастяване!

Запиши долната програмка като файл "DyDx.lsp" в SUPPORT. Направи си бутон с Customyze, от таба "Commands" избери "User Defined" в лявото поле избери "User Defined Button", вмъкни го в който искаш туулбар на което искаш място (излиза една дебела черта) чрез "влачене", с кликване върху бутона отвори прозореца за редактиране, в полето "User Defined Button" напиши каквото искаш да се показва в ToolTyp. В полето "Macro associated widt this button" запиши


(eval (load "DyDx"))

Избери картинка или си нарисувай с "Edit"
Натискаш "Apply" "Cancel" и имаш готов бутон

Начертай линия, натисни новия бутон, посочи линията и след това мястото, на което да се изпише резултата


;DltaY/(DeltaX*10) Lines
(defun DyDx (/ lin pt1 pt2 dpt result)
(if (and
(setq lin(entsel "\nSelect LINE: "))
(= "LINE" (cdr(assoc 0 (entget (car lin)))))
);and
(PROGN
(setq lin (car lin)
pt1 (cdr(ASSOC 10(entget lin)))
pt2 (cdr(ASSOC 11(entget lin)))
dpt (MAPCAR '- pt1 pt2)
result (/ (cadr dpt)(* 10 (car dpt)))
);setq
(COMMAND "text" (getpoint "\nStart point of TEXT: ") "" "" (RTOS result 2 4))
);PROGN
(if lin (ALERT "This is not a LINE")(ALERT "No Selection"))
);if
);DyDx
'(DyDx)

На български имаше една книжка мисля че се казваше "Програмиране на AutoLISP" но не съм много сигурен. В нея са дадени началните уроци и основните положения. След това започваш с HELP за разработчици, който се извиква в редактора на LISP с F1 и там са описани всички функции (LISP е функционален език) както на LISP, така и на VisualLISP и VBA

След като помислих малко реших, че може би искаш да обработваш повече линии и затова ги експортваш в Exel. Затова промених малко програмата, така че можеш предварително да избереш необходимите линии или да ги посочиш след като стартираш програмата. Резултатът се изписва в близост да средата на линията. Височината на текста се задава предварително с TEXTSIZE. Останалите обяснения от сутринта важат и тук.

;Dy/10Dx group lines
(defun DyDx (/ nab i lin)
(PROMPT "Select nested LINES")
(if (setq i 0 nab (ssget))
(REPEAT (sslength nab)
(setq lin (ssname nab i)
i(1+ i))
(DyDx1 lin)
);REPEAT
);if nab
);DyDx
(defun DyDx1 (lin / pt1 pt2 pti dpt result)
(if (= "LINE"(cdr(ASSOC 0 (entget lin))))
(progn
(setq pt1 (cdr(ASSOC 10 (entget lin)))
pt2 (cdr(ASSOC 11 (entget lin)))
dpt (MAPCAR '- pt1 pt2)
result (/ (cadr dpt)(* 10 (car dpt)))
);setq
(COMMAND "text" "j" "BC"
(polar pt1 (ANGLE pt1 pt2)(/(DISTANCE pt1 pt2)2.0))
"" (/ (* (ANGLE pt1 pt2) 180.0)pi)
(rtos result 2 4)
(COMMAND))

);progn
);if LINE
);DyDx1
'(DyDx)

Благодаря !
Започвам да се притеснявам от Голямата си Уста !
Според мен вече дължа 20-тина лв. + (поне още 5лв. на друго място)
Стартирал съм процедура по информиране на колегите , но съм песимистично настроен ... направих бутончета и меню .... сложил съм ги ...

А пробва ли ги в действителен чертеж

Да си призная пробвах това , Главно в с няколко начертани обекта и в два-три малки чертежа :
-------------------------------------------------------------------------
(defun C:DyDx (/ lin pt1 pt2 dpt result)
(if (and
(setq lin(entsel "\nСелектирай LINE: "))
(= "LINE" (cdr(assoc 0 (entget (car lin)))))
);and
(PROGN
(setq lin (car lin)
pt1 (cdr(ASSOC 10(entget lin)))
pt2 (cdr(ASSOC 11(entget lin)))
dpt (MAPCAR '- pt1 pt2)
result (/ (cadr dpt)(* 10 (car dpt)))
);setq
(COMMAND "text" (getpoint "\nСтартова точка на TEXT: ") "" "" (strcat "I=" (RTOS result 2 4)))
);PROGN
(if lin (ALERT "Tова не е LINE !")(ALERT "No Selection"))
);if
);DyDx
'(DyDx)
------------ и това Демо Версия ------------------------------------------------------
Sub Test()
' наклон на линия получен от деленето на deltaY и deltaX*10
Label1: Dim returnObj As AcadObject
Dim basePnt As Variant
ThisDrawing.Utility.GetEntity returnObj, basePnt, vbCrLf & "Изберете LINE: "
If TypeOf returnObj Is AcadLine Then
Dim lineObj As AcadLine
Set lineObj = returnObj
Dim tmpDbl As Double
tmpDbl = lineObj.Delta(1) / (lineObj.Delta(0) * 10)
ThisDrawing.Utility.Prompt "DY/(DX*10)=" & Format(tmpDbl, "0.0000") & vbCrLf
MsgBox "Наклон Y към X*10 --> I= " & Format(tmpDbl, "0.0000"), vbDefaultButton1, "Наклон на Линията ДЕМО ВЕРСИЯ"
Else: MsgBox "Това не е LINE !", vbCritical, "ГРЕШКА !"
GoTo Label1
End If
End Sub
---------------------------------------------------------------------
Ако има пробеми със смятането и др. големи не съм забелязал !

Ако искаш само съобщение при единичната версия промени реда с
(command "TEXT" ......
със

(alert (strcat "I=" (RTOS result 2 4)))

Имай в предвид, че така написаните програми няма да работят с вертикални линии (ще гърми заради делението на 0), няма да връща коректен резулатат ако работиш в координатна система различна от базовата WCS, или UCS, която не е паралелна на WCS и накрая можеш да я използваш само с LINE, но не можеш да я използваш с Polyline или LWPolyline.
Това общо взето не е хич страшно, защото ти може изобщо и да не използваш горните случаи, но все пак ако ги използваш - да не се чудиш откъде ще ти идват проблемите

Pin е прав.
Затова моля за извинение.
Решението е в първия ред на програмата да се запише

(command "UCS" "W")
а на последния
(command "UCS" "P")
това решава проблема с координатната система - ще дава текста на друго място.
Резултатите не се влияят от координатната система - функция entget на AutoLISP връща координатите на точките в световна координатна система.
За да се избегне деленето на нула предлагам

(IF (/= (CAR dpt)0.0)(SETQ result (/ (cadr dpt)(* 10.0 (car dpt))))(SETQ result (EXPT 10.0 10)))


Всъщност това беше и идеята ми да пусна тази тема - обмен на идеи
Благодаря на Pin

или пресечени от затворена полилиния


;избира обекти изцяло в затворена полилиния
(defun wsel (/ pol spi NN)
(setq pol (car(entsel "\nSelect polyline "))SPI (LIST))
(wsel1 pol)
);wsel
(defun wsel1 (pol / spi NN PTMIN PTMAX)
(SETQ PTMIN (GETVAR "EXTMAX")PTMAX (GETVAR "EXTMIN"))
(if (=(cdr(assoc 0 (ENTGET pol))) "LWPOLYLINE")
(progn
(FOREACH NN (ENTGET pol)
(IF(= 10(CAR NN))
(SETQ SPI (CONS (CDR NN)SPI)
PTMIN (LIST (MIN (CAR PTMIN)(CAR (CDR NN)))(MIN (CADR PTMIN)(CADR (CDR NN))))
PTMAX (LIST (MAX (CAR PTMAX)(CAR (CDR NN)))(MAX (CADR PTMAX)(CADR (CDR NN))))
);SETQ
);IF NN=10
);FOREACH
;;; (COMMAND "ZOOM" "W" PTMIN PTMAX)
(setq pol (ssget "WP" spi))
;;; (COMMAND "ZOOM" "P")
POL
);progn
(ALERT "This is NOT 'POLYLINE'!")
);IF
);wsel1
;избира обекти пресечени от затворена полилиния
(defun csel (/ pol spi NN)
(setq pol (car(entsel "\nSelect polyline "))SPI (LIST))
(csel1 pol)
);csel
(defun csel1 (pol / spi NN PTMIN PTMAX)
(SETQ PTMIN (GETVAR "EXTMAX")PTMAX (GETVAR "EXTMIN"))
(if (=(cdr(assoc 0 (ENTGET pol))) "LWPOLYLINE")
(progn
(FOREACH NN (ENTGET pol)
(IF(= 10(CAR NN))
(SETQ SPI (CONS (CDR NN)SPI)
PTMIN (LIST (MIN (CAR PTMIN)(CAR (CDR NN)))(MIN (CADR PTMIN)(CADR (CDR NN))))
PTMAX (LIST (MAX (CAR PTMAX)(CAR (CDR NN)))(MAX (CADR PTMAX)(CADR (CDR NN))))
);SETQ
);IF
);FOREACH
;;; (COMMAND "ZOOM" "W" PTMIN PTMAX)
(setq pol (ssget "CP" spi))
;;; (COMMAND "ZOOM" "P")
POL
);progn
(ALERT "This is NOT 'POLYLINE'!")
);IF
);csel1

За да изберете елементите в определена област с произволни граници първо очертайте с една полилиния границата, заредете програмата и стартирайте

(wsel)

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

(csel)

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

Няма за какво да бъдеш извиняван, а по-скоро похвален. Програмките са повече от добри за някой, който трябва сега да започва от 0 - нали ако му напишеш по-дълга програма ще го шашнеш!

Аз си позволих да вметна тази забележка, защото с това делене 1/10 ми светна,че може би става въпрос за геодезически проекти и там геодезическата координатна система е X=North, Y=East, Z=Height и много от геодезистите държат да си работят в координатна система,в която Х си е по хоризонталата, обаче по вертикалата вместо Y имат Z. Та при такива ситуации (хипотетично) може да се получат нЕкои аномалии

P.S. А ти си си избрал ник, точно като мойте инициали (истнските)

Да знаеш, че и моите са такива

Искам да попитам, доколко е перспективно програмирането на LISP.
Имам слаби познания по този език, на все пак мога да напиша някоя елементарна програма. Но се чудя, дали не трябва да заложа на други езици за програмиране като VBA или С++?

Чистия AutoLISP е ограничен, но VisualLisp има доста сериозни възможности, включително и достъп до Properties и Metods от VBA. Манипулирането на чертожните примитиви е по-лесно. Слабост му е управлението на комплексни програми, включващи и други офис приложения, диалоговите прозорци са доста дървени. Много силна страна според мен са възможностите за обработка на списъци - там можеш да направиш логически конструкции (връзки и т.н.), каквито трудно се правят в обикновените бази данни и работата с тях е доста лесна. Трудно е в началото, защото списъците са по-особен вид организация на данните, но като свикнеш с тях след това е много приятно. Друга особена конструкция са реакторите (нещо като Events в обектните езици) - доста по-сложно е. Основното предимство на LISP е възможността да го ползваш в командния ред директно - много е удобно.
От опита, който имам, стигнах до заключението, че организацията на данните в чертежа е най-важния момент - езикът на който са написани програмите е по-маловажен. Зависи от начина на мислене и навиците на програмиста. Ако имаш опит с VB, C++ или друг език - по-добре продължи в тази насока. Няма най-добър език (иначе другите няма да съществуват).
Ако желаеш, дай имейл да ти пратя едно файлче за организация на данните и възможностите за кодиране на информация в чертожните елементи.

Като чета написаните работи , май трябва да се появи и тема "интелигентният чертеж" !

Това е функция, която връща ъгъла(в градуси), под който е начертан посочен елемент.
Можете да го включите в ACAD.LSP и да го прикачите към бутон от туулбар.
Когато искате да завъртите елемент или набор от елементи след избора им и посочване на базова точка натискате бутона или пишете в командния ред
(to-ang)
избирате точка от линия или полилиния и избраното се завърта на избрания ъгъл. Ако не посочите елемент програмата пита за две точки и връща ъгъла между тях. Работи с всякакви елементи, но трябва да се внимава с избора на точката на посочване. Трябва да се има предвид, че понякога завъртането става на 180 градуса и трябва да се прави още едно въртене.
Може да се направи и бутон за изправяне, т.е. завърнате до 0 градуса така
(* -1 (to-ang))

;Връща ъгъла на посочен елемент
(defun to-ang ( / a b)
(setq
a (entsel)
);setq
(if a
(setq
a(cadr a)
b(osnap a "per")
a(osnap a "nea")
);if a
(progn
(setq a (getpoint "\nSelect two point. First point: ")
b (getpoint a "\nSecond point: ")
)
);if not a
);if
(setq
a (* (angle a b) (/ 180 pi))
);setq
);to-ang

Приемам
Мога да предложа за обсъждане някои разсъждения относно организацията на елементите от чертежа.
Нека, обаче, да се обадят повече хора. Не знам доколко ги интересува. Виждам, че настоящата тема се посещава доста, но мнения има само от 3-4 души. Ако само това са заинтересованите можем да си разменим имейли и да си говорим само ние, няма причина да досаждаме на другите.

Благодаря за отговара.
Познания по други езици нямам, така че ако искам да ги ползвам трябва да започна от нулата. Затова и питам, дали да се захващам с това.
Що се отнася до диалоговите прозорци, точно те ми намалиха ентусиазма към програмирането на LISP. Твърде много усилия за една малка част от общата програма. Но според мен те са твърде важни. Ако не можеш да си комуникираш с програмата по бърз и интуитивен начин, то тогава се връщаш във времето на DOS.

Въпросът за организация на данните,разбира се, е много важен. Но според мен много зависят от задачата, която се решава. Не знам, дали може да се унифицират по някакъв начин.

LISP е доста стар, мощен и оригинален език.

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

със сигурност трябва да има такава тема, ама тя трябва да е закована най отгоре, обаче не знам колко хора влизат в тоя клуб за да я прочетат.
Виждал съм чертеж с 5 линии на кръст дето аутокада не може и малкото име да си каже, едвам се селектира обект.
А има чертежи (огромни) дето може всичко да си правиш и то се случва много бързо, все едно чертаеш върху празна бланка.


А относно програмирането на AutoLISP: Твърде малко хора знаят, говоря от ползващите Аутокад, че в него има такава възможност. Много от хората, които се наричат инжинери и архитектурни техници че дори и архитекти не знаят елементарни неща и не умеят да боравят със слоеве ти ще искаш да им правиш програми на AutoLISP.

Прекомерната употреба на LINUX води до пристрастяване!

Щом сега започваш - хвани VBA. Просто ще ти бъде по-лесно да преминеш и към проектиране в други офис приложения и ще можеш да ги свързваш в общи проекти. За диалозите си прав - много дървени са.
Сега малко за организацията на данните в чертежа. За дребни работи не е от такова значение организацията, но за по-големи работи и особено при работа в група е задължително. За унификацията - трябва да се изработят някои прости правила и да се ползват при всички случаи. Ще ти дам пример:
Направил съм си няколко набора от блокове (за вътрешни инсталации, за външни захранвания и т.н.). Когато създавам такъв блок му закачам два невидими константни атрибути с имена HIDDENNAME и GROUP. В HIDDENNAME слагам пълното име на изобразявания обект ("осветително тяло с ЛЛ 2х40" например), а в GROUP групата на блоковете ("осветителни тела", "табла", "стълбове" и т.н.). Тези атрибути ги ползвам в списъци за вмъкване на блоковете (доста по-удобно е да избереш блок "осветително тяло с ЛЛ 2х40" отколокото "qweasd2-40"), при създаване на легенда и спецификация, разни справки и т.н.

Явно не съм разбрала каква организация имаш предвид.
Мислех, че говориш за организацията на самата програма.
Организацията на самия чертеж е може би най-важната тема, но няма никаква връзка с програмирането. Тъй като много ме вълнува тази тема ще я изнеса отделно. Ще се радвам, ако повече хора вземат отношение.

Организацията на данните в чертежа има пряко отношение към програмирането. Това е първата стъпка.
Аз съм привърженик на програми, които подпомагат проектирането. Това не изключва "ръчно" въвеждане и затова именно спазването на принципите осигурява нормалната работа на програмите.
В примера за невидимите атрибути на блоковете, ако въведеш блок без необходимите атрибути, съответните програми няма да ги обработват и резултатите няма да са коректни.

Да, това е вярно. Но в случая става дума за изисквания на програмата. Това се залага още при формирането на идеята за самата пограма. Предполагам, че може да се тръгне и по друг път. Програмистът сам си решава какви рамки ще постави.
На мене ми е най-интересно, така да си организирам даден чертеж, че да свърша определена работа само с подръчни средства и де не се стигне до програмиране. Разбира се става дума за прости задачи. За по-сложни няма да мине без програмиране.

Отдавна не бях влизал в тоя форум и с удоволствие открих интересната тема.

Пич, трябва да си много богат щом за такива прости задачки даваш по 5 лева.

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

В отговор на:

---

Пич, трябва да си много богат щом ...

---

Писах ти на мейла и ти пратих и едно примерче...

Тук ти пускам едно макросче, което може би ще бъде полезно и за други. Служи за мащабиране на размерите в чертежа. Работи добре за детайли с размери от 10 до към 3000мм. Ако са по-големи или по-малки трябва се настроят обхватите.
За да се види "силата" на макроса трябва да свържеш към иконки двете подпрограми ScaleUp и ScaleDown, ако го стартираш от меню производителността му пада много.


Public Sub ScaleUp()
ChangeDimensions True
End Sub

Public Sub ScaleDown()
ChangeDimensions False
End Sub

Private Function ChangeDimensions(direction As Boolean)
Dim d3p As AcadDim3PointAngular
Dim ddi As AcadDimDiametric
Dim dor As AcadDimOrdinate
Dim dal As AcadDimAligned
Dim dro As AcadDimRotated
Dim dan As AcadDimAngular
Dim dra As AcadDimRadial
Dim ent As AcadEntity
Dim i As Integer, count As Integer
Dim dScale As Double
dScale = ThisDrawing.GetVariable("DIMSCALE")
If direction Then
If dScale < 1 Then
dScale = dScale * 2
Else
dScale = dScale + 1
End If
Else
If dScale > 2 Then
dScale = dScale - 1
Else
dScale = dScale / 2
End If
End If
ThisDrawing.SetVariable "DIMSCALE", dScale
count = ThisDrawing.ModelSpace.count - 1
For i = 0 To count
Set ent = ThisDrawing.ModelSpace.Item(i)
Select Case ent.ObjectName
Case "AcDbRotatedDimension"
Set dro = ent
dro.ScaleFactor = dScale
Case "AcDbAlignedDimension"
Set dal = ent
dal.ScaleFactor = dScale
Case "AcDbRadialDimension"
Set dra = ent
dra.ScaleFactor = dScale
Case "AcDbDiametricDimension"
Set ddi = ent
ddi.ScaleFactor = dScale
Case "AcDbOrdinateDimension"
Set dor = ent
dor.ScaleFactor = dScale
Case "AcDb2LineAngularDimension"
Set dan = ent
dan.ScaleFactor = dScale
End Select
Next
ThisDrawing.Regen True
End Function

Имаше въпроси за ефективността и перспективността на LISP. Затова давам същата програма написана на LISP.

;променя DIMSCALE
(DEFUN chdScale (direction / dScale nab)
(setq nab (ssget "x" '((0 . "DIMENSION")))
dScale (GETVAR "DIMSCALE"))
(COND
((AND direction (< dScale 1.0))(SETQ dScale (* dScale 2.0)))
((AND direction (> dScale 1.0))(SETQ dScale (1+ dScale )))
((AND direction (> dScale 2.0))(SETQ dScale (1- dScale )))
(T (SETQ dScale (/ dScale 2.0)))
);COND
(SETVAR "DIMSCALE" dScale)
(COMMAND "DIM1")
(COMMAND "UPDATE" NAB "")
);chdScale

При създаване на бутони за увеличаване и намаляване на DIMSCALE в "Macro associated in this button" трябва да се запише
(chdScale T) - за увеличаване
(chdScale nil) - за намаляване
Увеличение на скоростта на обработка при варианта на LISP програмата ще се усети при чертежи с много чертожни елементи.

На VBA също може да е грозно и кратко.

Съдържаниет е скрито
Влезте за да го видите

В отговор на:

---

Function ChangeDimensions(direction As Boolean)
Dim iType(0) As Integer
Dim vValue(0) As Variant
dScale = ThisDrawing.GetVariable("DIMSCALE")
dScale = IIf(direction, IIf(dScale < 1, dScale * 2, dScale + 1), _
IIf(dScale > 2, dScale - 1, dScale / 2))
vValue(0) = "DIMENSION"
Set sSet = ThisDrawing.SelectionSets.Add("DIM")
sSet.Select acSelectionSetAll, , , iType, vValue
For Each aEnt In sSet
aEnt.ScaleFactor = dScale
Next
sSet.Delete
Update
End Function

Sub ScaleUp()
ChangeDimensions True
End Sub

Sub ScaleDown()
ChangeDimensions False
End Sub

---

Да попитам и Аз !
Това върши ли подобна работа ?
-----------------------------------------------------------
Увеличаване на DIMSCALE + UPDATE на Dimension :
$M=$(if,$(>=,$(getvar,dimscale),1),^^_dimscale $(+,$(getvar,dimscale),1),^^_dimscale $(*,$(getvar,dimscale),2));_-dimstyle a all;;
Намаляване на DIMSCALE + UPDATE на Dimension :
$M=$(if,$(>=,$(getvar,dimscale),1),^^_dimscale $(-,$(getvar,dimscale),1),^^_dimscale $(/,$(getvar,dimscale),2));_-dimstyle a all;;
Но има проблем като стигне до 0-та ...
-----------------------------------------------------------
Текста се слага директно като макрос на бутона ...

Ето я същата функция написана по твоя начин:

Public Sub ChangeDimmensions()
Dim dScale As Double
dScale = ThisDrawing.GetVariable("DIMSCALE")
If direction Then
If dScale < 1 Then
dScale = dScale * 2
Else
dScale = dScale + 1
End If
Else
If dScale > 2 Then
dScale = dScale - 1
Else
dScale = dScale / 2
End If
End If
ThisDrawing.SetVariable "DIMSCALE", dScale
ThisDrawing.SendCommand "-dimstyle" & vbCr & "a" & vbCr & "all" & vbCr & vbCr
End Sub

Ako се използва функцията IIf както е направил колегата по-горе ще стане още по-кратка.

Повдигнах темата защото смятам, че е важна.
В написаните мнения почти всички бяха разочаровани от ниското ниво на ползващите чертожни програми (не само на ACAD). И аз мисля така. Стигнал съм до мнение, че има два подхода при ползване на чертожни програми - на "чертожника" и "проектанта" (слагам ги в кавички защото много проектанти работят с програмите като чертожници). При подхода на "чертожника" всичко се смята предварително, разчертава се с моливче и след това се изчертава "на чисто" на компютъра. Такива хора работят с линии, окръжности, дъги и т.н. и ползват генериращите команди (такива като LINE, CIRCLE ....).
"Проектанта" констуира чертежа си в процеса на ползване на програмите, като следва взаимовръзките между реалните физически обекти, ползвайки редактиращите команди на програмите (CHAMFER, FILLET, OFFSET, DIVIDE, MEASURE .....). Обектите с които работят са отражение на реални физически обекти (линията за него е стена, кабел ....). Необходимите размери и параметри се получават в процеса на конструиране на чертежа.
Е, как да автоматизираш работат на "чертожника" - най-много да му организираш малко слоевете и линиите, за да ползва някои по-мощни команди (QSELECT например). Специализирани програми не му трябват.

Беше повдигнат и въпроса за заплащането - такова няма. Смятам, че ще се появи тагявя, когато се появи търсенето. И тайната ми мисъл при пускането на тази тема беше да покажем, че може много по-интелигентно и ефективно да се работи, ползвайки специализирани програми, направени според собствените разбирания и начин на работа. От опит знам, че който пробва веднъж, след това иска още и още. Апетитът идва с яденето.

Друг повод за тази тема беше обмен на идеи и решения - появиха се и такива мнения. Дадени бяха решения на LISP, VBA, DIESEL ..... Така се повишава нивото на програмистите и това е много хубаво.

И накрая - според силите си ще помагам на всеки, който постави проблем в клуба.

В отговор на:

---

И накрая - според силите си ще помагам на всеки, който постави проблем в клуба.

---

Как така заключение, никаква почивка по въпроса

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

В отговор на:

---

Следващото ми питане е как се закача LISP програма за бутон.

---

Съдържаниет е скрито
Влезте за да го видите

Как се закача лисп програма към бутон - Имаш поне два варианта:
Вариант 1:
Десен клик върху който и да е видим тоолбар и избираш Customize, след което имаш възможности да си направиш нов тоолбар и да вкараш в него нов бутон или да вмъкнеш нов бутон във вече съществуващ тоолбар. В свойствата на бутона трябва да има един теьт бокс, където пище " Macro associated with the button.." или нещо подобно и там вмъкваш примерно:
^C^C(func_in_lisp par1 par2)
Вариант 2:

Пишеш един меню фаил, където описваш тоолбара и бутона(ите) и после го зареждаш този менюфаил с командата menuload. Ако не се вижда ще трябва да избереш view/toolbars и да го го отметнеш за да се покаже

Ето ти извадки от един примерен менюфаил, където се вика директно функция написана на лисп:

***MENUGROUP=PIPE
***TOOLBARS

**GEOHATCH
TID_TbGeoH [_Toolbar("GeoHatch", _Floating, _Hide, 85, 378, 1)]
TID__GHEarth [_Button("Earth", "h_eart_16.bmp", "h_eart_32.bmp")]^C^C(ghatch "earth" 20.0)


За слоевете си на прав път

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Искам само да добавя, че вместо променлива може да се ползва състоянието на слоя (включен или изключен). Това става така


(if (>=(cdr(ASSOC 62(tblsearch "layer""1")))0)
(command "layer" "off" "1,2" "")
(command "layer" "on" "1,2" ""))

Групата с ключ 62 е за цвят на слоя. Ако стойността е отрицателена, значи че слоя е изключен и обратно

ОК, до тук добре, сега как ще изглежда като цяла програма, защото само това if-че не работи.

Освен това е необходимо да се прави проверка дали слоя, който се изключва е текущ, защото тогава трябва да се добави още едно "y" накрая тъй като AutoCAD пита да ли сме сигурни, че искаме да изключим текущия слой.
за исключване на текущия слой:
-layer OFF layer1,layer2 y[][]
за всички останали:
-layer OFF layer1,layer2 [][]
Това е във формат за скрип

Съдържаниет е скрито
Влезте за да го видите

Кolumb е прав. Ето коригирания макрос:

(if (>=(cdr(ASSOC 62(tblsearch "layer""1")))0)
(command "layer" "off" "1,2" (if (VL-STRING-SEARCH "1,2" (getvar "clayer"))"y"""))
(command "layer" "on" "1,2" (if (VL-STRING-SEARCH "1,2" (getvar "clayer"))"y""")))

Ако го слагаш като макро към бутон от тулбар трябва да залепиш веднага след последната скоба ";" (без кавичките) и трябва да работи (с изключение на случая с текущия слой

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Даденият по-горе код не е верен!
Трябва да бъде така:

(foreach nn '("1" "2");тука се изписват имената на слоевете, които трябва да се изслючват
(if (>=(cdr(ASSOC 62(tblsearch "layer" nn)))0)
(command "layer" "off" nn(if(/=(getvar "clayer" )nn)" " "y "))
(command "layer" "on" nn "")
);if
);foreach

Все още не работи

Съдържаниет е скрито
Влезте за да го видите

Грешката беше в един интервал в кавичките

(foreach nn '("1" "2")
(if (>=(cdr(ASSOC 62(tblsearch "layer" nn)))0)
(command "layer" "off" nn(if(/=(getvar "clayer" )nn)"" "y"))
(command "layer" "on" nn "")
);if
)

РАБОТИ!

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Точно така с FOREACH на NN се присвоява последователно по един елемент от списъка

В темата няколко пъти беше засегнато прикачването на програми към бутони на туулбаровете.
Моето мнение е, че трябва да се реши предварително кои неща да се закачат на бутони. Аз имам повече от 500 файла с повече от 1000 функции и ако трябва да ги прикача на бутони ще стане голямо мазало - няма да има място за чертане.
На бутони трябва да се прикачат само тези функции, които се ползват във всички чертежи. Има начини това да стане по-интуитивно или според случая. Мисля, че съм го описвал в сайта. Ако трябва ще отворя отделна тема.

И аз програмирам на Autolisp, но за разлика от повечето тук използвам ACAD за карти, кадастър и задаване на допълнителна информация към обектите в ACAD. Програмките ги пиша за ускоряване на работата и мога да кажа, че ползата е огромна. Освен това смятам, че ако става въпрос за скорост, Autolisp няма конкуренция. Разбира се ако нещицата са простички това няма значение, но в случай, че обработвате нещо голямо разликата е огромна.

Дай мейл на stan_emea@abv.bg

много хубава тема - аз се интересувам за лиспове за 3д- прозорци/врати/рамки .... всичко което може да улесни моделирането :-) за арх. 3д виз

за контакти
www.projects3d.com
office@projects3d.com

10x

stanslavov написа :

В отговор на:

---

много хубава тема ...

---

Съдържаниет е скрито
Влезте за да го видите

Здравейте колеги,

Имам проблем с командата LAYISO oт EXPRESS TOOLS на ACAD Mechanical 2006.
Работя чертеж, чийто файли е към 5MB и голяма част от елементите са
получени от "гръмване" на няколко блока. Командата LAYISO често дава
грешка от тепа "lentype - nil". Тъй като всички ЕТ - команди са писани на
AUTOLISP поствам въпроса си тук.
Има ли някой подобен проблем и ако някой се е справял с него моля за
помощ.
Имам известни познания по AUTOLISP-а, но малко помощ не би ми била
излишна.

Поздрави на всички и предварително благодаря.

Това може да се получи по най-различни поводи. Обикновено при обработване на DWG чертежи създавани на други програми някои от системните променливи не са указани или имат неподходяща стойност. Опитай да отвориш нов празен чертеж и да вмъкнеш с INSERT с EXPLODE стария. За точка на вмъкване задай точка различна от 0,0 (напр. 1,1) и след това го премести в 0,0. Провери системните променливи FLATLAND=0, TEXTSIZE<>0. Виж настройките на дименсионния стил.
Пробвай тези неща, пък да видим.

Благодаря за отговора, ще опитам това, което предлагаш.
И аз имах известни съмнения, че чертежа е правен с друг
софтуер. Основно проблема се появява след като се " гръмне"
блока. Може би наистина има някаква разлика в описанието на
различните примитиви.
Много благодаря за съвета. Утре ще го пробвам и ще се обадя
отново.

Допада ми начина, по който се развива темата. Някъде скоро прочетох как може да се печели от отворен код - от поддръжката му. Няма какво да се коментира за разликатa в производителността между традиционното чертане с моливче и ползването на програми( за справка класацията по лично богатсво и мястото на Бил Гейтс в нея). Малко се отклонявам от Кад програмирането. Отдавна залитам по програмиране и това ми е хоби. Отделно и аз се трудя в инженерния бранш, а в него вече без Кад не можеш да минеш. Нещо, което и аз като начинаещ го правех за 8 часа, с около 1500 реда код се редуцира до 7мин, като от тях 4 мин са за допълнително оформление, а е лесно и те да се спестят ако още малко се поровя из VBA help-a. А сега практичното предложение: Моля ви намерете начин да изнесете темата в отделен форум. Мисля че имаме какво да си кажем, но поне да е по-добре структурирано.

При един-два файла се получи, но при някои не проработи.

Благодаря все пак за идеята.

аз ще започвам да пиша на С# и Аутокад, много ще се радвам ако има форум където можем да обсъждаме :).

Дай малко повече информация - при тези файлове, при които се е получило, какво направи. Защото бях дал няколко варианта.

Още няколко се оправиха като минах през dxf-формат.

Знае ли някой как се отварят ACAD файлове в VIZ Render 2006?Иска да са с разширение .viz.

Не е много за тази Тема !
По принцип съм останал с впечатление , че самостоятелната версия на VIZ-a , отваря DWG файлове , а VIZ-a към някоя от другите програми е с ограничена функционалност т.е. става чрез линкване от другата програма към VIZ-a .
Ти какъв вариант на Програмата ползваш ?

Все още никакъв,там е проблема.Имам инсталиран 2006,но не мога по никакъв начин да отворя AutoCad файл,а би трябвало. Точната версия е VIZ Render as ADT 2006.Знаеш ли програма,която да преобразува dwg в viz.Изобщо имаш ли някоя идея?

трябва ми нещо, което да смята общата дължина на селектираните polylines. пробвах да ти вадя с list, но хистори-то е много малко.

идеална работа ще свърши и нещо, което само да принтира дължината на всеки обект (оттам копи/пейст и...)

едит: натворих нещо. комбинирах 2 примера на vba, дето си вървят с аутокада (вер 2004). сега праща в excel дължините. ето го нещото:

Private Sub cmdStart_Click()

    Dim Excel As Object

    Dim elem As Object

    Dim excelSheet As Object

    Dim Array1 As Variant

    Dim Count, RowNum As Integer

    Dim NumberOfAttributes As Integer

    

    ' Start Excel

    On Error Resume Next

    

    Set Excel = GetObject(, "Excel.Application")

    

    If Err <> 0 Then

        Err.Clear

        Set Excel = CreateObject("Excel.Application")

            

        If Err <> 0 Then

            MsgBox "Could not load Excel.", vbExclamation

            End

        End If

    End If

    

    On Error GoTo 0

    

    Excel.Visible = True

    Excel.Workbooks.Add

    Excel.Sheets("Sheet1").Select

    Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")

    

    RowNum = 1

    Dim Header As Boolean

    For Each elem In ThisDrawing.ModelSpace

        If StrComp(elem.EntityName, "AcDbPolyline", 1) = 0 Then

            RowNum = RowNum + 1

            excelSheet.Cells(RowNum, Count + 1).Value = elem.Length

            

        End If

    Next elem

    

    NumberOfAttributes = RowNum - 1

    

    If NumberOfAttributes > 0 Then

        excelSheet.Range(Cells(1, 1), Cells(1, 100)).Font.Bold = True

        

        'For a specific set of attribute information this could

        'be set to fit the exact number of columns.

        excelSheet.Columns("A:G").AutoFit

        'Rename the worksheet

        Sheets("Sheet1").Name = "Attributes"

        If Chart.Value = True Then

            CreateChart (NumberOfAttributes)

        End If

        If Memo.Value = True Then

            MakeMemos

        End If

    Else

        MsgBox "No attributes found in the current drawing.", vbInformation

        Excel.Quit

    End If

    

    Unload Me

End Sub

Редактирано от onzi на 08.08.06 12:00.

Ми точно "VIZ Render as ADT 2006" е с ограничена функционалност ! Т.е. входа с dwg файл става само от ADT-то .... Трябва да си намериш самостоятелен Autodesk® VIZ ->

Съдържаниет е скрито
Влезте за да го видите

GIF89aЦ
]

Вижда ми се прекалино сложно да вадиш дължините в Excel, да ги сумираш там и да ги връщаш отново в ACAD с Copy/Paste. Предлагам ти програмка, която изчислява дължините на линии, полилинии, сплайнове и дъги (предварително избрани) и прави МТЕХТ с описани по редове дължините на всички отделни групи примитиви, броя им и общата дължина.
Запиши я като *.LSP файл, зареди я с Tools/Load Application
(sp-long-type)


;сумира дължините на избрани елементи и ги описва
(defun SUM-LONG (/ i sp nab en VL-EN type-en )
(IF (SETQ
I 0
SP NIL
NAB (SSGET)
)
(PROGN
(VL-LOAD-COM)
(REPEAT (SSLENGTH NAB)
(SETQ EN (SSNAME NAB I)
I(1+ I)
VL-EN(vlax-ename->vla-object EN)
type-en (cdr(ASSOC 0 (entget en)))
);SETQ
(IF
(or
(= "LINE" type-en)
(= "LWPOLYLINE" type-en)
(= "ARC" type-en)
(= "SPLINE" type-en)

);or
(SETQ
LONG(vlax-curve-getDistAtParam VL-EN(vlax-curve-getEndParam VL-EN))
SP (APPEND SP (LIST (CONS EN LONG)))
);setq
);if LINE LWPOLYLINE ARC
);REPEAT
);PROGN
);IF NAB
sp
);SUM-LONG
;вади списък на дължините по тип на обекта от набора
(defun sp-long-type ( / sp sp-obj nn obj obj-line )
(if (setq sp (SUM-LONG))
(PROGN
(setq sp-obj nil)
(FOREACH nn sp
(setq obj (cdr(ASSOC 0 (entget (car nn)))))
(if (not (ASSOC obj sp-obj))
(setq sp-obj (APPEND sp-obj (list (list obj 0 0))))
);if
);FOREACH
(FOREACH nn sp
(setq obj (cdr(ASSOC 0 (entget (car nn))))
obj-line (ASSOC obj sp-obj)
obj-line (list (car obj-line)
(+ (nth 1 obj-line)(cdr nn))
(1+ (nth 2 obj-line)))
sp-obj (SUBST obj-line (ASSOC obj sp-obj)sp-obj)
);setq
);FOREACH
);PROGN
);if sp
(if (setq pti (getpoint "\nStart point of text: "))
(text-create sp-obj pti)
);if pti
sp-obj
);sp-long-type
;изписва текст със име, дължина и брой
(defun text-create (sp pti / txt nn all-long all-num )
(if (and sp
pti
);and
(PROGN
(setq txt "" all-long 0.0 all-num 0)
(FOREACH nn sp
(setq txt (strcat txt
(substr(strcat (nth 0 nn) " ")1 20)
(substr(strcat (rtos (nth 1 nn)2 2)" ") 1 10)
(substr(strcat (rtos (nth 2 nn)2 0)" ") 1 10)
"\\P")
all-long (+ all-long (nth 1 nn))
all-num (+ all-num (nth 2 nn)))
);FOREACH
(setq txt (strcat txt(substr(strcat " ОБЩО" " ")1 20)
(substr(strcat(rtos all-long 2 2)" ") 1 10)
(substr(strcat(rtos all-num 2 0)" ") 1 10)))
(COMMAND "mtext" pti (MAPCAR '+ pti (list (* (getvar "textsize")40.0) 10)) txt "")
);PROGN
);if sp
);text-create

Нарочно съм отделил функциите, защото на базата на тях може да се направят и други програми (например да се вадят дължините по слоеве, цвят и т.п.)

Много ти благодаря,Минаващ хубаво е да наминаваш в този клуб.

Съдържаниет е скрито
Влезте за да го видите

С мойте скромни познания по AutoCAD ... останах с впечатление , че създаването на AutoCAD® Dialog Control Language (DCL) файлове е малко трудна работа и ...
Преди време го бях видял , сега видях в един форум нова информация и реших , че може да е интересно ...
3dr Day Software - ObjectDCL
Само този жив сайт открих ->

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Hora kade ste izcheznali tozi forum ne e li aktiven вече. Kajete kade da vi pisha? Да не сте в друг форум

Пиши тук ... аз незнам за друг форум .

Да попитам - как със VBA мога да взема координатите на точки(points) в един слой и да ги изпиша до точките?

За VBA е малко сложно, но ти предлагам програмка на LISP
Долния текст го запиши в PTC.LSP
Зареди го с

(load "PTC")

избери точките или всички елементи от нужния слой (може с QSELECT) и стартирай

PTC

Ако текста е с неподходяща големина смени го с

TEXTSIZE

Ако разположението на текста не е подходящ в сорса промени числото след DTXT (сега е 1.0)


;ПРОСТАВЯ КООРТИНАТИ НА ТОЧКИ
(DEFUN C:PTC ()
(IF (AND
(SETQ NAB (SSGET))
(> (SSLENGTH NAB) 0)
);AND
(PROGN
(SETQ I 0 TS (GETVAR "TEXTSIZE") DTXT 1.0)
(REPEAT (SSLENGTH NAB)
(SETQ EN (SSNAME NAB I)
I(1+ I)
PT (CDR(ASSOC 10 (ENTGET EN)))
);SETQ
(IF (= "POINT"(CDR(ASSOC 0 (ENTGET EN))))
(COMMAND "TEXT" (POLAR PT (/ PI 4) (* DTXT TS))TS 0
(STRCAT (RTOS(NTH 0 PT)2 4)","(RTOS(NTH 1 PT)2 4)","(RTOS(NTH 1 PT)2 4))
(COMMAND))
);IF POINT
);REPEAT
);PROGN
);IF
);C:PTC

StSt, благодаря ти за отговора. Скриптът работи чудесно, но аз никак не го разбирам този синтаксис на Lisp :( и реших да го направя на VBA. Ето го и резултатът:

Sub Example_Coordinates()


Dim Selection As AcadSelectionSet
Dim Poly As AcadLWPolyline
Dim Obj As AcadEntity
Dim dblBound As Double
Dim PointMy As AcadPoint
Dim MTextObj As AcadMText
Dim adblCorner(0 To 2) As Double
Dim dblWidth As Double
Dim heightMy
Dim intNumDgtAftDcml As Integer
Dim strText As String
Dim newLayer As AcadLayer
'end----Dobaveno ot men

Set newLayer = ThisDrawing.Layers.Add("Koordinati")
ThisDrawing.ActiveLayer = newLayer
'Makes a selectionset.
On Error Resume Next
Set Selection = ThisDrawing.SelectionSets.Item("Select object.")
If Err Then
Set Selection = ThisDrawing.SelectionSets.Add("Select object.")
Err.Clear
Else
Selection.Clear
End If

ThisDrawing.Utility.Prompt vbCrLf & "Координатор !!!" & _
vbCrLf & "--------------------------------" & vbCrLf
heightMy = ThisDrawing.Utility.GetInteger("? Въведете височина на текста: ")
intNumDgtAftDcml = ThisDrawing.Utility.GetInteger("? Въведете брой символи след десетичната запетая: ")
dblWidth = 0
ThisDrawing.Utility.Prompt vbCrLf & "Изберете обекти:"

Selection.SelectOnScreen

For Each Obj In Selection

If Obj.ObjectName = "AcDbPolyline" Then

Set Poly = Obj
On Error Resume Next

dblBound = UBound(Poly.Coordinates)

x = 0
y = 1

For i = 0 To dblBound / 2

'MsgBox "X= " & Poly.Coordinates(x) & vbCrLf & "Y= " & Poly.Coordinates(y)
adblCorner(0) = Poly.Coordinates(x)
adblCorner(1) = Poly.Coordinates(y)
adblCorner(2) = 0#

strText = "X= " & FormatNumber(Poly.Coordinates(x), intNumDgtAftDcml) & vbCrLf & _
"Y= " & FormatNumber(Poly.Coordinates(y), intNumDgtAftDcml)

' Creates the mtext Object
Set MTextObj = ThisDrawing.ModelSpace.AddMText(adblCorner, dblWidth, strText)
MTextObj.Height = heightMy
MTextObj.Update
ZoomAll

If Err Then
Err.Clear
End If

x = x + 2
y = y + 2

Next

End If
If Obj.ObjectName = "AcDbPoint" Then
Set PointMy = Obj
On Error Resume Next
x = 0
y = 1
'MsgBox "X= " & PointMy.Coordinates(x) & " Y= " & PointMy.Coordinates(y)

adblCorner(0) = PointMy.Coordinates(x)
adblCorner(1) = PointMy.Coordinates(y)
adblCorner(2) = 0#
strText = "X= " & FormatNumber(PointMy.Coordinates(x), intNumDgtAftDcml) & vbCrLf & _
"Y= " & FormatNumber(PointMy.Coordinates(y), intNumDgtAftDcml)

' Creates the mtext Object
Set MTextObj = ThisDrawing.ModelSpace.AddMText(adblCorner, dblWidth, strText)
MTextObj.Height = heightMy
MTextObj.Update
ZoomAll


If Err Then
Err.Clear
End If
End If
Next Obj

End Sub

За Dim
Това е, според мен, целта на един такъв форум - обмен на идеи.
Затова пуснах тази тема.
Периодично посещавам подобни форуми
(особено http://www.autocad.ru/cgi-bin/f1/board.cgi?p=23)
между другото препоръчвам на всички, интересуващи се от програмиране в ACAD да поглеждат и навън
Там хората поставят въпроси от текущата си практика и в повечето случаи получават отговор.
В нашия форум въпросите, в болшинството си са откъде да си сваля програмка (ама безплатна), как да си настроя програмата по-иначе и т.н.
Това е ниско ниво на потребление. Показва повърностни понятия и ниски изисквания.
Имаше доста изказвания във форума за това, че не може да се накарат хората да работят малко по-интелигентно - да ползват малко повече от възможностите, които им предлага софтуера, който ползват.
Самият факт, че ти имаш повишени изисквания към програмата, при това можеш и ги решаваш, ознчава че си на много високо ниво и ще очаквам подкрепата ти в инициативата да "заразяваме" повече хора да ползват възможностите на ползваните програми.

В отговор на:

---

StSt
... да "заразяваме" повече хора да ползват възможностите на ползваните програми.

---

Не знам дали от алтруизъм

Съдържаниет е скрито
Влезте за да го видите

[image]C:\leta4.bmp[/image]

[IMG]http://img132.imageshack.us/img132/8317/leta4yc6.png[/IMG]

Здравейте, аз съм нова тук и съм почитател на Аутолисп или по-точно на начина, по който можеш да си улесниш работата.. И съм нова и в Аутокад(както руснаците казват Автогад ;), както си личи от предния ми пост, ама бързо се уча.... :))) Програмирането не ми е била стихията, както електротехниката, но....

Съдържаниет е скрито
Влезте за да го видите

Не знам дали има нещо общо с програмирането, ама блоковете с атрибути и динамичните блокове дават доста възможности за обикновения потребител, т.е. за мен.
Една задачка ме тормози. Направил съм си блок с 4 атрибута, които се изписват на един ред, като изречение. Дразни ме това, че когато стойностите на атрибутите са с по-къси думички - остават големи интервали между тях, а ако са с по-дълги - почват да застъпват следващия.

Дайте идея, сигурно е просто?

Верно , това си е за нова тема

Съдържаниет е скрито
Влезте за да го видите