三维图投影成二维图的小程序请指教
[三维图投影成二维图]defun c:3dty(/ draw_line s1n obl
tou osmode value fszw019
fszw020 fszw020-2 fszw020-1fszw005
fszw005-1DEL_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 okTT 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 T1T3T4) 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 T1T3T4) entnam 1) T-L))
)
((= typ "POLYLINE")
(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 "POINT")
(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))))
(setqOB-L(entget obl)
tou (cdr (assoc 0 OB-L))
)
(if (member TOU '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "POINT" "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)
-----------------------------------------------------------------------------------
风来风去为我所舞！ 楼主，这个能不能录个使用动图，加载了没有反应。 加载后提示：error: bad argument type: numberp: nil 哦！
这段先="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！
虽然我不用这类程序，但对您上传原码表示支持！！！ 谢谢!希望其他高手也能将自己的源程序上传给我们的菜鸟学学呀!
资源共享嘛!!!(呼吁)!!! LISP里提供了一个常量PI，为何还多定义一个PII， 有把二维图形转换为三维图形的例子吗？谢谢！ 哦!
忘了,呵呵!
反正一样!
谢谢!~ 我建立了几个3dsolid测试。
返回错误？
Warning : Special object type : 3DSOLID 我也是
页:
[1]
2