[分享]基準點-參考點-目標距離,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

代碼:

;;;本程式需搭配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

為運行順利,請在acaddoc.lsp中加入下面程式

代碼:

(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

畫線程式,檔名請用LineReferenceV1.00.LSP

代碼:

;;;此檔需搭配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

這程式可以在PPD程式執行後的一開始修改畫線模式,
畫線模式有以下幾種:
nil,預設的畫線模式,只畫單一線段,從基準點畫線到目標點.
"E",兩端對稱線:中心點-端點,畫出單一線段,從目標點畫線到相對於基準點的鏡射點.
"M",兩互相鏡射線:鏡射點-鏡射線中心點,畫出兩條線,這兩條線的中點的連線之中點為基準點.

拉伸圖元程式,檔名請用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)
  )
)