AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
LISP修改伪源碼問題(已經自己解決) Io15011 LISP修改伪源碼問題(已經自己解決) 2020-310 LISP修改伪源碼問題(已經自己解決) Oiu15010 LISP修改伪源碼問題(已經自己解決) 2020-211 LISP修改伪源碼問題(已經自己解決) Oo-2-110 LISP修改伪源碼問題(已經自己解決) BPl3tjj

LISP修改伪源碼問題(已經自己解決)

2 posters

向下

LISP修改伪源碼問題(已經自己解決) Empty LISP修改伪源碼問題(已經自己解決)

發表 由 ga619091 2020-11-18, 16:52

此源碼是要加載工具箱才能執行的代碼
不過因為加載工具箱後CAD開啟速度變很慢
所以想請問板上的大大們是否能把伪源碼改成純源碼?
附上源碼及影片跟照片的功能


LISP修改伪源碼問題(已經自己解決) 0110

(defun c:ff (/ Dlst ll1 ll2) ;2020-03-13 ff(中線角圓)
 (xyp-Start)
 (defun main-pro ()
   (xyp-MkLaCo "TEST1" 1)
   (princ "\n選擇矩形<退出>: ")
   (setq ss (ssget '((0 . "*pol*")))
 i  -1
   )
   (while (setq s1 (ssname ss (setq i (1+ i))))
     (if (= bo1 "1")
(progn
 (foreach pt (list (xyp-Pt2XY (xyp-9pt s1 1) 8 8)
   (xyp-Pt2XY (xyp-9pt s1 9) -8 -8)
     )
   (xyp-CircleCr pt (* r2 0.5))
   (xyp-CircleCr pt (* r3 0.5))
 )
 (foreach pt (list (xyp-Pt2XY (xyp-9pt s1 3) -8 8)
   (xyp-Pt2XY (xyp-9pt s1 7) 8 -8)
     )
           (xyp-CircleCr pt (* r1 0.5))
 )
)
     )
     (xyp-Line (setq p2 (xyp-9pt s1 2)) (xyp-Pt2Y p2 d1))
     (xyp-Line (setq p8 (xyp-9pt s1 8)) (xyp-Pt2Y p8 (- d1)))
     (xyp-Line (setq p4 (xyp-9pt s1 4)) (xyp-Pt2X p4 d1))
     (xyp-Line (setq p6 (xyp-9pt s1 6)) (xyp-Pt2X p6 (- d1)))
   )
 )
 (defun abo1 ()
   (xyp-Dcl-Gettile '("bo1"))
   (cond ((= bo1 "1") (xyp-Dcl-KeyEnable '("r1" "r2" "r3") t))
 ((= bo1 "0") (xyp-Dcl-KeyEnable '("r1" "r2" "r3") nil))
   )
 )
 (setq ll1 '(d1 r1 r2 r3 bo1)
ll2 '(5. 3. 3.1 3.6 "0")
 )
 (defun ajbcs () (xyp-MultSettile ll1 ll2))
 (xyp-initSet ll1 ll2)
 (setq Dlst '(("" "參數" ":boxed_column{")
      ("d1" "中線" "real" "8")
      ("r1" "直徑1" "real" "8")
      ("r2" "直徑2" "real" "8")
      ("r3" "直徑3" "real" "8")
      "spacer;"
      ("bo1" "角圓" "bool" "(abo1)")
      "spacer;"
      ("jbcs" "預設參數" "button1" "(ajbcs)")
      "}"
      ("" "" "user" "(abo1)")
     )
 )
 (if (= (xyp-Dcl-Init Dlst "【中線角圓】" t) 1)
   (main-pro)
 )
 (xyp-End)
)
ga619091
ga619091
一般會員
一般會員

文章總數 : 5
年齡 : 28
來自 : 新北市
職業 : 繪圖
愛好 : 電腦
個性 : 幽默
使用年資 : 4年
使用版本 : 2007
經驗值 : 657
威望值 : 6
注冊日期 : 2020-01-06
男 射手座 猴

回頂端 向下

LISP修改伪源碼問題(已經自己解決) Empty 回復: LISP修改伪源碼問題(已經自己解決)

發表 由 ga619091 2020-11-23, 14:57

附上源碼

代碼:
;矩形中心線
(defun c:ss()
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(command "undo" "be")
(If (progn
(princ "請選取矩形:")
(setq ssa (ssget":S" '((0 . "lwpolyline") (90 . 4) (70 . 1))))
)
(progn
(setq dxf (entget (ssname ssa 0)))
(setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
(setq p1 (apply 'mapcar (cons 'min pts)))
(setq p3 (apply 'mapcar (cons 'max pts)))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq p14m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p1 p4))
(setq p14m2 (mapcar '+ p14m1 '(5 0)))
(setq p12m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p1 p2))
(setq p12m2 (mapcar '+ p12m1 '(0 5)))
(setq p23m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p2 p3))
(setq p23m2 (mapcar '+ p23m1 '(-5 0)))
(setq p34m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p3 p4))
(setq p34m2 (mapcar '+ p34m1 '(0 -5)))
(setvar "osmode" 0)
(mapcar '(lambda(pts)
(command "_line" (car pts) (cadr pts) "" "_chprop" (entlast) "" "c" 1 "")
)
(list (list p14m1 p14m2)
(list p12m1 p12m2)
(list p23m1 p23m2)
(list p34m1 p34m2)
)
)
(mapcar '(lambda(pt dxy)
(setq pt1 (mapcar '+ pt dxy))
)
(list p1 p2 p3 p4 )
(list ' (-8 8) '(8 -8)) 
)
)
)
(command "undo" "e")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)

代碼:
;矩形中心線
(defun c:ff()
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(command "undo" "be")
(If (progn
(princ "請選取矩形:")
(setq ssa (ssget":S" '((0 . "lwpolyline") (90 . 4) (70 . 1))))
)
(progn
(setq dxf (entget (ssname ssa 0)))
(setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
(setq p1 (apply 'mapcar (cons 'min pts)))
(setq p3 (apply 'mapcar (cons 'max pts)))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq p14m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p1 p4))
(setq p14m2 (mapcar '+ p14m1 '(5 0)))
(setq p12m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p1 p2))
(setq p12m2 (mapcar '+ p12m1 '(0 5)))
(setq p23m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p2 p3))
(setq p23m2 (mapcar '+ p23m1 '(-5 0)))
(setq p34m1 (mapcar '(lambda(a b)(* 0.5 (+ a b))) p3 p4))
(setq p34m2 (mapcar '+ p34m1 '(0 -5)))
(setvar "osmode" 0)
(mapcar '(lambda(pts)
(command "_line" (car pts) (cadr pts) "" "_chprop" (entlast) "" "c" 1 "")
)
(list (list p14m1 p14m2)
(list p12m1 p12m2)
(list p23m1 p23m2)
(list p34m1 p34m2)
)
)
(mapcar '(lambda(pt dxy)
(setq pt1 (mapcar '+ pt dxy))
(command "_Circle" pt1 1.55 "_chprop" (entlast) "" "c" 1 "")
(command "_Circle" pt1 1.80 "_chprop" (entlast) "" "c" 1 "")
)
(list p1 p3 )
(list '(8 8) '(-8 -8)) 
)
)
)
(mapcar '(lambda(pt dxy)
(setq pt1 (mapcar '+ pt dxy))
(command "_Circle" pt1 1.50 "_chprop" (entlast) "" "c" 1 "")
)
(list p2 p4 )
(list '(-8 8) '(8 -8))
)
(command "undo" "e")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
ga619091
ga619091
一般會員
一般會員

文章總數 : 5
年齡 : 28
來自 : 新北市
職業 : 繪圖
愛好 : 電腦
個性 : 幽默
使用年資 : 4年
使用版本 : 2007
經驗值 : 657
威望值 : 6
注冊日期 : 2020-01-06
男 射手座 猴

回頂端 向下

LISP修改伪源碼問題(已經自己解決) Empty 回復: LISP修改伪源碼問題(已經自己解決)

發表 由 Tiger&蘋果爸 2020-11-24, 10:32

謝謝回報成果
恭喜你自行解決囉~

____________________________________________________________________________________
LISP修改伪源碼問題(已經自己解決) Oo-2-110 LISP修改伪源碼問題(已經自己解決) Ia15010 LISP修改伪源碼問題(已經自己解決) Ziao1510 LISP修改伪源碼問題(已經自己解決) BPl3tjj
Tiger&蘋果爸
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 19819
年齡 : 45
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 20↑
使用版本 : AutoCAD 2021
經驗值 : 79724
威望值 : 15371
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
LISP修改伪源碼問題(已經自己解決) Uos15010 LISP修改伪源碼問題(已經自己解決) BPl3tjj LISP修改伪源碼問題(已經自己解決) Ziao1510 LISP修改伪源碼問題(已經自己解決) Oo-2-110 LISP修改伪源碼問題(已經自己解決) Oooo-110 LISP修改伪源碼問題(已經自己解決) 2020-211