用VLISP能得到三维实心体的模型线数据吗？

Hart

如画一个正方形的三维实心体，用直线标注的点选功能可选一条边进行标注。
用VLISP可不可以得到这条边的数据。

龙龙仔

Hart

没有其它方法了吗？

龙龙仔

;;; ACIS-REGION.LSP
;;; by Reini Urban, 12/1/98
;;; no warranties, given to the public domain.

;;; Extracts some REGION info from a 3DSOLID.
;;; Simple test functions, not very useful for apps but useful
;;; for playing with it. see the Acis SAT docs at www.spatial.com (in postscript)
;;; requires the AutoLISP STDLIB http://xarch.tu-graz.ac.at/autocad/stdlib/

;;; A region has no triangulation stored, we must better use 3dsout/3dsin
;;; or explode to get at the faces.

;;; sample region data
;|
  34
  +---+29
  |   |
  |   +--+24
  |   25 |
  |      |
  +------+32
  35

header "106 36 1 0          "
0  "body $-1 $1 $-1 $-1 #"        => to lump at 1
1  "lump $-1 $-1 $2 $0 #"        => to shell (child) at 2 and body (parent) at 0
2  "shell $-1 $-1 $-1 $3 $1 #"         => bounded (no next shell+subshell), face3, parent lump1
3  "face $-1 $-1 $4 $2 $-1 $5 forward double out #" =>loop4, in shell2, surface5
4  "loop $-1 $-1 $6 $3 #"         => coeedge6
5  "plane-surface $-1 6.2211508759432341 6.0525378103691665 0 0 0 1 1 0 0 0 I I I I #"
6  "coedge $-1 $7 $8 $-1 $9 0 $4 $-1 #"                => edge9
7  "coedge $-1 $10 $6 $-1 $11 0 $4 $-1 #"        => edge11
8  "coedge $-1 $6 $12 $-1 $13 0 $4 $-1 #"        => edge13
9  "edge $-1 $14 $15 $6 $16 0 #"                => line v14-v15 (=p24-p25)
10 "coedge $-1 $17 $7 $-1 $18 0 $4 $-1 #"        => edge18
11 "edge $-1 $15 $19 $7 $20 0 #"                => line v15-v19 (=p25-p29)
12 "coedge $-1 $8 $17 $-1 $21 0 $4 $-1 #"        => edge21
13 "edge $-1 $22 $14 $8 $23 0 #"                => line v22-v14 (=p32-p24)
14 "vertex $-1 $9 $24 #"                        =p24
15 "vertex $-1 $9 $25 #"                        =p25
16 "straight-curve $-1 10.3919107277945 6.6328077489319801 0 -1 3.8791551863714972e-016 0 I I #"
17 "coedge $-1 $12 $10 $-1 $26 0 $4 $-1 #"        => edge26
18 "edge $-1 $19 $27 $10 $28 0 #"                => line v19-v27 (=p29-p34)
19 "vertex $-1 $11 $29 #"                        =p29
20 "straight-curve $-1 5.8126743888074337 6.6328077489319819 0 -4.3048961392706539e-016 1 0 I I #"
21 "edge $-1 $30 $22 $12 $31 0 #"                => line v30-v22 (=p35-p32)
22 "vertex $-1 $21 $32 #"                        =p32
23 "straight-curve $-1 10.391910727794501 2.8288159400756316 0 -4.669717834997924e-016 1 0 I I #"
24 "point $-1 10.3919107277945 6.6328077489319801 0 #"
25 "point $-1 5.8126743888074337 6.6328077489319819 0 #"
26 "edge $-1 $27 $30 $17 $33 0 #"                => line v27-v30 (=p34-p35)
27 "vertex $-1 $18 $34 #"                        =p34
28 "straight-curve $-1 5.8126743888074328 8.6959897420998882 0 -1 5.2965388415035719e-016 0 I I #"
29 "point $-1 5.8126743888074328 8.6959897420998882 0 #"
30 "vertex $-1 $26 $35 #"                        =p35
31 "straight-curve $-1 2.4588675112277691 2.8288159400756325 0 1 -1.1195935726724954e-016 0 I I #"
32 "point $-1 10.391910727794501 2.8288159400756316 0 #"
33 "straight-curve $-1 2.4588675112277691 8.6959897420998864 0 0 -1 0 I I #"
34 "point $-1 2.4588675112277691 8.6959897420998864 0 #"
35 "point $-1 2.4588675112277691 2.8288159400756325 0 #"
|;

(if (not STD-REMOVE-IF-NOT)
  (load "stdinit")
)
(STD-REQUIRE "STDLIST")
(STD-REQUIRE "STDSTR")

;;; accepts region ename,
;;; decode a region into segments, list of (p1 p2)
;;; extracts all edges as segmentlist. no faces, no triangulation.
;;; no further shell or face information.
(defun ACIS-REGION (ELE / ACIS PTS VTX EDGES)
  (setq        ACIS (mapcar (function (lambda (S) (ACIS-DECODE (cdr S))))
                     (STD-REMOVE-IF-NOT
                       (function (lambda (L) (= (car L) 1)))
                       (STD-ENTGET ELE)
                     )
             )
  )
  (if ACIS
    (progn
      ;; fixed to skip the SAT header, body must be at index 0
      ;; newer acis versions (r2000) have a longer header!
      (while (not (ACIS-BODY-P (car ACIS)))
        (setq ACIS (cdr ACIS))
      )
      (setq PTS (mapcar (function ACIS->OINT) ACIS))
      (setq VTX (mapcar (function ACIS->VERTEX) ACIS))
      (setq EDGES (mapcar
                    (function (lambda (S / EDGE)
                                (if (ACIS-EDGE-P S)
                                  (progn
                                    (setq EDGE (ACIS->EDGE S))
                                        ; v14-v15
                                    (list
                                      (nth (car EDGE) VTX) ; p24
                                      (nth (cadr EDGE) VTX)
                                    )
                                  )
                                )
                              )
                    )                        ; p25
                    ACIS
                  )
      )
      (STD-REMOVE
        NIL
        (mapcar
          (function (lambda (PL)
                      (if PL
                        (list (nth (car PL) PTS)
                              (nth (cadr PL) PTS)
                        )
                      )
                    )
          )
          EDGES
        )
      )
    )
  )
)

(defun ACIS-DECODE (S)                        ; decode an encrypted acis-string of dxf group 1
  (apply (function strcat)
         (mapcar
           (function (lambda (C)        ; decode one char
                       (cond                ; by Owen Wengerd
                         ((= C 32) " ")
                         ((= C 86) "I")
                         (t (chr (boole 6 C 95)))
                       )
                     )
           )
           (STD-STRING->LIST S)
         )
  )
)

(defun ACIS-BODY-P (S)
  (STD-STRCMP "body" S)
)
(defun ACIS-POINT-P (S)
  (STD-STRCMP "point" S)
)
(defun ACIS-VERTEX-P (S)
  (STD-STRCMP "vertex" S)
)
(defun ACIS-EDGE-P (S)
  (STD-STRCMP "edge" S)
)

(defun ACIS->OINT (S)
  (if (ACIS-POINT-P S)
    (read (strcat "(" (substr (STD-STR-1 S) 10) ")"))
  )
)
(defun ACIS->VERTEX (S)
  (if (ACIS-VERTEX-P S)
    (ACIS-NTH-POINTER 3 S)
  )
)
(defun ACIS->EDGE (S)
  (if (ACIS-EDGE-P S)
    (list (ACIS-NTH-POINTER 2 S) (ACIS-NTH-POINTER 3 S))
  )
)

(defun ACIS-NTH-POINTER        (I S)
  (repeat I (setq S (substr S (1+ (STD-STRPOS "$" S)))))
  (atoi S)
)

(defun C:ACIS-REGION-TEST ()
  (if (setq ELE (entsel "pick REGION: "))
    (ACIS-REGION ELE)
  )
)

(defun C:ACIS-EDGE-EXTRACT ()
  (STD-VAR-INIT NIL)
  (STD-REQUIRE "STDPOINT")
  (STD-REQUIRE "STDENT")
  (STD-REQUIRE "ENTMAKE")
  ;; allow all objects, also custom objects, to be selected. for simplicity
  (foreach ELE (STD-SSLIST
                 (STD-SSGET "Extract edges from 3DSOLID Objects" NIL)
               )
    (foreach SEG (ACIS-REGION ELE)
      (STD-ENTMAKE-LINE
        (list (cons 10 (STD-SEG-P1 SEG))
              (cons 11 (STD-SEG-P2 SEG))
        )
      )
    )
  )
  (STD-VAR-RESTORE)
)

;;; no face or loop extract yet, aka closed polylines, pface mesh.




;;Acis decode string
(defun ACISDECODE (ST / LN N C ST1)
  (setq        ST1 ""
        N   (strlen ST)
  )
  (while (> N 0)
    (setq C (ascii (substr ST N 1)))
    (setq ST1
           (strcat
             (cond
               ((= C 32) " ")
               ((= C 86) "I")
               ((chr (boole 6 C 95)))
             )
             ST1
           )
    )
    (setq N (1- N))
  )
  ST1
)

;;Acis decode entity
(defun ACISDECODEENT (ENT)
  (foreach @@ ENT
    (if        (= (car @@) 1)
      (setq ENT (subst (cons 1 (ACISDECODE (cdr @@))) @@ ENT))
    )
  )
  ENT
)

;;Display items
(defun ACISWHAT        (ENT TP)
  (setq TMP ())
  (foreach @@ ENT
    (if        (and (equal (car @@) 1) (wcmatch (cdr @@) (strcat TP "*")))
      (setq TMP (cons @@ TMP))
    )
  )
  (reverse TMP)
)

;;GetACISDataonly
(defun GETACISDATAONLY (ENT)
  (setq TMP ())
  (foreach @@ ENT
    (if        (equal (car @@) 1)
      (setq TMP (cons @@ TMP))
    )
  )
  (setq TMP (reverse TMP))
  (setq        TMP1 (car TMP)
        TMP  (cdr TMP)
        TMP  (cdr TMP)
        TMP  (cdr TMP)
  )
  (cons TMP1 TMP)
)

;;Main Routine
(defun C:TEST ()
  (setq ORENT (entget (car (entsel "\nSelect 3d Solid entity: "))))
  (setq DEENT (ACISDECODEENT ORENT))
  (setq        ACENT (GETACISDATAONLY DEENT)
  )
)

;|
1. A quick non-programming way to get POINTs from ACIS objects in
R2002 is to create an xml file of the geometry using WBLOCK,
and read the xyz entries for the "point" entities directly
from the XML text file.
eg. "point $-1 0 3 0 #" --------> coordinates are '(0 3 0)

2. Reini Urban has an example that "Extracts some REGION info
from a 3DSOLID." His file, called ACIS-REGION.LSP, can be found at
|;

tender138

看不懂