[转帖]关于指北针zbz.lsp，求高手修改一下！

lonshinyoo

在网上看到了别人的转帖，收藏备用了，在此想请高手再修改一下，现在生成的指北针的比例好像是一般总图的比例，能否增加选比例的选项，同时生成的指北针是一个块。

原lisp如下：

(defun c:zbz (/    mdpt xdpt yxdpt    zxdpt pt1 pt2 pt3 pt4 pt5 pt6 ss1 ss2
     ss3)
(setvar "cmdecho" 0)
(print "欢迎使用biaoge124的指北针制定 \\n 命令:zbz")
(setq mdpt (getpoint "\\n 请确定插入点:"))
(setq jdzbz (getreal "\\n请确定北方向(竖直向上为0度，分+ -):"))
(setq sizeview (getvar "viewsize"))
(setq ctrview (getvar "viewctr"))
(command "zoom" "c" mdpt 52.6)
(if (not (tblsearch "layer" "指北针"))
(command "_layer" "m" "指北针" "c" "4" "" "")
)
(setq ddpt (polar mdpt 1.5708 24.5))
(setq xdpt (polar mdpt 4.71239 11.5))
(setq yxdpt (polar xdpt 5.27099 18.868))
(setq zxdpt (polar xdpt 4.15379 18.868))
(setq pt1 (polar mdpt 4.36362 12.5))
(setq pt2 (polar mdpt 4.36362 15))
(setq pt5 (polar mdpt 1.63536 12.5))
(setq pt6 (polar mdpt 1.63536 15))
(setq pt3 (polar yxdpt 1.91957 7))
(setq pt4 (polar mdpt 0 2))
(command "_circle" mdpt 12.5)
(command "_circle" mdpt 15)
(command "_line" ddpt xdpt "")
(command "_line" xdpt yxdpt "")
(command "_line" xdpt zxdpt "")
(setq ss1 (entlast))
(command "_line" ddpt zxdpt "")
(setq ss2 (entlast))
(command "_line" ddpt yxdpt "")
(setq ss3 (entlast))
(command "_trim" ss1 ss2 "" pt1 pt2 "")
(command "_trim" ss2 ss3 "" pt5 pt6 "")
(command "_bhatch" "p" "solid" pt3 pt4 "")
(command "zoom" "c" ctrview sizeview)
(setq sszbz (ssget "x" \'((8 . "指北针"))))
(command "_rotate" sszbz "" mdpt jdzbz "")
(setvar "cmdecho" 0)
)

xiaotao

(defun c:zbz (/ mdpt xdpt yxdpt zxdpt pt1 pt2 pt3 pt4 pt5 pt6 ss1 ss2 ss3)
  (setvar "cmdecho" 0)
  (print "欢迎使用biaoge124的指北针制定 \\n 命令:zbz")
  (setq mdpt (getpoint "\\n 请确定插入点:"))
  (if (null
        (setq jdzbz (getreal "\\n请确定北方向(竖直向上为0度，分+ -)<0>:"))
        )
    (setq jdzbz 0)
    )
  (setq sizeview (getvar "viewsize"))
  (setq ctrview (getvar "viewctr"))
  (command "zoom" "c" mdpt 52.6)
  (if (not (tblsearch "layer" "指北针"))
    (command "_layer" "m" "指北针" "c" "4" "" "")
    )
  (setq ddpt (polar mdpt 1.5708 24.5))
  (setq xdpt (polar mdpt 4.71239 11.5))
  (setq yxdpt (polar xdpt 5.27099 18.868))
  (setq zxdpt (polar xdpt 4.15379 18.868))
  (setq pt1 (polar mdpt 4.36362 12.5))
  (setq pt2 (polar mdpt 4.36362 15))
  (setq pt5 (polar mdpt 1.63536 12.5))
  (setq pt6 (polar mdpt 1.63536 15))
  (setq pt3 (polar yxdpt 1.91957 7))
  (setq pt4 (polar mdpt 0 2))
  (setq ss (ssadd))
  (command "_circle" mdpt 12.5)
  (command "_circle" mdpt 15)
  (command "_line" ddpt xdpt "")
  (command "_line" xdpt yxdpt "")
  (command "_line" xdpt zxdpt "")
  (setq ss1 (entlast))
  (command "_line" ddpt zxdpt "")
  (setq ss2 (entlast))
  (command "_line" ddpt yxdpt "")
  (setq ss3 (entlast))
  (command "_trim" ss1 ss2 "" pt1 pt2 "")
  (command "_trim" ss2 ss3 "" pt5 pt6 "")
  (command "_bhatch" "p" "solid" pt3 pt4 "")
  (command "zoom" "c" ctrview sizeview)
  (MAKE-UNNAMEBLOCK (ssget "x" '((8 . "指北针"))) mdpt)
  (command "_rotate" (entlast) "" mdpt jdzbz "")
  (command "SCALE" (entlast) "" mdpt)
  (setvar "cmdecho" 0)
  )

 ;建无名块
(defun MAKE-UNNAMEBLOCK (ss pt / i num)
  (if (/= (getvar "HANDLES") 1)
    (command "HANDLES" "ON")
    ) ;_ 结束if
  (entmake (list '(0 . "BLOCK")
                 '(2 . "*U")
                 '(70 . 1)
                 (cons 10 PT)
                 ) ;_ 结束list
           ) ;_ 结束entmake
  (setq i -1)
  (repeat (sslength ss)
    (entmake (cdr (entget (ssname ss (setq i (1+ i))))))
    ) ; repeat     
  (setq num (entmake '((0 . "ENDBLK"))))
  (entmake
    (list '(0 . "INSERT")
          (cons 2 num)
          (cons 10 pt)
          ) ;_ 结束list
    ) ;_ 结束entmake
  (command "erase" ss "")
  (entlast)
  )

xiaotao

夜深了，没时间给你再完善了

lonshinyoo

xiaotao发表于2010-11-27 23:10:00夜深了，没时间给你再完善了

呵呵，谢谢！有空再完善下啊！

lonshinyoo

xiaotao发表于2010-11-27 23:10:00夜深了，没时间给你再完善了

 

谢谢xiaotao，已经达到索要的目的了！

xyp1964

直接插入指北针的图块应该更简便些

461045462

收藏学习了
谢谢xiaotao
谢谢楼主