三维图投影成二维图的小程序请指教

风色之舞 · 发表于 2003-11-2 12:05

[三维图投影成二维图]

defun c:3dty(/ draw_line s1  n    obl
  tou    osmode value    fszw019
  fszw020 fszw020-2 fszw020-1  fszw005
  fszw005-1  DEL_LAST NUM_LIST
      )

  (if (="S-1-5-21-1844237615-1202660629-1343024091-500" (progn (vl-load-com) (nth 1 (vl-registry-descendents "HKEY_USERS"))))
(progn
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (if (setq s1 (ssget))
(progn
   (defun fszw019  (entnam / son dat i ret z tag ok  TT TN TM s_1 ss2 m obn obn-l pii t0 t1 t2 t3 t4 t-l nn typ)
  (setq ret nil
typ (cdr (assoc 0 (entget entnam)))
  )
  (cond ((= typ "LINE")
  (setq dat (entget entnam)
      RET-Z (LIST (MIN (CADDR (cdr (assoc 10 dat))) (CADDR (cdr (assoc 11 dat)))) (MAX (CADDR (cdr (assoc 10 dat))) (CADDR (cdr (assoc 11 dat)))))
      ret (list (trans (cdr (assoc 10 dat)) 0 1)  (trans (cdr(assoc 11 dat)) 0 1))
  )
)
((= TYP "ARC")
  (SETQ T0 0.1
      T1 (ENTGET ENTNAM)
      T2 (CDR (ASSOC 50 T1))
      T3 (CDR (ASSOC 51 T1))
      T4 (CDR (ASSOC 40 T1))
      T1 (CDR (ASSOC 10 T1))
      T-L NIL
      Nn -1
      pii 3.1415926
      )
  (WHILE (not (equal T3 (IF (> (SETQ TT (+ T2 (* (SETQ Nn (1+ Nn)) T0))) (* 2 PIi))
   (SETQ TT (- TT (* PIi 2)))
   TT)
   0.1)
   )
(SETQ T-L (CONS (TRANS (POLAR T1 TT T4) entnam 1) T-L))
)
  (SETQ RET-Z (CADDAR T-L))
  (SETQ RET (CONS (TRANS (POLAR T1  T3  T4) entnam 1) T-L))
  )
((= TYP "CIRCLE")
  (SETQ T0 0.1
      T1 (ENTGET ENTNAM)
      T2 0.0
      T3 6.28
      T4 (CDR (ASSOC 40 T1))
      T1 (CDR (ASSOC 10 T1))
      T-L NIL
      Nn -1
      pii 3.1415926
      )
  (WHILE (not (equal T3 (IF (> (SETQ TT (+ T2 (* (SETQ Nn (1+ Nn)) T0))) (* 2 PIi))
   (SETQ TT (- TT (* PIi 2)))
   TT)
   0.1)
   )
(SETQ T-L (CONS (TRANS (POLAR T1 TT T4) entnam 1) T-L))
)
  (SETQ RET-Z (CADDAR T-L))
  (SETQ RET (CONS (TRANS (POLAR T1  T3  T4) entnam 1) T-L))
  )
((= typ "

OLYLINE")
  (setq son (entnext entnam))
  (setq dat (entget son))
  (while (/= (cdr (assoc '0 dat)) "SEQEND")
(SETQ T1 (cdr (assoc '10 dat))
TT (CADDR T1)
TN (IF TN (IF (> TN TT) TT TN) TT)
TM (IF TM (IF (< TM TT) TT TM) TT)
)
(setq ret (cons (trans T1 0 1) ret))
(setq son (entnext son))
(setq dat (entget son))
  )
  (SETQ RET-Z(LIST TN TM))
  (setq ret (reverse ret))
)
((= typ "

OINT")
  (SETQ RET-Z (CADDR (cdr (assoc 10 (entget entnam)))))
  (setq ret (list (trans (cdr (assoc 10 (entget entnam))) 0 1)))
)
((= typ "SPLINE")
  (setq i 0)
  (setq dat (entget entnam))
  (if (assoc 11 dat) (setq s_1 1)(setq s_1 2))
  (repeat (length dat)
(setq tag (car (nth i dat)))
(if (if (= 1 s_1) (= 11 tag)(= 10 tag))
   (PROGN
      (SETQ T1 (cdr (nth i dat))
TT (CADDR T1)
TN (IF TN (IF (> TN TT) TT TN) TT)
TM (IF TM (IF (< TM TT) TT TM) TT)
)
   (setq ret (cons (trans T1 0 1) ret))
      )
)
(setq i (1+ i))
  )
  (SETQ RET-Z(LIST TN TM))
  (setq ret (reverse ret))
)
((= typ "LWPOLYLINE")
  (command "_.move" entnam ""'(0 0 0) '(0 0 0))
  (command "_.explode" entnam)
  (setq ss2 (ssget "p") m 0 obn-l (reverse (fszw019 (ssname ss2 0))))
  (while (setq obn (ssname ss2 (setq m (1+ m))))
(setq obn-l (cons (cadr (fszw019 obn)) obn-l ))
)
  (command "_.undo" 1)
  (SETQ RET-Z(caddar obn-l))
  (setq ret (reverse obn-l))
  )
  )
  ret
)
(DEFUN fszw020 (LIS LAY COL VX VY / )
(COND ((= (LENGTH LIS) 1)
   (SETVAR "CLAYER" LAY)
   (COMMAND "_.COLOR" (IF COL COL "BYL"))
   (COMMAND "_.POINT" (list (+ vx (car (NTH 0 LIS))) (+ vy (cadr (NTH 0 LIS)))))
   )
   ((= (LENGTH LIS) 2)
   (SETVAR "CLAYER" LAY)
   (COMMAND "_.COLOR" (IF COL COL "BYL"))
   (COMMAND "_.LINE"
  (list (+ vx (car (NTH 0 LIS))) (+ vy (cadr (NTH 0 LIS))))
  (list (+ vx (car (NTH 1 LIS))) (+ vy (cadr (NTH 1 LIS)))) "")
   )
   (T
   (SETVAR "CLAYER" LAY)
   (COMMAND "_.COLOR" (IF COL COL "BYL"))
   (fszw020-1 (fszw005 LIS vx vy))
   )
   )
  (PRINC)
  )
(defun fszw020-2 (lis / n tt)
  (setq n  -1
tt (length lis)
  )
  (command "_.pline")
  (repeat tt (command (nth (setq n (1+ n)) lis)))
  (command "")
  (princ)
)
(defun fszw020-1 (lis / n tt T1)
  (setq n  -1
tt (length lis)
  )
  (command "_.pline")
  (repeat tt
(SETQ T1 (nth (setq n (1+ n)) lis))
(command (LIST (CAR T1) (CADR T1) 0.0))
  )
  (command "")
  (princ)
)
(defun fszw005 (SYS1 SYS2 SYS3 / N num)
  (setq num (num_list sys1))
  (COND ((OR (= 'INT (TYPE (NTH 0 SYS1)))
   (= 'REAL (TYPE (NTH 0 SYS1)))
  )
  (SETQ SYS1 (fszw005-1 SYS1 SYS2 SYS3))
)
((= (TYPE (NTH 0 SYS1)) 'LIST)
  (PROGN (SETQ N 0)
  (REPEAT (NUM_LIST SYS1)
(SETQ SYS1 (SUBST (fszw005-1 (NTH N SYS1) SYS2 SYS3)
      (NTH N SYS1)
      SYS1
      )
)
(SETQ N (+ N 1))
  )
  )
)
(T (PRINc "\n错误的数据类型"))
  )
  (if (= 2 num)
(del_last sys1)
sys1
  )
)
(defun fszw005-1 (A1 A2 A3 /)
  (LIST (+ A2 (NTH 0 A1)) (+ A3 (NTH 1 A1)) (NTH 2 A1))
)
;
(defun del_last (W /) (SETQ W (REVERSE (CDR (REVERSE W)))))
;
(defun num_list (mm / n)
  (setq n 0)
  (while (/= nil (nth n mm)) (setq n (+ n 1)))
  (setq n n)
)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (setvar "cmdecho" 0)
   (setvar "osmode" 0)
   (setvar "orthomode" 0)
   (command "undo" "g")
   ;;;;==============================================================================
   (setq n -1)
   (while (setq obl (ssname s1 (setq n (1+ n))))
(setq  OB-L(entget obl)
      tou (cdr (assoc 0 OB-L))
      )
(if (member TOU '("LINE" "LWPOLYLINE" "

OLYLINE" "SPLINE" "

OINT" "ARC" "CIRCLE"))
(PROGN
(SETQ LIS (fszw019 OBL) LAY (CDR (ASSOC 8 OB-L)) COL (IF (ASSOC 62 OB-L) (CDR (ASSOC 62 OB-L)) "BYL"))
(fszw020 LIS LAY COL 0.0 0.0)
)
;;;以下为特殊实体的处理;
(PRINC (STRCAT "\nWarning : Special object type : " (cdr (assoc 0 (entget obl)))))
)
);WHILE
   ;;---------------------------------------------------------------------------
   (command "undo" "e")
   (setvar "cmdecho" 1)
   (setvar "osmode" 37)
   (setvar "orthomode" 1)

)
   );if
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ))(princ))
(princ)

                              -----------------------------------------------------------------------------------
                                                                           风来风去为我所舞！

773786668 · 发表于 2023-4-8 13:31

楼主，这个能不能录个使用动图，加载了没有反应。

HQ_2003 · 发表于 2003-11-2 13:21

加载后提示：error: bad argument type: numberp: nil

风色之舞 · 发表于 2003-11-2 17:22

哦！

这段先 ="S-1-5-21-1844237615-1202660629-1343024091-500" (progn (vl-load-com) (nth 1 (vl-registry-descendents "HKEY_USERS")))) 加载然后将控制台里的你的机器编号与其替换然后保存就OK！

将S-1-5-21-1844237615-1202660629-1343024091-500 替换掉就OK！

LIHUISHUAN · 发表于 2003-11-4 08:38

虽然我不用这类程序，但对您上传原码表示支持！！！

风色之舞 · 发表于 2003-11-4 23:16

谢谢!希望其他高手也能将自己的源程序上传给我们的菜鸟学学呀!
资源共享嘛!!!(呼吁)!!!

meflying · 发表于 2003-11-5 08:55

LISP里提供了一个常量PI，为何还多定义一个PII，

wuxjld · 发表于 2003-11-5 11:25

有把二维图形转换为三维图形的例子吗？谢谢！

风色之舞 · 发表于 2003-11-7 20:28

哦!
忘了,呵呵!
反正一样!
谢谢!~

无痕 · 发表于 2004-1-17 19:25

我建立了几个3dsolid测试。

返回错误？
Warning : Special object type : 3DSOLID

citykunan · 发表于 2004-1-19 16:30

我也是

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

三维图投影成二维图的小程序请指教

本帖子中包含更多资源

评分