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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Можно-ли "Взорвать линию"?

Можно-ли "Взорвать линию"?

Ответ
Поиск в этой теме
Непрочитано 19.12.2005, 09:19 #1
Можно-ли "Взорвать линию"?
Dante
 
Николаев
Регистрация: 01.12.2005
Сообщений: 76

Кто знает безболезненный способ "взорвать" навороченную линию, в частности мне нужно из линии Batting (Изоляция) сделать набор элементов из которых она состоит - линии и дуги. [/quote]
Просмотров: 14570
 
Непрочитано 19.12.2005, 10:09
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,760


Нереал - если сделано именно типом линии.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.12.2005, 11:23
#3
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,119
<phrase 1=


На уровне идеи - в сложных линиях, где собсно есть что разбивать, используются shape. можно найти shape от вашей линии и командой express преобразовать его в блок, который разбить.
Apelsinov вне форума  
 
Непрочитано 19.12.2005, 11:46
#4
Jurasic


 
Регистрация: 10.01.2005
Москва
Сообщений: 89
<phrase 1=


Экспорт в WMF с последующей вставкой wmf'a в чертеж разбивает линию типа Batting до отрезков...
Jurasic вне форума  
 
Непрочитано 19.12.2005, 11:53
#5
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,760


> Apelsinov : Если четко знаешь имя shape, то можно (кстати, не знал, спасибо). А если нет, то придется писать лисп для вставки shape и последующей конвертации их.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.12.2005, 12:19
#6
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Взять идею Apelsinov и комманду из Exprerss'a Explode text. Сам текст команды (txtexp.lsp в папке Express) на лиспе. Если отбросить все проверки, то получится
Код:
[Выделить все]
         (command "_.mirror" SS "" PT1 PT2 "_y"
                   "_.WMFOUT" TMPFIL SS "")
                   ....
              (setq ss (acet-wmfin TMPFIL))               ; insert the WMF file
              (command "_.mirror" ss "" PT1 PT2 "_y")
Итак.
1. Зеркалим линию по вертикали
2. К полученной зеркальной копии творим "_.WMFOUT"
3. "_.WMFIN" (правда у меня размеры немного отличаются, но думаю это можно поправить масштабом. Думаю именно этим и занимается acet-wmfin )
4. Втавленный блок зеркалим обратно по вертикали
5. Взрываем.
VVA вне форума  
 
Непрочитано 19.12.2005, 13:18
1 | #7
Jurasic


 
Регистрация: 10.01.2005
Москва
Сообщений: 89
<phrase 1=


Все понятно!! Но зачем зеркалить???? Не понял.... Два раза сделал WMFOUT-WMFIN с зеркалом и без - однохренственно!!!
Кстати, оффтопик сорри, вместо wmfout лучше использовать BetterWMF http://www.furix.com/ Не реклама, просто прога хорошая..
Jurasic вне форума  
 
Непрочитано 24.10.2013, 18:10
#8
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Возникла необходимость преобразовать dwg в dmf (это формат программы Digitals). Ничего путного по поводу конвертирования не нашел (наверное потому что Digitals вроде как понимает dwg). Решал как-то аналогичную задачу для Компаса - там это реализовано наподобие команды laytrans, т.е. можно задавать типу линии dwg тип линии в компасе. Т.е. задача свелась к созданию всех используемых типов линиий в компасе и создание шаблона соответствий. В Digitals такого инструмента нет, поэтому возникла задача перевести все "сложное" в автокаде в простое. Грубо говоря взорвать все. Со сложными типами линий сразу же возник затык. Нашел готовое решение
Код:
[Выделить все]
 ;;
;;;
;;;    By Dominic Panholzer
;;;
;;;    Modified original TXTEXP.LSP from Express Tools
;;;    Copyright © 1999 by Autodesk, Inc.
;;     LINEXP.LSP modifications by XANADU
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
;;;
;;;  External Functions:
;;;
;;;     ACET-ERROR-INIT           --> ACETUTIL.FAS   Intializes bonus error routine
;;;     ACET-ERROR-RESTORE        --> ACETUTIL.FAS   Restores old error routine
;;;     ACET-GEOM-ZOOM-FOR-SELECT --> ACETUTIL.FAS   Zoom boundry to include points given
;;;     ACET-LAYER-LOCKED         --> ACETUTIL.FAS   Checks to see if layer is locked
;;;     ACET-GEOM-PIXEL-UNIT      --> ACETUTIL.FAS   Size of pixel in drawing units
;;;     ACET-GEOM-TEXTBOX         --> ACETUTIL.FAS   Returns the textbox for any text
;;;     ACET-GEOM-MIDPOINT        --> ACETUTIL.FAS   Returns midpoint between two points
;;;     ACET-GEOM-VIEW-POINTS     --> ACETUTIL.FAS   Returns corner points of screen or viewport
;;;     ACET-STR-FORMAT           --> ACETUTIL.ARX   String builder
;;;     ACET-WMFIN                --> ACETUTIL.FAS   Brings in WMF file
;;;
 
(defun c:linexp (/ grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX
                   TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked)
  (acet-error-init
        (list
         (list   "cmdecho" 0
                 "highlight" 1
                 "osmode" 0
                 "Mirrtext" 1
                 "limcheck" 0
         )
         T
        )
  )
 
; --------------------- GROUP LIST FUNCTION ----------------------
;   This function will return a list of all the group names in the
;   drawing and their entity names in the form:
;   ((<ename1> . <name1>) ... (<enamex> . <namex>))
; ----------------------------------------------------------------
 
  (defun acet-txtexp-grplst (/ GRP ITM NAM ENT GLST)
 
    (setq GRP  (dictsearch (namedobjdict) "ACAD_GROUP"))
    (while (setq ITM (car GRP))       ; While edata item is available
      (if (= (car ITM) 3)             ; if the item is a group name
        (setq NAM (cdr ITM)           ; get the name
              GRP (cdr GRP)           ; shorten the edata
              ITM (car GRP)           ; get the next item
              ENT (cdr ITM)           ; which is the ename
              GRP (cdr GRP)           ; shorten the edata
              GLST                    ; store the ename and name
                  (if GLST
                    (append GLST (list (cons ENT NAM)))
                    (list (cons ENT NAM))
                  )
        )
        (setq GRP (cdr GRP))          ; else shorten the edata
      )
    )
    GLST                              ; return the list
  )
 
; ------------------- GET GROUP NAME FUNCTION --------------------
;   This function returns a list of all the group names in GLST
;   where ENT is a member. The list has the same form as GLST
; ----------------------------------------------------------------
 
  (defun acet-txtexp-getgname (ENT GLST / GRP GDATA NAM NLST)
    (if (and GLST (listp GLST))
      (progn
        (foreach GRP GLST
          (setq GDATA (entget (car GRP)))
          (foreach ITM GDATA                   ; step through the edata
            (if (and
                  (= (car ITM) 340)            ; if the item is a entity name
                  (eq (setq NAM (cdr ITM)) ENT) ; and the ename being looked for
                )
              (setq NLST                       ; store the ename and name
                      (if NLST
                        (append NLST (list (cons (car GRP) (cdr GRP))))
                        (list (cons (car GRP) (cdr GRP)))
                      )
              )
            )
          )
        )
      )
    )
    NLST
  )
 
; ----------------------------------------------------------------
;                          MAIN PROGRAM
; ----------------------------------------------------------------
 
  (if (and                                                ; Are we in plan view?
        (equal (car (getvar "viewdir")) 0 0.00001)
        (equal (cadr (getvar "viewdir")) 0 0.00001)
        (> (caddr (getvar "viewdir")) 0)
      )
 
    (progn
 
      (prompt "\nSelect lines to be EXPLODED: ")
 
      (Setq FLTR    '((-4 . "<AND")
                        (-4 . "<OR")                      ; filter for mtext and text
                          (0 . "MTEXT")
                          (0 . "TEXT")
                        (-4 . "OR>")
                        (-4 . "<NOT")
                          (102 . "{ACAD_REACTORS")        ; and not leader text
                        (-4 . "NOT>")
                      (-4 . "AND>")
                     )
            GLST     (acet-txtexp-grplst)                             ; Get all the groups in drawing
            GDICT    (if GLST
                       (dictsearch (namedobjdict) "ACAD_GROUP")
                     )
            SS       (ssget);  FLTR)
            CNT      0
      )
      ;; filter out the locked layers
      (if SS
        (setq SS (car (bns_ss_mod SS 1 T)))
      ) ;if
 
      ;; if we have anything left
      (if SS
        (progn
          (setq CNT 0)                                 ; Reset counter
          (while (setq ENT (ssname SS CNT))            ; step through each object in set
 
            (and
              GLST                                     ; if groups are present in the drawing
              (setq GNAM (acet-txtexp-getgname ENT GLST))          ; and the text item is in one or more
              (foreach GRP GNAM                        ; step through those groups
                (command "_.-group" "_r"               ; and remove the text item
                  (cdr GRP) ENT ""
                )
              )
            )
 
            (setq TBX (acet-geom-textbox (entget ENT) 0))   ; get textbox points
 
            (setq TBX (mapcar '(lambda (x)
                                 (trans x 1 0)         ; convert the points to WCS
                               )
                        TBX
                      )
            )
 
            (setq PTLST (append PTLST TBX))            ; Build list of bounding box
                                                       ; points for text items selected
 
            (setq CNT (1+ CNT))                        ; get the next text item
          ); while
 
          (setq PTLST (mapcar '(lambda (x)
                                 (trans x 0 1)         ; convert all the points
                               )                       ; to the current ucs
                      PTLST
                    )
          )
 
          (if (setq ZM (acet-geom-zoom-for-select PTLST))          ; If current view does not contain
            (progn                                     ; all bounding box points
              (setq ZM
                (list
                  (list (- (caar ZM) (acet-geom-pixel-unit))     ; increase zoom area by
                        (- (cadar ZM) (acet-geom-pixel-unit))    ; one pixel width to
                        (caddar ZM)                    ; sure nothing will be lost
                  )
                  (list (+ (caadr ZM) (acet-geom-pixel-unit))
                        (+ (cadadr ZM) (acet-geom-pixel-unit))
                        (caddr (cadr zm))
                  )
                )
              )
              (if (setq vpna (acet-currentviewport-ename))
                  (setq vplocked (acet-viewport-lock-set vpna nil))
              );if
              (command "_.zoom" "_w" (car ZM) (cadr ZM))  ; zoom to include text objects
            )
          )
 
          (setq VIEW     (acet-geom-view-points)
                TMPFIL   (strcat (getvar "tempprefix") "txtexp.wmf")
                PT1      (acet-geom-midpoint (car view) (cadr view))
                PT2      (list (car PT1) (cadadr VIEW))
          )
 
          (if (acet-layer-locked (getvar "clayer"))       ; if current layer is locked
            (progn
              (command "_.layer" "_unl" (getvar "clayer") "")  ; unlock it
              (setq LOCKED T)
            )
          )
 
          (command "_.mirror" SS "" PT1 PT2 "_y"
                   "_.WMFOUT" TMPFIL SS "")
 
          (if (findfile tmpfil)                           ; Does WMF file exist?
            (progn
              (command "_.ERASE" SS "")                   ; erase the orignal text
              (setq ss (acet-wmfin TMPFIL))               ; insert the WMF file
              (command "_.mirror" ss "" PT1 PT2 "_y")
            ) ;progn
          ) ;if
 
 
          (if LOCKED
            (command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed
          ) ;if
 
          (if ZM (command "_.zoom" "_p"))              ; Restore original view if needed
          (if vplocked 
              (acet-viewport-lock-set vpna T) ;re-lock the viewport if needed.
          );if
          (prompt (acet-str-format "\n%1 object(s) have been exploded to lines."  CNT))
          (prompt "\nThe line objects have been placed on layer 0.")
        )
      )
    )
    (prompt "\nView needs to be in plan (0 0 1).")
  );if equal
  (acet-error-restore)                                  ; Retsore values
  (princ)
)


(princ)
вот только результат получил немного неожиданный. (см. вложение)
Может кто подправить программу чтобы она работала как надо?
Изображения
Тип файла: jpg результа работы linexp.jpg (34.1 Кб, 1116 просмотров)
off вне форума  
 
Непрочитано 25.10.2013, 08:56
#9
Bull

Конструктор по сути (машиностроитель)
 
Регистрация: 10.10.2005
Набережные Челны (это где КамАЗ)
Сообщений: 10,919


Значит все-таки важный пункт:
Цитата:
Сообщение от VVA Посмотреть сообщение
1. Зеркалим линию по вертикали
__________________
Век живи, век учись - ...
Bull вне форума  
 
Непрочитано 25.10.2013, 09:32
#10
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Цитата:
Сообщение от Bull Посмотреть сообщение
Значит все-таки важный пункт:
В тексте программы этот пункт присутствует.

Логика подсказывает что для линий без текста, но у которых shape имеет ориентацию нужно перед выполнением экспорта/импорта выполнять реверс линии.
Линиям с текстом это не помогает. У образовавшихся в результате действия программы текстовых элементов в свойства параметр "Слева направо" стоит в "Да", видимо это как раз следствие действия команды _mirror. Чтобы вернуть тексту нормальный вид нужно отзеркаливание повторить для каждого текстового элемента в отдельности. Центром отзеркаливания д.б. центр текста (а не точка вставки). Как бы это программно реализовать?
off вне форума  
 
Непрочитано 25.10.2013, 09:55
#11
ProPeller

Пастух
 
Регистрация: 16.07.2012
Питер
Сообщений: 318


Цитата:
Сообщение от off Посмотреть сообщение
В тексте программы этот пункт присутствует.

... видимо это как раз следствие действия команды _mirror. ...
Попробуйте перед выполнением программы изменить переменную MIRRTEXT на 0
__________________
Автоматизация должна быть автоматической.
ProPeller вне форума  
 
Непрочитано 25.10.2013, 10:07
#12
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Цитата:
Сообщение от ProPeller Посмотреть сообщение
Попробуйте перед выполнением программы изменить переменную MIRRTEXT на 0
Попробовал в обоих вариантах - результат идентичен.
off вне форума  
 
Непрочитано 25.10.2013, 10:20
#13
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,067


реверс линии нужен.
_reverse
меняет начало и конец линии местами
Хмурый вне форума  
 
Непрочитано 25.10.2013, 10:22
#14
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Цитата:
Сообщение от Хмурый Посмотреть сообщение
реверс линии нужен.
_reverse
меняет начало и конец линии местами
А эта из какой программы команда? В 2007 такой нет. Пользуюсь командой из набора Pl-tools.

p.s. Вобщем _.WMFOUT и _.WMFIN решили поставленную задачу. Правда после импорта shape который был квадратным стал кривоугольным, но с этим как-нибудь можно бороться. Главное что текст выглядит нормально.

Последний раз редактировалось off, 25.10.2013 в 10:28.
off вне форума  
 
Непрочитано 25.10.2013, 10:31
#15
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,067


off, реверс, вроде с 2010-го появился, если память не отшибло
Хмурый вне форума  
 
Непрочитано 25.10.2013, 10:55
#16
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Да уж, отстал от жизни
off вне форума  
 
Непрочитано 25.10.2013, 15:33
#17
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Хмурый Посмотреть сообщение
реверс линии нужен.
Как оказалось не только реверс. Еще и mirrtext'ом нужно поиграться
В общем кое-что состряпал. Тестируйте
Код:
[Выделить все]
 ;;
;;;
;;;    By Dominic Panholzer
;;;
;;;    Modified original TXTEXP.LSP from Express Tools
;;;    Copyright © 1999 by Autodesk, Inc.
;;     LINEXP.LSP modifications by XANADU
;;;   Modified VVA (Vladimir Azarko) www.dwg.ru
;;;   url: http://forum.dwg.ru/showthread.php?t=4971
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
;;;
;;;  External Functions:
;;;
;;;     ACET-ERROR-INIT           --> ACETUTIL.FAS   Intializes bonus error routine
;;;     ACET-ERROR-RESTORE        --> ACETUTIL.FAS   Restores old error routine
;;;     ACET-GEOM-ZOOM-FOR-SELECT --> ACETUTIL.FAS   Zoom boundry to include points given
;;;     ACET-LAYER-LOCKED         --> ACETUTIL.FAS   Checks to see if layer is locked
;;;     ACET-GEOM-PIXEL-UNIT      --> ACETUTIL.FAS   Size of pixel in drawing units
;;;     ACET-GEOM-TEXTBOX         --> ACETUTIL.FAS   Returns the textbox for any text
;;;     ACET-GEOM-MIDPOINT        --> ACETUTIL.FAS   Returns midpoint between two points
;;;     ACET-GEOM-VIEW-POINTS     --> ACETUTIL.FAS   Returns corner points of screen or viewport
;;;     ACET-STR-FORMAT           --> ACETUTIL.ARX   String builder
;;;     ACET-WMFIN                --> ACETUTIL.FAS   Brings in WMF file
;;;


 
(defun c:linexp (/ grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX
                   TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked Express)
  (acet-error-init
        (list
         (list   "cmdecho" 0
                 "highlight" 1
                 "osmode" 0
                 "Mirrtext" 1
                 "limcheck" 0
         )
         T
        )
  )
 
; --------------------- GROUP LIST FUNCTION ----------------------
;   This function will return a list of all the group names in the
;   drawing and their entity names in the form:
;   ((<ename1> . <name1>) ... (<enamex> . <namex>))
; ----------------------------------------------------------------
 
  (defun acet-txtexp-grplst (/ GRP ITM NAM ENT GLST)
 
    (setq GRP  (dictsearch (namedobjdict) "ACAD_GROUP"))
    (while (setq ITM (car GRP))       ; While edata item is available
      (if (= (car ITM) 3)             ; if the item is a group name
        (setq NAM (cdr ITM)           ; get the name
              GRP (cdr GRP)           ; shorten the edata
              ITM (car GRP)           ; get the next item
              ENT (cdr ITM)           ; which is the ename
              GRP (cdr GRP)           ; shorten the edata
              GLST                    ; store the ename and name
                  (if GLST
                    (append GLST (list (cons ENT NAM)))
                    (list (cons ENT NAM))
                  )
        )
        (setq GRP (cdr GRP))          ; else shorten the edata
      )
    )
    GLST                              ; return the list
  )
 
; ------------------- GET GROUP NAME FUNCTION --------------------
;   This function returns a list of all the group names in GLST
;   where ENT is a member. The list has the same form as GLST
; ----------------------------------------------------------------
 
  (defun acet-txtexp-getgname (ENT GLST / GRP GDATA NAM NLST)
    (if (and GLST (listp GLST))
      (progn
        (foreach GRP GLST
          (setq GDATA (entget (car GRP)))
          (foreach ITM GDATA                   ; step through the edata
            (if (and
                  (= (car ITM) 340)            ; if the item is a entity name
                  (eq (setq NAM (cdr ITM)) ENT) ; and the ename being looked for
                )
              (setq NLST                       ; store the ename and name
                      (if NLST
                        (append NLST (list (cons (car GRP) (cdr GRP))))
                        (list (cons (car GRP) (cdr GRP)))
                      )
              )
            )
          )
        )
      )
    )
    NLST
  )

(defun reverseobject ( e1 / ed list:pt)
(setq ed (entget e1))
    (cond ((= (cdr(assoc 0 ed)) "LINE")
	   (setq e1 (vlax-ename->vla-object e1))
	   (setq list:pt (mapcar '(lambda (x) (vlax-get e1 x))
			   '(StartPoint EndPoint))
		 list:pt  (reverse list:pt))
	   (vla-put-StartPoint e1 (vlax-3d-point (car list:pt)))
	   (vla-put-EndPoint e1 (vlax-3d-point (cadr list:pt)))
	  )
	  ((= (cdr(assoc 0 ed)) "LWPOLYLINE")
	   (setq e1 (pl:geom-LWpolyline-revers e1))
	   )
	  ((= (cdr(assoc 0 ed)) "SPLINE")(vla-reverse (vlax-ename->vla-object e1))) 
  	  ((= (cdr(assoc 0 ed)) "POLYLINE")
	   (setq e1 (pl:geom-polyline-revers  e1))
           )
	  (t nil)
    )
  e1
  )
;;;Реверс LW полилиний
;;;Код Евгения Елпанова
;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20450SW
;;;http://www.arcada.com.ua/forum/viewtopic.php?t=481&sid=69bf50f6022d526c7c56ad2029d9f24c
;;; lib:plineLW-reverse теперь pl:geom-LWpolyline-revers
(defun pl:geom-LWpolyline-revers ( lw / e x1 x2 x3 x4 x5 x6)
  (if (= (type lw) 'VLA-OBJECT)
    (setq lw (vlax-vla-object->ename lw)))
    (setq e (entget lw ))
(foreach a1 e 
   (cond 
     ((= (car a1) 10) (setq x2 (cons a1 x2))) 
     ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4))) 
     ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3))) 
     ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5))) 
     ((= (car a1) 210) (setq x6 (cons a1 x6))) 
     (t (setq x1 (cons a1 x1))) 
     ) ;_ end of cond 
   )
(entmod (append(reverse x1)(append(apply(function append)
  (apply (function mapcar)(cons 'list (list x2 
         (cdr (reverse (cons (car x3) (reverse x3)))) 
         (cdr (reverse (cons (car x4) (reverse x4)))) 
         (cdr (reverse (cons (car x5) (reverse x5)))) 
         ) ;_ end of list 
        ) ;_ end of cons 
      ) ;_ end of apply 
         ) ;_ end of apply 
       x6 
       ) ;_ end of append 
     ) ;_ end of append 
   ) ;_ end of entmod 
  (entupd lw) 
  ) ;_ end of defun

(defun pl:revpoly (en ed / vlist count delen pcode end)
;_ Process POLYLINES (R13 or R14)
  (if
(and
   (entmake ed) ; start making complex entity (polyline)
  (progn
   (setq delen en
         pcode (cdr (assoc '70 ed))
         en (entnext  en)
         ed (entget en)
       end (cdr (assoc '10 ed))
       vlist nil
   ) ; setq

   ; Assemble list of vertices

   (while (/= "SEQEND" (cdr (assoc '0 ed)))
      (setq vlist (append vlist (list ed))
           start (cdr (assoc '10 ed))
           en (entnext en)
         ed (entget en)
     ) ; setq
   ) ; while

   (pl:procpoly pcode (length vlist) vlist "POLY")
   ;(command "_.erase" delen "")
  (entdel delen) 
  (entmake ed) ; finish off object creation
   )
   )
  (entlast)
   (entdel delen)
)
) ; defun revpoly


(defun pl:procpoly (pcode vert vlist typ / count leg bulge elist)

;_ Paul Frylink 23 Sept 1997
;_ This procedure processes polylines (LWPOLYLINES and POLYLINES)
;_ It Reverses the order of vertices and matches up the
;_ Correct bulge factors
;_ If group code 70 contains a 1 (ie, is odd) then polyline is closed
   (if (/= (/ pcode 2) (/ pcode 2.0))
      (setq vlist (append (list (car vlist)) (reverse vlist))) ;_ Polyline is closed
      (setq vlist (reverse vlist))                             ;_ Polyline is open
   ) ;_ if
   (setq count 0)
   (while (/= count vert) ; loop through all vertices
      (setq leg (nth count vlist)
           bulge (cdr (assoc '42 (nth (1+ count) vlist))) ;_ bulge factor
      ) ;_ setq
      (if (not bulge)
        (setq bulge 0)  ;_ last leg
         (setq bulge (* -1 bulge) ;_ reverse arc - if any
              leg (subst (cons '42 bulge) (assoc '42 leg) leg)
        ) ;_ setq
      ) ; if
      (if (eq "LWPOLY" typ)
        (setq elist leg);_ return (setq elist (append elist leg))
       (entmake leg)
      ) ; setq
      (setq count (1+ count))
   ) ;_ while
  elist
) ;_ 
;;;Реверс полилиний POLYLINE
;;; На основе ru-geom-polyline-revers  
;;;Взято http://www.arcada.com.ua/forum/viewtopic.php?t=481
;;;!Есть исправления
(defun pl:geom-polyline-revers  (ent)
 (if (= (type ent) 'VLA-OBJECT)
    (setq ent (vlax-vla-object->ename ent)))
  (cond
    ((= (logand (cdr(assoc 70 (entget ent))) 4) 4) ;_Fit
     (pl:revpoly ent (entget ent '("*")))
     )
    (t
     (pl:geom-polyline-revers-notfit ent)
     )
)
  )
;;;Реверс полилиний POLYLINE
;;; На основе ru-geom-polyline-revers  
;;;Взято http://www.arcada.com.ua/forum/viewtopic.php?t=481
;;;!Есть исправления
(defun pl:geom-polyline-revers-notfit  
                               (ent_name        / 
                                _dxf-code-data  tmp_ent 
                                i               poly_ent 
                                vert_ent        vertex_list 
                                bulge_list      start_width_list 
                                end_width_list 
                               )
;;;  (defun _dxf-code-data (code ent_name) 
;;;    (cdr (assoc code (entget ent_name))) 
;;;  ) ;_ end of defun 
  
(if (= (type ent_name) 'VLA-OBJECT)
    (setq ent_name (vlax-vla-object->ename ent_name)))
  ;; Реверс "POLYLINE" 
  (setq tmp_ent ent_name 
        ;; копируем имя выбранного примитива 
        i       0 
  ) ;_ end of setq
  (setq bulge_list nil vertex_list nil start_width_list nil end_width_list nil)
  (while 
    (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent))))) ;_ end of not 
     (setq bulge_list 
            (cons (pl:dxf 42 tmp_ent) bulge_list) 
           vertex_list 
            (cons (entget tmp_ent) vertex_list) 
           start_width_list 
            (cons (pl:dxf 40 tmp_ent) 
                  start_width_list 
            ) ;_ end of cons 
           end_width_list 
            (cons (pl:dxf 41 tmp_ent) end_width_list) 
           i (1+ i) 
     ) ;_ end of setq 
  ) ;_ end of while
  
  (setq
        bulge_list       (append (cdr bulge_list) (list (car bulge_list))) 
        start_width_list (append (cdr start_width_list) 
                                 (list (car start_width_list)) 
                         ) ;_ end of append 
        end_width_list   (append (cdr end_width_list) 
                                 (list (car end_width_list)) 
                         ) ;_ end of append
        i                0
        bulge_list       (mapcar '(lambda (x) (- 0 x)) bulge_list) 
        tmp_ent          ent_name 
        poly_ent         (cdr (entget tmp_ent '("*"))) ;;;Добавлено, чтобы реверсировалось с РД
        poly_ent         (subst (cons 40 (car end_width_list)) 
                                (assoc 40 poly_ent) 
                                poly_ent 
                         ) ;_ end of subst 
        poly_ent         (subst (cons 41 (last start_width_list)) 
                                (assoc 41 poly_ent) 
                                poly_ent 
                         ) ;_ end of subst 
  ) ;_ end of setq 
  (entmakex poly_ent)          ; polyline
  (while 
    (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent)))) 
    ) ;_ end of not 
     (progn 
       (setq vert_ent (nth i vertex_list) 
             vert_ent (subst (cons 40 (nth i end_width_list)) 
                             (assoc 40 vert_ent) 
                             vert_ent 
                      ) ;_ end of subst 
             vert_ent (subst (cons 41 (nth i start_width_list)) 
                             (assoc 41 vert_ent) 
                             vert_ent 
                      ) ;_ end of subst 
             vert_ent (subst (cons 42 (nth i bulge_list)) 
                             (assoc 42 vert_ent) 
                             vert_ent 
                      ) ;_ end of subst 
             i        (1+ i) 
       ) ;_ end of setq
       (entmakex vert_ent) 
     ) ;_ end of progn 
  ) ;_ end of while 
  (entmakex (cdr (entget tmp_ent))) ; seqend
  (entdel ent_name) 
  (redraw (entlast))
  (entlast)
) ;_ end of defun
  (defun _dwgru-conv-ent-to-ename (ent / ret)
;;;    Выполняет преобразование переданного указателя в ename-вариант
;;;    Параметры вызова:
;;;	ent	обрабатываемый указатель. Может быть:
;;;		 ename
;;;		 vla-object
;;;		 строка (воспринимается как хендл примитива)
;;;		 список, полученный от (entsel)
;;;		 список, полученный от (entget)
;;;    Примеры вызова:
  ;|
(setq
  entity (vla-addline
        (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
        (vlax-3d-point (setq pt (getpoint)))
        (vlax-3d-point (getpoint pt))
        ) ;_ end of vla-addline
  ) ;_ end of setq
(_dwgru-conv-ent-to-ename entity)	; <Entity name: 7ef5cf68>
|;
  (cond
    ((= (type ent) 'vla-object) (vlax-vla-object->ename ent))
    ((= (type ent) 'ename) ent)
    ((= (type ent) 'str) (handent ent))
;;;((= (type ent) 'str) (handent str))
;;; VVA 26/12/2007 : start
    ((and (= (type ent) 'list)
          (= (type (setq ret (car ent))) 'ename)
          ) ;_ end of and
     ret
     )
    ((= (type ent) 'list) (cdr (assoc -1 ent)))
    (t nil)
;;; VVA 26/12/2007 : end
    ) ;_ end of cond
  )
  ;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark ( )
 (if (setq *mip:mark (entlast)) nil
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
       (setq *mip:mark (entlast))(entdel *mip:mark)))(princ))
;;;* returns selection set of entities since last mip:mark.
(defun mip:get-last-ss (/ ss tmp val)
  (setq val (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if *mip:mark
    (progn (setq ss (ssadd))
           (while (setq *mip:mark (entnext *mip:mark))
             (ssadd *mip:mark ss)
           ) ;_ end of while
           (if (> (sslength ss) 0)
             (progn
               (command "_.select" ss "")
               (setq tmp ss)
             ) ;_ end of progn
             (setq tmp nil)
           ) ;_ end of if
    ) ;_progn
    (alert
      "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."
    ) ;_ end of alert
  ) ;_if
  (setvar "cmdecho" val)
  tmp
) ;_ end of defun

(vl-load-com)
  
; ----------------------------------------------------------------
;                          MAIN PROGRAM
; ----------------------------------------------------------------
(if
  (not
    (setq Express
    (and (vl-position "acetutil.arx" (arx))
      (eq (type ACET-SS-ZOOM-EXTENTS) 'SUBR)
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            (function (lambda nil (acet-sys-shift-down)))
          )
        )
      )
    )
  )
    )
  (progn
    (alert "\nNeed Express Tools!!!\Run setup and add it")
    (exit)
    )
  )
  (if (and                                                ; Are we in plan view?
        (equal (car (getvar "viewdir")) 0 0.00001)
        (equal (cadr (getvar "viewdir")) 0 0.00001)
        (> (caddr (getvar "viewdir")) 0)
      )
 
    (progn
 
      (prompt "\nSelect lines to be EXPLODED: ")
 
      (Setq FLTR    '((-4 . "<AND")
                        (-4 . "<OR")                      ; filter for mtext and text
                          (0 . "MTEXT")
                          (0 . "TEXT")
                        (-4 . "OR>")
                        (-4 . "<NOT")
                          (102 . "{ACAD_REACTORS")        ; and not leader text
                        (-4 . "NOT>")
                      (-4 . "AND>")
                     )
            GLST     (acet-txtexp-grplst)                             ; Get all the groups in drawing
            GDICT    (if GLST
                       (dictsearch (namedobjdict) "ACAD_GROUP")
                     )
            SS       (ssget);  FLTR)
            CNT      0
      )
      ;; filter out the locked layers
      (if SS
        (setq SS (car (bns_ss_mod SS 1 T)))
      ) ;if
 
      ;; if we have anything left
      (if SS
        (progn
          (ACET-SS-ZOOM-EXTENTS SS)
          (setq CNT 0)                                 ; Reset counter
          (while (setq ENT (ssname SS CNT))            ; step through each object in set
 
            (and
              GLST                                     ; if groups are present in the drawing
              (setq GNAM (acet-txtexp-getgname ENT GLST))          ; and the text item is in one or more
              (foreach GRP GNAM                        ; step through those groups
                (command "_.-group" "_r"               ; and remove the text item
                  (cdr GRP) ENT ""
                )
              )
            )
 
            (setq TBX (acet-geom-textbox (entget ENT) 0))   ; get textbox points
 
            (setq TBX (mapcar '(lambda (x)
                                 (trans x 1 0)         ; convert the points to WCS
                               )
                        TBX
                      )
            )
 
            (setq PTLST (append PTLST TBX))            ; Build list of bounding box
                                                       ; points for text items selected
 
            (setq CNT (1+ CNT))                        ; get the next text item
          ); while
 
          (setq PTLST (mapcar '(lambda (x)
                                 (trans x 0 1)         ; convert all the points
                               )                       ; to the current ucs
                      PTLST
                    )
          )
          
 
          (if (setq ZM (acet-geom-zoom-for-select PTLST))          ; If current view does not contain
            (progn                                     ; all bounding box points
              (setq ZM
                (list
                  (list (- (caar ZM) (acet-geom-pixel-unit))     ; increase zoom area by
                        (- (cadar ZM) (acet-geom-pixel-unit))    ; one pixel width to
                        (caddar ZM)                    ; sure nothing will be lost
                  )
                  (list (+ (caadr ZM) (acet-geom-pixel-unit))
                        (+ (cadadr ZM) (acet-geom-pixel-unit))
                        (caddr (cadr zm))
                  )
                )
              )
              (if (setq vpna (acet-currentviewport-ename))
                  (setq vplocked (acet-viewport-lock-set vpna nil))
              );if
              (command "_.zoom" "_w" (car ZM) (cadr ZM))  ; zoom to include text objects
            )
          )
 
          (setq VIEW     (acet-geom-view-points)
                TMPFIL   (strcat (getvar "tempprefix") "txtexp.wmf")
                PT1      (acet-geom-midpoint (car view) (cadr view))
                PT2      (list (car PT1) (cadadr VIEW))
          )
 
          (if (acet-layer-locked (getvar "clayer"))       ; if current layer is locked
            (progn
              (command "_.layer" "_unl" (getvar "clayer") "")  ; unlock it
              (setq LOCKED T)
            )
          )
          ;;;REVERSE
          ((lambda (ss1 / lst)
            (setq CNT 0)                                 ; Reset counter
            (while (setq ENT (ssname SS CNT))            ; step through each object in set
              (setq lst (cons ENT lst))
              (setq CNT (1+ CNT))
              )
             (foreach item lst
               (setq ENT (reverseobject item))
               (ssadd (_dwgru-conv-ent-to-ename ENT) SS)
               )
             )
            SS
            )
          (command "_.mirror" SS "" PT1 PT2 "_y"
                   "_.WMFOUT" TMPFIL SS "")
 
          (if (findfile tmpfil)                           ; Does WMF file exist?
            (progn
              (command "_.ERASE" SS "")                   ; erase the orignal text
              (setq ss (acet-wmfin TMPFIL))               ; insert the WMF file
            (command "_.mirrtext" 0 "_.mirror" ss "" PT1 PT2 "_y")
            ) ;progn
          ) ;if
 
 
          (if LOCKED
            (command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed
          ) ;if
 
          (if ZM (command "_.zoom" "_p"))              ; Restore original view if needed
          (if vplocked 
              (acet-viewport-lock-set vpna T) ;re-lock the viewport if needed.
          );if
          (prompt (acet-str-format "\n%1 object(s) have been exploded to lines."  CNT))
          (prompt "\nThe line objects have been placed on layer 0.")
        )
      )
    )
    (prompt "\nView needs to be in plan (0 0 1).")
  );if equal
  (acet-error-restore)                                  ; Retsore values
  (princ)
)
(princ)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 25.10.2013 в 17:31. Причина: ACET-SS-ZOOM-EXTENTS*SS->ACET-SS-ZOOM-EXTENTS SS
VVA вне форума  
 
Непрочитано 25.10.2013, 15:54
#18
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Ругается после выбора линии no function definition: ACET-SS-ZOOM-EXTENTS*SS
off вне форума  
 
Непрочитано 25.10.2013, 16:16
#19
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от off Посмотреть сообщение
Ругается после выбора линии no function definition: ACET-SS-ZOOM-EXTENTS*SS
Это функция Express Tools. Должно было ругаться на ее отсутствие. Обновил код #17. Теперь точно должно ругаться
Что такое Express Tools, для чего нужен, как доставить читай в соответствующей теме Express Tools
PS Там была ошибка в логике. Обновил снова
PPS Опубликовал на cadtutore http://www.cadtutor.net/forum/showth...uot-lisp/page3
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 25.10.2013 в 16:23.
VVA вне форума  
 
Непрочитано 25.10.2013, 16:34
#20
off

геодезист
 
Регистрация: 11.11.2006
Ростов-на-Дону
Сообщений: 91
<phrase 1= Отправить сообщение для off с помощью Skype™


Там в строчку (ACET-SS-ZOOM-EXTENTS*SS) закралась звездочка. Без нее сработало.

Если сильно не придираться то сойдет, по крайней мере меня устраивает результат.
Если же подходить строго, то можно отметить что штрихи на наклонных линиях смотрят "не туда", т.е. их еще раз надо отзеркалить. Текст выглядит нормально, но буквы во-первых стоят не на тех местах где были (результат выполнения реверса) и ориентация буков на вертикальных участках линии наоборот.
Изображения
Тип файла: jpg Результат.jpg (48.5 Кб, 952 просмотров)

Последний раз редактировалось off, 25.10.2013 в 16:57.
off вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Можно-ли "Взорвать линию"?

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

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