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

Можно-ли "Взорвать линию"? · 19.12.2005, 09:19

Кто знает безболезненный способ "взорвать" навороченную линию, в частности мне нужно из линии Batting (Изоляция) сделать набор элементов из которых она состоит - линии и дуги. [/quote]

Кулик Алексей aka kpblc · 19.12.2005, 10:09

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

Apelsinov · 19.12.2005, 11:23

На уровне идеи - в сложных линиях, где собсно есть что разбивать, используются shape. можно найти shape от вашей линии и командой express преобразовать его в блок, который разбить.

Jurasic · 19.12.2005, 11:46

Экспорт в WMF с последующей вставкой wmf'a в чертеж разбивает линию типа Batting до отрезков...

Кулик Алексей aka kpblc · 19.12.2005, 11:53

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

VVA · 19.12.2005, 12:19

Взять идею 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. Взрываем.

Jurasic · 19.12.2005, 13:18

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

off · 24.10.2013, 18:10

Возникла необходимость преобразовать 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)

вот только результат получил немного неожиданный. (см. вложение)
Может кто подправить программу чтобы она работала как надо?

Bull · 25.10.2013, 08:56

Значит все-таки важный пункт:

Цитата:

Сообщение от VVA

1. Зеркалим линию по вертикали

off · 25.10.2013, 09:32

Цитата:

Сообщение от Bull

Значит все-таки важный пункт:

В тексте программы этот пункт присутствует.

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

ProPeller · 25.10.2013, 09:55

Цитата:

Сообщение от off

В тексте программы этот пункт присутствует.

... видимо это как раз следствие действия команды _mirror. ...

Попробуйте перед выполнением программы изменить переменную MIRRTEXT на 0

off · 25.10.2013, 10:07

Цитата:

Сообщение от ProPeller

Попробуйте перед выполнением программы изменить переменную MIRRTEXT на 0

Попробовал в обоих вариантах - результат идентичен.

Хмурый · 25.10.2013, 10:20

реверс линии нужен.
_reverse
меняет начало и конец линии местами

off · 25.10.2013, 10:22

Цитата:

Сообщение от Хмурый

реверс линии нужен.
_reverse
меняет начало и конец линии местами

А эта из какой программы команда? В 2007 такой нет. Пользуюсь командой из набора Pl-tools.

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

Хмурый · 25.10.2013, 10:31

off, реверс, вроде с 2010-го появился, если память не отшибло

off · 25.10.2013, 10:55

Да уж, отстал от жизни

VVA · 25.10.2013, 15:33

Цитата:

Сообщение от Хмурый

реверс линии нужен.

Как оказалось не только реверс. Еще и 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)

off · 25.10.2013, 15:54

Ругается после выбора линии no function definition: ACET-SS-ZOOM-EXTENTS*SS

VVA · 25.10.2013, 16:16

Цитата:

Сообщение от 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

off · 25.10.2013, 16:34

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

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

19.12.2005, 09:19		#1
Можно-ли "Взорвать линию"? Dante Николаев Регистрация: 01.12.2005 Сообщений: 76 Кто знает безболезненный способ "взорвать" навороченную линию, в частности мне нужно из линии Batting (Изоляция) сделать набор элементов из которых она состоит - линии и дуги. [/quote]
Просмотров: 19740

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

	Реклама i