怎么对线状地形图进行按线路走向分幅

zxa_2005 · 发表于 2015-3-31 21:29:19

楼上的这个分幅，是怎么实现的？？
vb，还是vc还是？？

czb203 · 发表于 2015-4-2 21:48:49

Atsai 发表于 2015-3-13 09:06
楼主要的是这种吧！

神奇的插件啊

Atsai · 发表于 2015-4-3 17:20:28

本帖最后由 Atsai 于 2015-4-30 22:47 编辑

代码的主要构思是从下面的三个部分组成的，里面的副程式请自己到黄大侠、高飞版主的个别帖子找！
偶而花花时间去翻帖子也是不错的。

最小包围核代码是自贡黄明儒:http://bbs.mjtd.com/thread-107647-1-1.html
及 highflybir:http://bbs.mjtd.com/thread-99926-1-1.html
视埠旋转的想法是自贡黄明儒:http://bbs.mjtd.com/thread-111691-1-1.html

下面是其他拼拼凑凑的代码如果不合用就自己再改改吧！

;;最小包围核代码是自贡黄明儒:http://bbs.mjtd.com/thread-107647-1-1.html]http://bbs.mjtd.com/thread-107647-1-1.html
;; 及 highflybir:http://bbs.mjtd.com/thread-99926-1-1.html]http://bbs.mjtd.com/thread-99926-1-1.html
;;视埠旋转的想法是自贡黄明儒:http://bbs.mjtd.com/thread-111691-1-1.html]http://bbs.mjtd.com/thread-111691-1-1.html
(princ
"\n===================================================="
)
(princ "\n命令：rv")
(princ "\n说明：批次依“模型”内图框于“配置”产生视埠")
(princ "\n说明：可适用于有旋转角的图框")
(princ "\nby Atsai 2015.03.12")
(princ
"\n===================================================="
)
(defun c:rv (/ cp cl cs vpl os vplyes l0 svpc ptlst ssvp)
(vl-load-com)
(setvar "cmdecho" 0) ; Turn off command line echoing
(setq cp (getvar "ctab")) ; Store current tab name
(setq cl (getvar "clayer")) ; Store current layer name
(setq cs (getvar "osmode")) ; Store current osnap mode
(setq vpl "视埠") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <<==
(setq os (getvar "osmode")) ;读取锁点原设定
(setvar "osmode" 0)
(setq nselect
(getstring
"\n选择排序方式,(1)自选顺序(2)左->右(3)右->左(4)上->下(5)下->上：预设(1)"
)
)
(if (= nselect "")
(setq nselect "1")
)
(if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab
(progn
(setq vplyes 0) ; Assume viewport doesn't exist
(setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list
(while (setq layers (tblnext "LAYER"))
;; Loop through layer list collection
(setq ln (cdr (assoc 2 layers))) ; Extract layer name from list
(if (= (strcase ln) (strcase vpl))
(setq vplyes 1)
) ; Check if viewport layer exists
)
(if (= vplyes 0)
(command "layer" "NEW" vpl "COLOR" "RED" vpl "")
) ; Make viewport layer and assign color to magenta if doesn't exist
(setvar "clayer" vpl) ; Change to viewport layer
(command "layer"
"ON"
(strcat "0," vpl)
"UNLOCK"
(strcat "0," vpl)
""
) ; Turn on and unlock viewport and 0 layer
(command "zoom" "ALL") ; View entire layout tab
(setvar "ctab" "Model") ; Activate Model tab
(command "zoom" "E") ; View entire Model Space area
(setq ss nil)
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq l (sslength ss)
i 0
)
(setq ent_lst nil)
(repeat (sslength ss)
(setq ent_lst (append ent_lst (list (ssname ss i)))
i (1+ i)
)
)
(princ "\n") ; Clean up command line
(setvar "ctab" cp) ; Return to layout tab program was started from
(command "pspace") ; Switch to Paper Space of layout tab
(setq ptlst nil)
(setq ptlst (HH:Ent4pt (nth 0 ent_lst) T))
(setq vpc1 (nth 0 ptlst))
(setq vpc2 (nth 1 ptlst))
(setq vpc3 (nth 2 ptlst))
(setq vpc4 (nth 3 ptlst))
(setq sf 1.0)
(setq vpyd (* sf (distance vpc2 vpc3)))
(defun viewpnts (/ a b c d x)
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (setq x (getvar "viewctr"))
x (trans x 1 2)
c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
c (trans c 2 1)
d (trans d 2 1)
)
(list c d)
)
(setq c (nth 0 (viewpnts)))
(setq d (nth 1 (viewpnts)))
(setq mvpc (list (/ (+ (car c) (car d)) 2.0) (/ (+ (cadr c) (cadr d)) 2.0) 0.0))
(command "zoom" "C" mvpc (rtos (* (* 2 l) vpyd)))
(setq svpc
(getpoint
"\n选择插入点："
)
) ; Can't change layout tabs manually here
(cond
((= nselect "1")
(setq ent_lst ent_lst)
)
((= nselect "2")
(progn
;;按X座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(< (cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;;按X座标排序
)
)
((= nselect "3")
(progn
;;按X座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(> (cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;;按X座标排序
)
)
((= nselect "4")
(progn
;;按Y座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
;;按Y座标排序
)
)
((= nselect "5")
(progn
;;按Y座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(< (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
;;按Y座标排序
)
)
)
(mapcar
'(lambda (ssn)
(setq ptlst nil)
(setq ptlst (HH:Ent4pt ssn T))
(setq vpc1 (nth 0 ptlst))
(setq vpc2 (nth 1 ptlst))
(setq vpc3 (nth 2 ptlst))
(setq vpc4 (nth 3 ptlst))
(setq sf 1.0)
(setq vpxd (* sf (distance vpc1 vpc2)))
;; Determine horizontal length of selected window
(setq vpyd (* sf (distance vpc2 vpc3)))
;; Determine vertical height of selected window
(setq
vpc
(list (/ (+ (car vpc1) (car vpc3)) 2.0)
(/ (+ (cadr vpc1) (cadr vpc3)) 2.0)
0.0
)
)
;; Determine center point of selected model window
(command "mview"
(list (car svpc) (cadr svpc))
(strcat "@" (rtos vpxd) "," (rtos vpyd))
)
;; Create Paper Space viewport
(setq ssvp nil)
(setq ssvp (ssget "L"))
;; Start selection set with last viewport frame
(command "zoom"
"w"
(list (car svpc) (cadr svpc))
(strcat "@" (rtos vpxd) "," (rtos vpyd))
)
(command "mspace")
;; Open viewport window to Model Space
(command "ucsicon" "ON")
;; Turn on UCS icon for viewport
(command "ucs" "Z" "non" vpc1 "non" vpc2)
(command "Plan" "")
(command "ucs" "WORLD") ; Reset UCS to WCS
(command "zoom" "C" vpc (rtos vpyd))
;; Center view of viewport window using determined point
(command "zoom" "SCALE" (strcat (rtos sf) "XP"))
;; Set zoom scale of viewport window
(command "vports" "LOCK" "ON" ssvp "")
;; Lock scale and position of model in viewport
(command "pspace")
;; Close viewport window
(setq w (distance vpc1 vpc2))
(setq svpc (polar svpc 0 (* 1.5 w)))
)
ent_lst
)
)
)
)
(princ "\n这个LISP程式只能在Layout使用！")
;; Need to start on a layout tab so program knows where to create the new viewports
)
(command "zoom" "all")
(setvar "ctab" cp) ; Reset to stored tab name
(setvar "clayer" cl) ; Reset to stored layer name
(setvar "osmode" os) ;回复锁点原设定
(princ)
)

;;最小包围核代码是 自贡黄明儒:http://bbs.mjtd.com/thread-107647-1-1.html]http://bbs.mjtd.com/thread-107647-1-1.html 
;;                            及 highflybir:http://bbs.mjtd.com/thread-99926-1-1.html]http://bbs.mjtd.com/thread-99926-1-1.html 
;;视埠旋转的想法是 自贡黄明儒:http://bbs.mjtd.com/thread-111691-1-1.html]http://bbs.mjtd.com/thread-111691-1-1.html 
 
(princ 
  "\n====================================================" 
) 
(princ "\n命令：rv") 
(princ "\n说明：批次依“模型”内图框于“配置”产生视埠") 
(princ "\n说明：可适用于有旋转角的图框") 
(princ "\nby Atsai 2015.03.12") 
(princ 
  "\n====================================================" 
) 
 
(defun c:rv (/ cp cl cs vpl os vplyes l0 svpc ptlst ssvp) 
  (vl-load-com) 
  (setvar "cmdecho" 0) ; Turn off command line echoing 
  (setq cp (getvar "ctab")) ; Store current tab name 
  (setq cl (getvar "clayer")) ; Store current layer name 
  (setq cs (getvar "osmode")) ; Store current osnap mode 
  (setq vpl "视埠") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <<== 
  (setq os (getvar "osmode")) ;读取锁点原设定 
  (setvar "osmode" 0) 
 
  (setq        nselect 
         (getstring 
           "\n选择排序方式,(1)自选顺序(2)左->右(3)右->左(4)上->下(5)下->上：预设(1)" 
         ) 
  ) 
 
  (if (= nselect "") 
    (setq nselect "1") 
  ) 
 
  (if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab 
    (progn 
      (setq vplyes 0) ; Assume viewport doesn't exist 
      (setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list 
      (while (setq layers (tblnext "LAYER")) 
        ;; Loop through layer list collection 
        (setq ln (cdr (assoc 2 layers))) ; Extract layer name from list 
        (if (= (strcase ln) (strcase vpl)) 
          (setq vplyes 1) 
        ) ; Check if viewport layer exists 
      ) 
      (if (= vplyes 0) 
        (command "layer" "NEW" vpl "COLOR" "RED" vpl "") 
      ) ; Make viewport layer and assign color to magenta if doesn't exist 
      (setvar "clayer" vpl) ; Change to viewport layer 
      (command "layer" 
               "ON" 
               (strcat "0," vpl) 
               "UNLOCK" 
               (strcat "0," vpl) 
               "" 
      ) ; Turn on and unlock viewport and 0 layer 
      (command "zoom" "ALL") ; View entire layout tab 
      (setvar "ctab" "Model") ; Activate Model tab 
      (command "zoom" "E") ; View entire Model Space area 
      (setq ss nil) 
      (if (setq ss (ssget '((0 . "INSERT")))) 
        (progn 
          (setq        l (sslength ss) 
                i 0 
          ) 
 
          (setq ent_lst nil) 
          (repeat (sslength ss) 
            (setq ent_lst (append ent_lst (list (ssname ss i))) 
                  i          (1+ i) 
            ) 
          ) 
 
          (princ "\n") ; Clean up command line 
          (setvar "ctab" cp) ; Return to layout tab program was started from 
          (command "pspace") ; Switch to Paper Space of layout tab 
 
          (setq ptlst nil) 
          (setq ptlst (HH:Ent4pt (nth 0 ent_lst) T)) 
          (setq vpc1 (nth 0 ptlst)) 
          (setq vpc2 (nth 1 ptlst)) 
          (setq vpc3 (nth 2 ptlst)) 
          (setq vpc4 (nth 3 ptlst)) 
          (setq sf 1.0) 
          (setq vpyd (* sf (distance vpc2 vpc3))) 
 
 
          (defun viewpnts (/ a b c d x) 
            (setq b (getvar "viewsize") 
                  c (car (getvar "screensize")) 
                  d (cadr (getvar "screensize")) 
                  a (* b (/ c d)) 
                  x (setq x (getvar "viewctr")) 
                  x (trans x 1 2) 
                  c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) 
                  d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) 
                  c (trans c 2 1) 
                  d (trans d 2 1) 
            ) 
            (list c d) 
          ) 
 
          (setq c (nth 0 (viewpnts))) 
          (setq d (nth 1 (viewpnts))) 
 
          (setq mvpc (list (/ (+ (car c) (car d)) 2.0) (/ (+ (cadr c) (cadr d)) 2.0) 0.0)) 
          (command "zoom" "C" mvpc (rtos (* (* 2 l) vpyd))) 
 
 
          (setq        svpc 
                 (getpoint 
                   "\n选择插入点：" 
                 ) 
          ) ; Can't change layout tabs manually here 
 
 
          (cond 
            ((= nselect "1") 
             (setq ent_lst ent_lst) 
            ) 
 
            ((= nselect "2") 
             (progn 
               ;;按X座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (<        (cadr (assoc 10 (entget e1))) 
                                        (cadr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按X座标排序 
             ) 
            ) 
 
            ((= nselect "3") 
             (progn 
               ;;按X座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (>        (cadr (assoc 10 (entget e1))) 
                                        (cadr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按X座标排序 
             ) 
            ) 
 
            ((= nselect "4") 
             (progn 
               ;;按Y座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (>        (caddr (assoc 10 (entget e1))) 
                                        (caddr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按Y座标排序 
             ) 
            ) 
 
            ((= nselect "5") 
             (progn 
               ;;按Y座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (<        (caddr (assoc 10 (entget e1))) 
                                        (caddr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按Y座标排序 
             ) 
            ) 
          ) 
 
          (mapcar 
            '(lambda (ssn) 
               (setq ptlst nil) 
               (setq ptlst (HH:Ent4pt ssn T)) 
               (setq vpc1 (nth 0 ptlst)) 
               (setq vpc2 (nth 1 ptlst)) 
               (setq vpc3 (nth 2 ptlst)) 
               (setq vpc4 (nth 3 ptlst)) 
 
               (setq sf 1.0) 
               (setq vpxd (* sf (distance vpc1 vpc2))) 
               ;; Determine horizontal length of selected window 
               (setq vpyd (* sf (distance vpc2 vpc3))) 
               ;; Determine vertical height of selected window 
               (setq 
                 vpc 
                  (list        (/ (+ (car vpc1) (car vpc3)) 2.0) 
                        (/ (+ (cadr vpc1) (cadr vpc3)) 2.0) 
                        0.0 
                  ) 
               ) 
               ;; Determine center point of selected model window 
 
               (command        "mview" 
                        (list (car svpc) (cadr svpc)) 
                        (strcat "@" (rtos vpxd) "," (rtos vpyd)) 
               ) 
               ;; Create Paper Space viewport 
 
               (setq ssvp nil) 
 
               (setq ssvp (ssget "L")) 
               ;; Start selection set with last viewport frame 
 
 
               (command        "zoom" 
                        "w" 
                        (list (car svpc) (cadr svpc)) 
                        (strcat "@" (rtos vpxd) "," (rtos vpyd)) 
               ) 
 
                
               (command "mspace") 
               ;; Open viewport window to Model Space 
 
               (command "ucsicon" "ON") 
               ;; Turn on UCS icon for viewport 
 
               (command "ucs" "Z" "non" vpc1 "non" vpc2) 
 
               (command "Plan" "") 
 
               (command "ucs" "WORLD") ; Reset UCS to WCS 
 
               (command "zoom" "C" vpc (rtos vpyd)) 
               ;; Center view of viewport window using determined point 
               (command "zoom" "SCALE" (strcat (rtos sf) "XP")) 
               ;; Set zoom scale of viewport window 
 
               (command "vports" "LOCK" "ON" ssvp "") 
               ;; Lock scale and position of model in viewport 
               (command "pspace") 
               ;; Close viewport window 
 
               (setq w (distance vpc1 vpc2)) 
               (setq svpc (polar svpc 0 (* 1.5 w))) 
 
             ) 
            ent_lst 
          ) 
        ) 
      ) 
    ) 
    (princ "\n这个LISP程式只能在Layout使用！") 
    ;; Need to start on a layout tab so program knows where to create the new viewports 
  ) 
  (command "zoom" "all") 
  (setvar "ctab" cp) ; Reset to stored tab name 
  (setvar "clayer" cl) ; Reset to stored layer name 
  (setvar "osmode" os) ;回复锁点原设定 
  (princ) 
)

qianzy · 发表于 2015-5-1 12:58:08

非常实用的代码下载一下看看

qianzy · 发表于 2015-5-1 13:52:01

Atsai 发表于 2015-4-3 17:20
代码的主要构思是从下面的三个部分组成的，里面的副程式请自己到黄大侠、高飞版主的个别帖子找！
偶而花花 ...

问一下楼主，模型层内的点选图框是什么属性的对象？是有特殊的层还是颜色属性？

Atsai · 发表于 2015-5-1 16:08:10

本帖最后由 Atsai 于 2021-3-23 19:51 编辑

qianzy 发表于 2015-5-1 13:52
问一下楼主，模型层内的点选图框是什么属性的对象？是有特殊的层还是颜色属性？

没有特殊的要求，当初只是把范围做成图块而已，方便一次性的缩放比例。

qianzy · 发表于 2015-5-2 17:58:42

Atsai 发表于 2015-5-1 16:08
没有特殊的要求，当初只是把范围做成图块而已，方便一次性的缩放比例，
没有什么特别需求，如果把一开始 ...

明白了提供的程序是否需要自己下载子程序？

Atsai · 发表于 2015-5-2 19:30:25

裏面用到的子程式要到帖子裏面的連結裏找！

hao3ren · 发表于 2015-5-6 01:37:52

这个做线路有用

wzg356 · 发表于 2015-5-6 02:26:39

路过看看，

账号		自动登录	找回密码
密码			注册

怎么对线状地形图进行按线路走向分幅

评分