俞雲霨工作室

MEASURE 指令加強版_Y021(20131115)
(本程式2013/08/27首次發表於AutoCAD顧問論壇)

MEASURE 指令很好用，但操作步驟很繁瑣。要先查詢BLOCK的名稱，再敲鍵盤輸入，還要再輸入間隔長度，很困擾。
將它改寫，可以指定圖面上現有的BLOCK，不用知道它的名稱，第二次執行時，也不用再重複輸入長度，試看看有沒有比較方便。

;;MEASURE 指令加強版
;;for AutoCAD 2013 中文版之 AutoLISP
;; 2013/11/15

(defun C:Y021 (/ scm shig *ERROR* obj BL ch dd p)
    (setq scm  (getvar "cmdecho"))
    (setq shig (getvar "highlight"))
        (setvar "cmdecho"   0)
        (setvar "highlight" 1)

    (defun *ERROR* (msg)
        ;;(:Ys+var:)
        (setvar "clayer" "0")
        (setvar "celtype" "ByLayer")
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n*** Error: " msg " ***")))
    (princ) )

    (:Y021-1:)
    (if (null y021) (setq y021 100)) (setq dd y021)
    (setq p (getdist (strcat "\n指定分段長度 <" (rtos dd) ">: ")))
    (if p (setq dd p)) (setq y021 dd)
    (command "._MEASURE" obj "_B" BL ch dd)
    (command "._REDRAW")
    (princ "\n****** End!  結束! ******")

    (setvar "cmdecho"   scm)
    (setvar "highlight" shig)
(princ)
)
(prompt "\n****** Load << MEASURE 指令加強版 >> Successful ******")
(prin1)

(defun :Y021-1: ()
    (setq obj (entsel "\n選取要測量的物件: "))
    (if obj
        (if (or (= (cdr (assoc 0 (entget (car obj)))) "CIRCLE")     ;;圓
                (= (cdr (assoc 0 (entget (car obj)))) "ELLIPSE")    ;;橢圓
                (= (cdr (assoc 0 (entget (car obj)))) "LINE")       ;;線
                (= (cdr (assoc 0 (entget (car obj)))) "LWPOLYLINE") ;;聚合線
                (= (cdr (assoc 0 (entget (car obj)))) "SPLINE")     ;;雲行線
                (= (cdr (assoc 0 (entget (car obj)))) "ARC") )      ;;弧
            (progn
                (setq BL (getstring "\n輸入要插入的BLOCK名稱或 [指定要插入的BLOCK物件(Enter)]: "))
                (if (= BL "") (:Y021-2:) (:Y021-3:)) )
            (progn
                (princ "\n*** 無法測量該物件. 請重新選取... ***")
                (:Y021-1:)) )
        (progn (princ "\n*無效的選取*") (:Y021-1:) )
)   )

(defun :Y021-2: (/ ent ss en)
    (setq ent (entsel "\n指定要插入的BLOCK: "))
    (if ent
        (if (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
            (progn
                (setq ss (ssget (cadr ent)))
                (setq en (entget (ssname ss 0)))
                (setq BL (cdr (assoc 2 en)))
                (princ (strcat "\n  Block 名稱為: " BL))
                (:Y021-3:) )
            (progn
                (princ "\n*** 這不是 Block 物件, 請重新執行... ***")
                (:Y021-2:)) )
        (progn (princ "\n*無效的選取*") (:Y021-2:) )
)   )

(defun :Y021-3: ()
    (initget "Y N")
    (setq ch (getkword "\n是否將BLOCK對齊物件? [是(Y)/否(N)] <Y>: "))
    (if (null ch) (setq ch "Y"))
)
(princ)