等待你优化：复杂线型打散炸开(源码)

NetBee · 发表于 2012-12-23 21:44:36

本帖最后由 NetBee 于 2012-12-23 22:03 编辑

由于有时需要复制图形给打印店，又担心没有线型文件，会变样。
所以急需将线型打散，所以根据et工具的文字打散改了几行代码，能打散了，但必须在ET工具下运行。
由于没有时间继续了。

哪位搞个脱ET版?

(defun NBTF_VXVariant->Lst2 (v)
(cond
((= (type v) 'variant)
(NBTF_VXVariant->Lst (variant-value v)))
((= (type v) 'safearray)
(mapcar 'NBTF_VXVariant->Lst2 (safearray-value v)))
(T v)
)
)
(defun NBTF_VXEntBox (ent / obj maxpt minpt)
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpt 'maxpt)
(list (NBTF_VXVariant->Lst2 minpt)(NBTF_VXVariant->Lst2 maxpt))
)
(defun c:NBTC_PLexp (/ fun_setini fun_setclose grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX
TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked)
; --------------------- 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 nbtf-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 nbtf-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
)
( fun_setini)
; ----------------------------------------------------------------
; 主程序
; ----------------------------------------------------------------
(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 "\n选择要分解的复杂线型: ")
(Setq FLTR '((-4 . "<AND")
(-4 . "<OR") ; filter for 复合线
(0 . "*POLYLINE")
(-4 . "OR>")
(-4 . "<NOT")
(102 . "{ACAD_REACTORS") ; and not leader text
(-4 . "NOT>")
(-4 . "AND>")
)
GLST (nbtf-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 (nbtf-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 (NBTF_VXEntBox ENT)) ; 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") "PLexp.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 个复杂线型对象已经被分解为直线。" CNT))
(prompt "\n该直线对象已经被放在图层 0。")
)
)
)
(prompt "\n视图需在平面 (0 0 1)。")
);if equal
;;(acet-error-restore) ; Retsore values
(princ)
)
(princ)

(defun NBTF_VXVariant->Lst2 (v) 
   (cond 
     ((= (type v) 'variant) 
       (NBTF_VXVariant->Lst (variant-value v))) 
     ((= (type v) 'safearray) 
       (mapcar 'NBTF_VXVariant->Lst2 (safearray-value v))) 
     (T v) 
   ) 
) 
 
(defun NBTF_VXEntBox (ent / obj maxpt minpt) 
  (setq obj (vlax-ename->vla-object ent)) 
  (vla-GetBoundingBox obj 'minpt 'maxpt) 
  (list (NBTF_VXVariant->Lst2 minpt)(NBTF_VXVariant->Lst2 maxpt)) 
) 
 
 
(defun c:NBTC_PLexp (/ fun_setini fun_setclose grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX 
                   TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked) 
 
; --------------------- 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 nbtf-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 nbtf-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 
  ) 
( fun_setini) 
; ---------------------------------------------------------------- 
;                          主程序 
; ---------------------------------------------------------------- 
 
  (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 "\n选择要分解的复杂线型: ") 
 
      (Setq FLTR    '((-4 . "<AND") 
                        (-4 . "<OR")                      ; filter for 复合线 
                          (0 . "*POLYLINE") 
                        (-4 . "OR>") 
                        (-4 . "<NOT") 
                          (102 . "{ACAD_REACTORS")        ; and not leader text 
                        (-4 . "NOT>") 
                      (-4 . "AND>") 
                     ) 
            GLST     (nbtf-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 (nbtf-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 (NBTF_VXEntBox ENT))   ; 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") "PLexp.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 个复杂线型对象已经被分解为直线。"  CNT)) 
          (prompt "\n该直线对象已经被放在图层 0。") 
        ) 
      ) 
    ) 
    (prompt "\n视图需在平面 (0 0 1)。") 
  );if equal 
  ;;(acet-error-restore)                                  ; Retsore values 
  (princ) 
) 
 
 
(princ)

NetBee · 发表于 2012-12-23 21:50:05

由于只是针对打印，所有不需要太碎，我记得可以打散为复合线，而不是很多的小线段的。

革天明 · 发表于 2012-12-24 10:02:56

你干嘛不转成PDF的？

NetBee · 发表于 2012-12-28 08:57:12

转换为pdf的话，分辨率有问题。
过高文件太大
过小打印出来看不清。

caoyin · 发表于 2019-10-9 01:33:50

本帖最后由 caoyin 于 2019-10-9 01:37 编辑

1.线型是随DWG文件保存的，无需.lin支持文件。（包含形或字体的复杂线型需要.shx支持）
2.线型打散无需导出wmf，dxf组码已经包含详细的定义信息，直接读取组码即可用直线（复杂线型包括形或字体）模拟出来

账号		自动登录	找回密码
密码			注册

等待你优化：复杂线型打散炸开(源码)

相关帖子