[討論]長度的LISP 在WINDOWS 8的2012CAD無法使用
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論]長度的LISP 在WINDOWS 8的2012CAD無法使用
長度的LISP 在WINDOWS 8的2012CAD無法使用,但在WINDOWS 7的2006 CAD卻可以使用,想請問是哪裡有問題呢?? 應該如何修改
(defun c:LLL ()
(COMMAND "UCS" "")
(setvar "cmdecho" 1)
(SETVAR "OSMODE" 0)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
;;選取需要測量的樣條曲線、圓弧、直線、橢圓
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
(setq i 0)
;;獲取系統參數textsize
(setq shh (getvar "textsize"))
(setq str_hh (strcat "\n文字高度 <" (rtos shh 2 2 ) ">: "))
(setq hh (getdist str_hh))
(while hh
(setvar "textsize" hh)
(setq hh nil))
;;輸入標注文字高度
;;迴圈開始
(repeat (sslength en)
(setq ss (ssname en i))
(setq endata (entget ss))
(command "lengthen" ss "")
(setq dd (getvar "perimeter"))
(princ (strcat "\n長度=" (rtos dd 2 2)))
;;尋找代表圖層的字串
(setq aa (assoc 0 endata))
;;獲取圖層名稱
(setq aa1 (cdr aa))
;;判斷線條種類
(cond
((= aa1 "SPLINE")
;;如果是spline
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-ControlPoints arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;迴圈,尋找最後一個控制點
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
((= aa1 "LWPOLYLINE")
;;如果是LWPOLYLINE
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-Coordinates arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;迴圈,尋找最後一個控制點
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
(t
;;如果是其他種類線條
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-StartPoint arcObj))
;;獲取起點
(setq endPnt1 (vla-get-EndPoint arcObj))
;;獲取終點
(setq pp1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq
pp2 (vlax-safearray->list (vlax-variant-value endPnt1))
)
)
)
)
(setq x1 (car pp1))
(setq y1 (cadr pp1))
(setq z1 (caddr pp1))
(setq x2 (car pp2))
(setq y2 (cadr pp2))
(setq z2 (caddr pp2))
(setq x (/ (+ x1 x2) 2))
(setq y (/ (+ y1 y2) 2))
(setq z (/ (+ z1 z2) 2))
(setq pt (list x y z))
;;取得線段兩端的中點
(setq ang (angle pp1 pp2))
;;獲取角度
(if (> (* (/ ang pi) 180) 180)
(setq ang (+ ang pi))
)
(command "text"
"j"
"bc"
pt
""
(* (/ ang pi) 180)
(strcat "" (rtos dd 2 2))
""
)
(setq i (1+ i))
)
(prin1)
)
(prompt "\n <>在圖中直接寫出長度")
(prin1)
(defun c:LLL ()
(COMMAND "UCS" "")
(setvar "cmdecho" 1)
(SETVAR "OSMODE" 0)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
;;選取需要測量的樣條曲線、圓弧、直線、橢圓
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
(setq i 0)
;;獲取系統參數textsize
(setq shh (getvar "textsize"))
(setq str_hh (strcat "\n文字高度 <" (rtos shh 2 2 ) ">: "))
(setq hh (getdist str_hh))
(while hh
(setvar "textsize" hh)
(setq hh nil))
;;輸入標注文字高度
;;迴圈開始
(repeat (sslength en)
(setq ss (ssname en i))
(setq endata (entget ss))
(command "lengthen" ss "")
(setq dd (getvar "perimeter"))
(princ (strcat "\n長度=" (rtos dd 2 2)))
;;尋找代表圖層的字串
(setq aa (assoc 0 endata))
;;獲取圖層名稱
(setq aa1 (cdr aa))
;;判斷線條種類
(cond
((= aa1 "SPLINE")
;;如果是spline
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-ControlPoints arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;迴圈,尋找最後一個控制點
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
((= aa1 "LWPOLYLINE")
;;如果是LWPOLYLINE
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-Coordinates arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
;;迴圈,尋找最後一個控制點
(setq p1 (cdddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
)
)
(t
;;如果是其他種類線條
(progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-StartPoint arcObj))
;;獲取起點
(setq endPnt1 (vla-get-EndPoint arcObj))
;;獲取終點
(setq pp1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq
pp2 (vlax-safearray->list (vlax-variant-value endPnt1))
)
)
)
)
(setq x1 (car pp1))
(setq y1 (cadr pp1))
(setq z1 (caddr pp1))
(setq x2 (car pp2))
(setq y2 (cadr pp2))
(setq z2 (caddr pp2))
(setq x (/ (+ x1 x2) 2))
(setq y (/ (+ y1 y2) 2))
(setq z (/ (+ z1 z2) 2))
(setq pt (list x y z))
;;取得線段兩端的中點
(setq ang (angle pp1 pp2))
;;獲取角度
(if (> (* (/ ang pi) 180) 180)
(setq ang (+ ang pi))
)
(command "text"
"j"
"bc"
pt
""
(* (/ ang pi) 180)
(strcat "" (rtos dd 2 2))
""
)
(setq i (1+ i))
)
(prin1)
)
(prompt "\n <
(prin1)
hist- 一般會員
- 文章總數 : 16
年齡 : 36
來自 : taipei
職業 : 待業
愛好 : 研究
個性 : good
使用年資 : 新手初學
使用版本 : 2012
經驗值 : 4186
威望值 : 0
注冊日期 : 2013-07-10
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章