[分享]基準點-參考點-目標距離,PPD.LSP...用副程式取得getxxx所需字串
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[分享]基準點-參考點-目標距離,PPD.LSP...用副程式取得getxxx所需字串
本程式僅收集資訊,收集完成後再執行預設的程式.
目前編寫完成的程式有2個,
一個是畫線程式;一個是拉伸圖元程式.
本程式有三種模式:以下模式皆會產生一個目標點
"PPD",getpoint-getpoint-getdist
基準點-參考點-目標距離
可以選擇抓取目標點時,距離要不要修整.
"PP",getpoint-getpoint
基準點-參考點
抓取目標點時,距離自動修整,距離的依據為基準點到參考點距離.
"PC",getpoint-getcorner
基準點-參考點(抓點模式getcorner)
抓取目標點時,距離自動修整,
距離的依據為基準點X/Y/Z座標到參考點X/Y/Z座標距離.
本程式需搭配程式qload來使用,
qload的程式請見shenhung的分享,請點下面連結.
https://www.autocad-tw.com/t9104-topic
PPD程式,檔名請用RG_PPD V1.00.LSP
這個PPD程式中有一個副程式str:initget可以取得getxxx所需字串,
基本上如果getxxx所需字串不需要經過很多條件式來產生的話,
不用這副程式會比較好,因為這副程式其實不太好懂...@@a
副程式str:initget所需求的變數str:L0所能接受的是list,有固定能接受的格式在
(用起來其實還蠻麻煩的@@a)...
它裡面的組成是關鍵LIST組(字組內部可為nil)或複數關鍵LIST組,
關鍵LIST組是由說明文字、關鍵字、關鍵字替用文字(可有可無)所組成的.
格式為("說明文字" "關鍵字")或("說明文字" "關鍵字" "關鍵字替用文字")
複數關鍵LIST組是由單個或多個關鍵LIST組所組成,
格式為(nil 關鍵LIST組1 關鍵LIST組2....)
實際的用法請看程式PPD裡面的子程式run:P1、run:P2、run:L
目前編寫完成的程式有2個,
一個是畫線程式;一個是拉伸圖元程式.
本程式有三種模式:以下模式皆會產生一個目標點
"PPD",getpoint-getpoint-getdist
基準點-參考點-目標距離
可以選擇抓取目標點時,距離要不要修整.
"PP",getpoint-getpoint
基準點-參考點
抓取目標點時,距離自動修整,距離的依據為基準點到參考點距離.
"PC",getpoint-getcorner
基準點-參考點(抓點模式getcorner)
抓取目標點時,距離自動修整,
距離的依據為基準點X/Y/Z座標到參考點X/Y/Z座標距離.
本程式需搭配程式qload來使用,
qload的程式請見shenhung的分享,請點下面連結.
https://www.autocad-tw.com/t9104-topic
PPD程式,檔名請用RG_PPD V1.00.LSP
- 代碼:
;;;本程式需搭配qload使用
;;;(defun C:輸入的指令 ()
;;; (RG:PPD "指令名稱" C:程式指令 是否有先行設定 L_unit預設值 L_valve預設值))
;;指令[有,沒有]包含設定=[T,nil]
(defun C:SR () (RG:PPD "SR1" C:SR1 nil 1.0 -0.5)) ;_C:SR
(defun C:LR () (RG:PPD "LR1" C:LR1 T 1.0 -0.5)) ;_C:LR
;;;為了同參數能跨程式直接使用
;;(defun C:輸入的指令 () (qload "lisp檔案名稱" "程式指令"))
(defun C:SR1 () (qload "StretchReferenceV1.00.LSP" "SR1")) ;_C:SR1
(defun C:LR1 () (qload "LineReferenceV1.00.LSP" "LR1")) ;_C:LR1
;|
持續沿用的變數
RG:PPD:oP1
上次使用的P1
RG:PPD:oP2
上次使用的P2
RG:PPD:oP3
上次使用的P3(已修整)
有更動修整設定時,需避免刻舟求劍
RG:PPD:oL
上次使用的L(未修整)
RG:PPD:L_unit
修整L所用的長度單位(需為REAL)
RG:PPD:L_valve
修整L所用的進位閥值(需為REAL)
負數 ,不修整
0 ,無條件進位
1 ,無條件捨去
0.5 ,四捨五入
RG:PPD:MODEL
"PPD",getpoint-getpoint-getdist
"PP",getpoint-getpoint
"PC",getpoint-getcorner
RG:PPD:USUBR
啟動"C:程式指令"的額外設定
nil ,正常執行
T ,先行設定,此設定設為T後執行C:程式指令
|;
(defun RG:PPD
(lsp_cmd lsp_cmd_USUBR PPD:SETUP L_unit L_valve / *error*
P1 P2)
;;吃掉錯誤訊息顯示
; (defun *error* (msg)
; (princ)
; )
;;;RG:PPD內部副程式
;;回傳P1點座標
(defun run:P1 (lsp_cmd_USUBR PPD:SETUP / getxxx str:LIST)
;;回傳while最後的回傳成為P1
(while (null getxxx)
;;設定提示訊息
(SETQ str:LIST
(str:initget
(LIST
(IF RG:PPD:oP3
(LIST "上次終點" "E")
)
(IF PPD:SETUP
(LIST "設定" "S")
)
)
)
)
(INITGET
;;判斷有沒有上次P1
(IF RG:PPD:oP3
0
1
)
(car str:LIST)
)
(SETQ getxxx
(GETPOINT (strcat
"設定基準點"
(cadr str:LIST)
(IF RG:PPD:oP3
"<上次基準點>"
""
)
":"
)
)
)
;;while最後回傳
(SETQ getxxx
(COND
;;點座標
((EQ (TYPE getxxx) 'LIST) (eval 'getxxx)) ;_cond1
;;使用上次P1
((null getxxx) (eval 'RG:PPD:oP1)) ;_cond2
;;使用上次P3
((= getxxx "E")
RG:PPD:oP3
) ;_cond3
;;執行程式設定
((= getxxx "S")
(progn
(SETQ RG:PPD:USUBR T)
(lsp_cmd_USUBR)
;;繼續迴圈
nil
)
) ;_cond4
) ;_COND
)
) ;_while
) ;_run:P1
;;回傳點座標P2
(defun run:P2 (P1 / getxxx str:LIST str:tmp)
;;回傳while的最後回傳成為P2
(while (null getxxx)
;;設定提示訊息
(SETQ str:LIST
(str:initget
(LIST
(IF RG:PPD:oP3
(LIST
nil
(LIST "上次參考點位移" "S")
(LIST "上次終點位移" "E")
)
)
(IF (/= RG:PPD:MODEL "PPD")
(LIST
nil
(LIST "恢復PPD模式" "X")
(LIST (strcat "修整單位:" (rtos RG:PPD:L_unit 2 8)) "U")
(LIST (strcat "進位閥:" (rtos (abs RG:PPD:L_valve) 2 8))
"V"
)
)
)
(IF (/= RG:PPD:MODEL "PC")
(LIST "切換至PC模式" "C")
)
)
)
)
(SETQ str:tmp (strcat "設定參考點"
(cadr str:LIST)
(IF RG:PPD:oP3
"<上次參考點>:"
":"
)
)
)
(initget (IF RG:PPD:oP3
0
1
)
(car str:LIST)
)
(SETQ getxxx
(IF (= RG:PPD:MODEL "PC")
(getcorner P1 str:tmp)
(getpoint P1 str:tmp)
) ;_IF
)
;;while最後回傳
(SETQ getxxx
;;是否為點
(COND
((EQ (TYPE getxxx) 'LIST)
;;點,判斷距離是否為0
(IF (= (distance P1 getxxx) 0)
;;繼續迴圈
(prompt "參考點等於基準點,請重新輸入.\n")
getxxx
)
) ;_cond 1
;;是否為空
((null getxxx)
RG:PPD:oP2
) ;_cond 2
((= getxxx "X")
(progn
(SETQ RG:PPD:MODEL "PPD")
;;繼續迴圈
(prompt "恢復PPD模式.\n")
)
) ;_cond3
((= getxxx "C")
(progn
(SETQ RG:PPD:MODEL "PC")
;;繼續迴圈
(prompt "切換至PC模式.\n")
)
) ;_cond4
((= getxxx "S")
(RC2AC P1 (AC2RC RG:PPD:oP1 RG:PPD:oP2))
) ;_cond5
((= getxxx "E")
(RC2AC P1 (AC2RC RG:PPD:oP1 RG:PPD:oP3))
) ;_cond6
;;設定單位
((= getxxx "U")
;;用副程式get:U設定,繼續迴圈
(get:U)
) ;_cond7
;;設定閥值
((= getxxx "V")
;;用副程式get:V設定,繼續迴圈
(get:V)
) ;_cond8
) ;_COND
)
) ;_while
) ;_run:P2
;;回傳L
(defun run:L (P1 P2 / getxxx str:LIST)
;;回傳while的最後回傳成為L
(while (null getxxx)
;;while最後回傳
(SETQ getxxx
(COND
;;非"PPD模式"自動計算L
((/= RG:PPD:MODEL "PPD")
;;回傳P1到P2距離
(distance P1 P2)
) ;_cond 1
(T ;_cL
(progn ;_cond last
(SETQ str:LIST
(str:initget
(LIST
(LIST "兩點模式" "P")
(IF (minusp RG:PPD:L_valve)
(LIST "開啟修整" "F")
(LIST
nil
(LIST "關閉修整" "F")
(LIST (strcat "單位:" (rtos RG:PPD:L_unit 2 8))
"U"
)
(LIST (strcat "進位閥:" (rtos RG:PPD:L_valve 2 8))
"V"
)
)
) ;_IF
)
)
)
(initget (IF RG:PPD:oP3
6
7
)
(car str:LIST)
)
(SETQ getxxx (getdist P1
(strcat
"設定目標長度"
(cadr str:LIST)
(IF RG:PPD:oL
"<上次未修整目標長度>:"
":"
)
)
)
)
;;依輸入回傳
(COND
;;為長度
((numberp getxxx) getxxx) ;_cL-cond1
;;上次L
((null getxxx)
RG:PPD:oL
) ;_cL-cond2
;;兩點模式
((= getxxx "P")
(progn
(SETQ RG:PPD:MODEL "PP")
;;繼續迴圈
(prompt "兩點模式開啟.\n")
)
) ;_cL-cond3
;;開啟或關閉修整
((= getxxx "F")
(progn
(SETQ RG:PPD:L_valve (- 0.0 RG:PPD:L_valve))
;;繼續迴圈
(prompt "修整模式切換.\n")
)
) ;_cL-cond4
;;設定單位
((= getxxx "U")
;;用副程式get:U設定,繼續迴圈
(get:U)
) ;_cL-cond5
;;設定閥值
((= getxxx "V")
;;用副程式get:V設定,繼續迴圈
(get:V)
) ;_cL-cond6
) ;_cL-COND
) ;_progn cond last
) ;_cL
) ;_COND
) ;_SETQ
) ;_while
) ;_run:L
;;回傳合乎規定的最小單位設定值
(defun get:U ()
(initget 7)
(SETQ RG:PPD:L_unit (getreal "設定單位:"))
(prompt (strcat "已設定單位為:"
(rtos RG:PPD:L_unit 2 8)
"\n"
)
)
)
;;回傳合乎規定的進位閥設定值
(defun get:V (/ getxxx)
(SETQ RG:PPD:L_valve
(* (IF (minusp RG:PPD:L_valve)
-1
1
)
(while (OR (null getxxx) (> getxxx 1.0))
(initget 5)
(SETQ getxxx
(getreal
(strcat
(IF (> getxxx 1.0)
"數值必需是在 0和1 之間.\n"
""
)
"設定進位閥; 0,無條件進位; 0.5,四捨五入; 1,無條件捨去:"
)
)
)
) ;_while
)
)
(prompt (strcat "已設定進位閥為:"
(rtos (abs RG:PPD:L_valve) 2 8)
"\n"
)
)
) ;_get:v
;;;RG:PPD的主程式
(setvar "cmdecho" 0)
;;預設值設定
(IF (null RG:PPD:L_unit)
(SETQ RG:PPD:L_unit L_unit)
)
(IF (null RG:PPD:L_valve)
(SETQ RG:PPD:L_valve L_valve)
)
(IF (null RG:PPD:MODEL)
(SETQ RG:PPD:MODEL "PPD")
)
;;設定P1
(PRIN1 (SETQ P1 (run:P1 lsp_cmd_USUBR PPD:SETUP)))
(PRINT)
;;設定P2
(PRIN1 (SETQ P2 (run:P2 P1)))
(PRINT)
;;設定oL;將P1和P2轉oP1和oP2備用;計算oP3
(SETQ RG:PPD:oL (run:L P1 P2)
RG:PPD:oP1 P1
RG:PPD:oP2 P2
RG:PPD:oP3 (RG:PPD_def:P3)
)
(IF (/= RG:PPD:MODEL "PC")
(PRIN1 RG:PPD:oL)
)
(PRINT)
(prompt (strcat "如要用相同數值執行,請輸入指令:" lsp_cmd))
;;執行程式
(lsp_cmd_USUBR)
(PRINT)
) ;_defun RG:PPD
;;;RG:PPD使用的副程式補完開始
;RG:PPD專用副程式,回傳P3點座標
;;需搭配real:fix使用
;;(RG:PPD_def:P3)
(defun RG:PPD_def:P3 (/ L m tmp:list ox1 oy1 oz1 ox2 oy2 oz2)
(IF (/= RG:PPD:MODEL "PC")
(progn
;;檢查是否需修整
(IF (AND (minusp RG:PPD:L_valve) (/= RG:PPD:MODEL "PP"))
;;未修整長度
(SETQ L RG:PPD:oL)
;;修整長度
(SETQ
L (real:fix RG:PPD:oL (abs RG:PPD:L_unit) RG:PPD:L_valve)
)
)
(polar RG:PPD:oP1 (angle RG:PPD:oP1 RG:PPD:oP2) L)
) ;_p if T
(progn
(reverse (FOREACH m (LIST 0 1 2)
(SETQ
tmp:list
(cons
(+ (nth m RG:PPD:oP1)
(real:fix
(- (nth m RG:PPD:oP2) (nth m RG:PPD:oP1))
(abs RG:PPD:L_unit)
RG:PPD:L_valve
)
)
tmp:list
)
)
)
)
) ;_p if nil
) ;_IF
) ;_RG:PPD_def:P3
;傳回real修整後的值
;;(real:fix 輸入real 修整單位 修整閥值)
(defun real:fix (L mi v)
(IF (>= (rem (abs L) mi) (* mi (abs v)))
;;進位
(* (IF (minusp L)
(1- (fix (/ L mi)))
(1+ (fix (/ L mi)))
)
mi
)
(* (fix (/ L mi)) mi) ;_捨去
)
) ;_real:fix
;傳回提示字串串列=(list 用於initget字串 用於getxxx字串)
(defun str:initget (str:L0 / str:L m n tmp1 tmp2)
;;str:L0轉為str:L
(FOREACH m str:L0
(IF (null (car m))
(FOREACH n (cdr m)
(SETQ str:L (cons n str:L))
)
(SETQ str:L (cons m str:L))
)
)
(IF str:L
(progn
(SETQ tmp1 ""
tmp2 ""
tmp3 "或 ["
)
(FOREACH m (reverse str:L)
(SETQ tmp1 (strcat tmp1 (cadr m) " ")
tmp2 (strcat tmp2
(IF (caddr m)
(caddr m)
(cadr m)
)
" "
)
tmp3 (strcat tmp3 (car m) "(" (cadr m) ")/")
)
) ;_FOR
(LIST
(strcat tmp1 "_" tmp2)
(strcat (substr tmp3 1 (1- (strlen tmp3))) "]")
)
) ;_if T
;;str:L為空
(LIST "" "") ;_if nil
)
) ;_str:initget
;輸入絕對座標,回傳相對座標
;;(AC2RC 基準點絕對座標 參考點絕對座標)
(defun AC2RC (fr to)
(LIST
(- (CAR to) (CAR fr))
(- (CADR to) (CADR fr))
(- (CADDR to) (CADDR fr))
)
) ;_AC2RC
;輸入相對座標,回傳絕對座標
;;(RC2AC 基準點絕對座標 參考點相對座標)
(defun RC2AC (fr to)
(LIST
(+ (CAR to) (CAR fr))
(+ (CADR to) (CADR fr))
(+ (CADDR to) (CADDR fr))
)
) ;_RC2AC
- 代碼:
(defun c:SR()(qload "RG_PPD V1.00.LSP" "SR"))
(defun c:SR1()(qload "RG_PPD V1.00.LSP" "SR1"))
(defun c:LR()(qload "RG_PPD V1.00.LSP" "LR"))
(defun c:LR1()(qload "RG_PPD V1.00.LSP" "LR1"))
這個PPD程式中有一個副程式str:initget可以取得getxxx所需字串,
基本上如果getxxx所需字串不需要經過很多條件式來產生的話,
不用這副程式會比較好,因為這副程式其實不太好懂...@@a
副程式str:initget所需求的變數str:L0所能接受的是list,有固定能接受的格式在
(用起來其實還蠻麻煩的@@a)...
它裡面的組成是關鍵LIST組(字組內部可為nil)或複數關鍵LIST組,
關鍵LIST組是由說明文字、關鍵字、關鍵字替用文字(可有可無)所組成的.
格式為("說明文字" "關鍵字")或("說明文字" "關鍵字" "關鍵字替用文字")
複數關鍵LIST組是由單個或多個關鍵LIST組所組成,
格式為(nil 關鍵LIST組1 關鍵LIST組2....)
實際的用法請看程式PPD裡面的子程式run:P1、run:P2、run:L
RyanGuo 在 2013-10-15, 18:20 作了第 3 次修改
RyanGuo- 初級會員
- 文章總數 : 206
年齡 : 41
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 5519
威望值 : 316
注冊日期 : 2013-04-18
回復: [分享]基準點-參考點-目標距離,PPD.LSP...用副程式取得getxxx所需字串
畫線程式,檔名請用LineReferenceV1.00.LSP
畫線模式有以下幾種:
nil,預設的畫線模式,只畫單一線段,從基準點畫線到目標點.
"E",兩端對稱線:中心點-端點,畫出單一線段,從目標點畫線到相對於基準點的鏡射點.
"M",兩互相鏡射線:鏡射點-鏡射線中心點,畫出兩條線,這兩條線的中點的連線之中點為基準點.
- 代碼:
;;;此檔需搭配RG:PPD使用
;|
持續沿用的變數
RG:LR:SET
決定畫線的模式
nil,單一線段
"E",兩端對稱線:中心點-端點
"M",兩互相鏡射線:鏡射點-鏡射線中心點
|;
(defun C:LR1 (/ *error*)
;;吃掉錯誤訊息顯示
; (defun *error* (msg)
; (princ)
; )
(defun set:LR1 (/ getxxx)
(initget "E M")
(SETQ RG:LR:SET
(getkword
"設定LR畫線模式[(E)兩端對稱線:中心點-端點/(M)兩互相鏡射線:鏡射點-鏡射線中心點]<單一線段>:"
)
)
(prompt "設定結束..\n")
)
;;指令執行
(defun run:LR1 ()
(COND ((null RG:LR:SET)
(COMMAND "LINE" RG:PPD:oP1 RG:PPD:oP3 "")
) ;_cond 1
((= RG:LR:SET "E") (run:LR:E)) ;_cond 2
((= RG:LR:SET "M") (run:LR:M)) ;_cond 3
) ;_COND
(PRINT)
)
(defun run:LR:E ()
(COMMAND "LINE"
RG:PPD:oP3
(polar RG:PPD:oP1
(+ (angle RG:PPD:oP1 RG:PPD:oP3) pi)
(distance RG:PPD:oP1 RG:PPD:oP3)
)
""
)
)
(defun run:LR:M (/ L AG m LP1 LP2)
(SETQ AG (angle RG:PPD:oP1 RG:PPD:oP3)
L (distance RG:PPD:oP1 RG:PPD:oP3)
)
(FOREACH m (LIST RG:PPD:oP3 (polar RG:PPD:oP1 (+ AG pi) L))
(SETQ LP1 (polar m (+ (* pi 0.5) AG) (* L 0.125))
LP2 (polar m (+ (* pi 1.5) AG) (* L 0.125))
)
(COMMAND "LINE" LP1 LP2 "")
)
)
;;是否為先行設定
(IF RG:PPD:USUBR
(SETQ RG:PPD:USUBR (set:LR1))
;;參數是否足夠
(IF (null RG:PPD:oP3)
(progn
(prompt "參數不足,改為執行指令:LR\n")
(C:LR)
)
(run:LR1)
)
)
) ;_LAST
畫線模式有以下幾種:
nil,預設的畫線模式,只畫單一線段,從基準點畫線到目標點.
"E",兩端對稱線:中心點-端點,畫出單一線段,從目標點畫線到相對於基準點的鏡射點.
"M",兩互相鏡射線:鏡射點-鏡射線中心點,畫出兩條線,這兩條線的中點的連線之中點為基準點.
RyanGuo 在 2013-10-04, 18:39 作了第 1 次修改
RyanGuo- 初級會員
- 文章總數 : 206
年齡 : 41
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 5519
威望值 : 316
注冊日期 : 2013-04-18
回復: [分享]基準點-參考點-目標距離,PPD.LSP...用副程式取得getxxx所需字串
拉伸圖元程式,檔名請用StretchReferenceV1.00.LSP
- 代碼:
;;;此檔需搭配RG:PPD使用
;|
持續沿用的變數
oPICKFIRST
記錄PICKFIRST設定值
|;
(defun C:SR1 (/ *error*)
;;吃掉錯誤訊息顯示,及恢復系統變數設定值
(defun *error* (msg)
(setvar "PICKFIRST" oPICKFIRST)
(princ)
)
;;指令執行
(defun run:SR1 (/ ox2 oy2 oz2 ox3 oy3 oz3)
(SETQ oPICKFIRST (getvar "PICKFIRST"))
(setvar "PICKFIRST" 0)
(IF (/= RG:PPD:MODEL "PC")
(progn
(prompt "\n選擇要STRETCH的圖元..")
(COMMAND "STRETCH" (ssget) "" RG:PPD:oP2 RG:PPD:oP3)
)
(progn
(SETQ
ox2 (car RG:PPD:oP2)
oy2 (cadr RG:PPD:oP2)
oz2 (caddr RG:PPD:oP2)
ox3 (car RG:PPD:oP3)
oy3 (cadr RG:PPD:oP3)
oz3 (caddr RG:PPD:oP3)
)
(IF (/= ox2 ox3)
(progn
(prompt "\n選擇要STRETCH的圖元,X方向..")
(COMMAND "STRETCH" (ssget) "" (LIST ox2 oy3 oz3) RG:PPD:oP3)
)
)
(IF (/= oy2 oy3)
(progn
(prompt "\n選擇要STRETCH的圖元,Y方向..")
(COMMAND "STRETCH" (ssget) "" (LIST ox3 oy2 oz3) RG:PPD:oP3)
)
)
(IF (/= oz2 oz3)
(progn
(prompt "\n選擇要STRETCH的圖元,Z方向..")
(COMMAND "STRETCH" (ssget) "" (LIST ox3 oy3 oz2) RG:PPD:oP3)
)
)
)
)
(setvar "PICKFIRST" oPICKFIRST)
(PRINT)
)
;;;主程式只判斷參數是否足夠
(setvar "cmdecho" 0)
(IF (null RG:PPD:oP3)
(progn (prompt "\n參數不足,改為執行指令:SR")
(C:SR)
)
(run:SR1)
)
)
RyanGuo 在 2013-10-07, 15:56 作了第 5 次修改 (原因 : 用"PICKFIRST",忽視指令執行前的選取,異常終止時恢復原有設定..)
RyanGuo- 初級會員
- 文章總數 : 206
年齡 : 41
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 5519
威望值 : 316
注冊日期 : 2013-04-18
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章