|
Страници по тази тема: 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | (покажи всички)
Тема
|
Re: Мотивация ...
[re: Mинaвaщ]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 23.05.06 09:13 |
|
Запиши долната програмка като файл "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)
| |
Тема
|
Re: А от къде...
[re: mimosh]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 23.05.06 09:18 |
|
На български имаше една книжка мисля че се казваше "Програмиране на AutoLISP" но не съм много сигурен. В нея са дадени началните уроци и основните положения. След това започваш с HELP за разработчици, който се извиква в редактора на LISP с F1 и там са описани всички функции (LISP е функционален език) както на LISP, така и на VisualLISP и VBA
| |
Тема
|
Re: Мотивация ...
[re: StSt]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 23.05.06 17:31 |
|
След като помислих малко реших, че може би искаш да обработваш повече линии и затова ги експортваш в 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)
| |
Тема
|
Re: Благодаря ...
[re: StSt]
|
|
Автор | Mинaвaщ (Нерегистриран) |
Публикувано | 23.05.06 22:38 |
|
Благодаря !
Започвам да се притеснявам от Голямата си Уста !
Според мен вече дължа 20-тина лв. + (поне още 5лв. на друго място)
Стартирал съм процедура по информиране на колегите , но съм песимистично настроен ... направих бутончета и меню .... сложил съм ги ...
| |
Тема
|
Re: Благодаря ...
[re: Mинaвaщ]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 24.05.06 13:01 |
|
А пробва ли ги в действителен чертеж
| |
Тема
|
Re: Пробвах...
[re: StSt]
|
|
Автор | Mинaвaщ (Нерегистриран) |
Публикувано | 24.05.06 13:59 |
|
Да си призная пробвах това , Главно в с няколко начертани обекта и в два-три малки чертежа :
-------------------------------------------------------------------------
(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
---------------------------------------------------------------------
Ако има пробеми със смятането и др. големи не съм забелязал !
| |
Тема
|
Re: Пробвах...
[re: Mинaвaщ]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 25.05.06 14:38 |
|
Ако искаш само съобщение при единичната версия промени реда с
(command "TEXT" ......
със
(alert (strcat "I=" (RTOS result 2 4)))
| |
Тема
|
нЕкои ограничения ;-)
[re: Mинaвaщ]
|
|
Автор | Pin (Нерегистриран) |
Публикувано | 26.05.06 16:04 |
|
Имай в предвид, че така написаните програми няма да работят с вертикални линии (ще гърми заради делението на 0), няма да връща коректен резулатат ако работиш в координатна система различна от базовата WCS, или UCS, която не е паралелна на WCS и накрая можеш да я използваш само с LINE, но не можеш да я използваш с Polyline или LWPolyline.
Това общо взето не е хич страшно, защото ти може изобщо и да не използваш горните случаи, но все пак ако ги използваш - да не се чудиш откъде ще ти идват проблемите
| |
Тема
|
моля да бъда извинен
[re: Pin]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 26.05.06 23:11 |
|
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
| |
Тема
|
Програма за избор на елементи в
[re: Rado]
|
|
Автор | StSt (Нерегистриран) |
Публикувано | 28.05.06 12:35 |
|
или пресечени от затворена полилиния
;избира обекти изцяло в затворена полилиния
(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)
за да изберете всички елементи вклизащи изцяло в полилинията и обектите пресечени от нея
| |
|
Страници по тази тема: 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | (покажи всички)
|
|
|