[分享]：《湘源控制性详细规划CAD系统》用地图例生成l

david96007 · 发表于 2005-12-15 12:13:09

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

感觉原系统的图例生成不太好，自己捣腾一晚上，编了一个lsp程序，程序还不完善，但主要功能已经能够实现！
因为是不常用的程序，所以也没打算进一步修改，贴上来，有兴趣的朋友可以参考一下！

附件里是用地性质的一个模版文件，放到cad的支持路径就行了！

(defun c:ydtl ()
(defun drawtl (txt ydmch pt0 /)
(pt pt0)
(setq layname (strcat "YD-" txt))
(entmake (list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
(cons 8 Layname)
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(2 . "SOLID")
'(70 . 1)
'(71 . 0)
'(91 . 1)
'(92 . 3)
'(72 . 0)
'(73 . 1)
'(93 . 4)
(cons 10 pt1)
(cons 10 pt2)
(cons 10 pt3)
(cons 10 pt4)
'(97 . 0)
'(75 . 0)
'(76 . 1)
'(98 . 0)
)
)
(entmake (list '(0 . "TEXT")
'(8 . "YD-CODE")
(cons 10 pt5)
'(40 . 25.0)
(cons 1 txt)
'(50 . 0.0)
'(41 . 0.5)
'(51 . 0.0)
'(7 . "DIMHT")
'(71 . 0)
'(72 . 1)
(cons 11 pt5)
'(73 . 2)
)
)
(entmake (list '(0 . "TEXT")
'(8 . "TX-图例")
(cons 10 pt6)
'(40 . 25.0)
(cons 1 ydmch)
'(50 . 0.0)
'(41 . 0.7)
'(51 . 0.0)
'(7 . "黑体")
'(71 . 0)
'(72 . 0)
'(73 . 0)
)
)
(entmake (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "YD-CODE")
'(100 . "AcDbPolyline")
'(90 . 2)
'(70 . 129)
'(43 . 1.5625)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 pt7)
(cons 40 w)
(cons 41 w)
'(42 . 1.0)
(cons 10 pt8)
(cons 40 w)
(cons 41 w)
'(42 . 1.0)
'(210 0.0 0.0 1.0)
)
)
)
(defun removedups (pts / pl)
(while pts
(setq p (car pts)
pts (cdr pts)
pts (vl-remove-if '(lambda (x) (equal x p 1e-10)) pts)
pl (cons p pl)
)
)
(reverse pl)
)
(defun remdl (pfn k / roop fn a val)
(setq roop T
;;; id (strcase(strcat "[" id "]"))
k
(strcase (strcat k "=*"))
)
(if (setq pfn (findfile pfn))
(progn
(setq fn (open pfn "r"))
(while (and (setq a (read-line fn))
roop
)
(if (wcmatch (strcase a) k)
(setq roop nil
val (substr a (strlen k))
)
)
)
(close fn)
)
)
val
)
(defun pt (pt0 /)
(setq pt1 pt0
pt2 (polar pt1 0 (* sca 150))
pt3 (polar pt2 (* pi 0.5) (* sca 56.4))
pt4 (polar pt1 (* pi 0.5) (* sca 56.4))
pt5 (polar (polar pt1 0 (* sca 75)) (* pi 0.5) (* sca 28.2))
pt6 (polar (polar pt1 0 (* sca 180)) (* pi 0.5) (* sca 13.2))
pt7 (polar pt5 0 (* sca 27.5))
pt8 (polar pt5 pi (* sca 27.5))
)
)
(setq sca 0.75
w (* sca 1.5625) )
(princ "选择用地编号:")
(setq ss (ssget '((0 . "text") (8 . "YD-CODE")))
pt0 (getpoint "点取插入点:")
ss_l (sslength ss)
n 0
txt_l nil
)
(while (< n ss_l)
(setq ent (ssname ss n)
txt (cdr (assoc 1 (entget ent)))
txt_l (cons txt txt_l)
n (1+ n)
)
)
(setq new_txt_l (vl-sort (removedups txt_l) '<)
l (length new_txt_l)
n 0
)
(while (< n l)
(setq txt (nth n new_txt_l)
ydmch (remdl "yd.mdl" txt)
n (1+ n)
)
(drawtl txt ydmch pt0)
(setq pt0 (polar pt0 0 (* sca 450)))
(pt pt0)
)
)

(defun c:ydtl () 
  (defun drawtl        (txt ydmch pt0 /) 
    (pt pt0) 
 
    (setq layname (strcat "YD-" txt)) 
    (entmake (list '(0 . "HATCH") 
                   '(100 . "AcDbEntity") 
                   '(67 . 0) 
                   '(410 . "Model") 
                   (cons 8 Layname) 
                   '(100 . "AcDbHatch") 
                   '(10 0.0 0.0 0.0) 
                   '(210 0.0 0.0 1.0) 
                   '(2 . "SOLID") 
                   '(70 . 1) 
                   '(71 . 0) 
                   '(91 . 1) 
                   '(92 . 3) 
                   '(72 . 0) 
                   '(73 . 1) 
                   '(93 . 4) 
                   (cons 10 pt1) 
                   (cons 10 pt2) 
                   (cons 10 pt3) 
                   (cons 10 pt4) 
                   '(97 . 0) 
                   '(75 . 0) 
                   '(76 . 1) 
                   '(98 . 0) 
             ) 
 
    ) 
    (entmake (list '(0 . "TEXT") 
                   '(8 . "YD-CODE") 
                   (cons 10 pt5) 
                   '(40 . 25.0) 
                   (cons 1 txt) 
                   '(50 . 0.0) 
                   '(41 . 0.5) 
                   '(51 . 0.0) 
                   '(7 . "DIMHT") 
                   '(71 . 0) 
                   '(72 . 1) 
                   (cons 11 pt5) 
                   '(73 . 2) 
             ) 
    ) 
    (entmake (list '(0 . "TEXT") 
                   '(8 . "TX-图例") 
                   (cons 10 pt6) 
                   '(40 . 25.0) 
                   (cons 1 ydmch) 
                   '(50 . 0.0) 
                   '(41 . 0.7) 
                   '(51 . 0.0) 
                   '(7 . "黑体") 
                   '(71 . 0) 
                   '(72 . 0) 
                   '(73 . 0) 
             ) 
    ) 
(entmake (list '(0 . "LWPOLYLINE") 
               '(100 . "AcDbEntity") 
               '(67 . 0) 
               '(410 . "Model") 
               '(8 . "YD-CODE") 
               '(100 . "AcDbPolyline") 
               '(90 . 2) 
               '(70 . 129) 
               '(43 . 1.5625) 
               '(38 . 0.0) 
               '(39 . 0.0) 
               (cons 10 pt7) 
               (cons 40 w) 
               (cons 41 w) 
               '(42 . 1.0) 
               (cons 10 pt8) 
               (cons 40 w) 
               (cons 41 w) 
               '(42 . 1.0) 
               '(210 0.0 0.0 1.0) 
         ) 
) 
 
 
  ) 
 
  (defun removedups (pts / pl) 
    (while pts 
      (setq p        (car pts) 
            pts        (cdr pts) 
            pts        (vl-remove-if '(lambda (x) (equal x p 1e-10)) pts) 
            pl        (cons p pl) 
      ) 
    ) 
    (reverse pl) 
  ) 
  (defun remdl (pfn k / roop fn a val) 
    (setq roop T 
;;;        id   (strcase(strcat "[" id "]")) 
          k 
           (strcase (strcat k "=*")) 
    ) 
    (if        (setq pfn (findfile pfn)) 
      (progn 
        (setq fn (open pfn "r")) 
        (while (and (setq a (read-line fn)) 
                    roop 
               ) 
          (if (wcmatch (strcase a) k) 
            (setq roop nil 
                  val  (substr a (strlen k)) 
            ) 
          ) 
        ) 
        (close fn) 
      ) 
    ) 
    val 
  ) 
  (defun pt (pt0 /) 
    (setq pt1 pt0 
          pt2 (polar pt1 0 (* sca 150)) 
          pt3 (polar pt2 (* pi 0.5) (* sca 56.4)) 
          pt4 (polar pt1 (* pi 0.5) (* sca 56.4)) 
          pt5 (polar (polar pt1 0 (* sca 75)) (* pi 0.5) (* sca 28.2)) 
          pt6 (polar (polar pt1 0 (* sca 180)) (* pi 0.5) (* sca 13.2)) 
          pt7 (polar pt5 0 (* sca 27.5)) 
          pt8 (polar pt5 pi (* sca 27.5)) 
    ) 
  ) 
(setq sca 0.75 
      w  (* sca 1.5625) ) 
  (princ "选择用地编号:") 
  (setq        ss    (ssget '((0 . "text") (8 . "YD-CODE"))) 
        pt0   (getpoint "点取插入点:") 
        ss_l  (sslength ss) 
        n     0 
        txt_l nil 
  ) 
  (while (< n ss_l) 
    (setq ent        (ssname ss n) 
          txt        (cdr (assoc 1 (entget ent))) 
          txt_l        (cons txt txt_l) 
          n        (1+ n) 
    ) 
  ) 
  (setq        new_txt_l (vl-sort (removedups txt_l) '<) 
        l          (length new_txt_l) 
        n          0 
  ) 
  (while (< n l) 
    (setq txt        (nth n new_txt_l) 
          ydmch        (remdl "yd.mdl" txt) 
          n        (1+ n) 
    ) 
    (drawtl txt ydmch pt0) 
    (setq pt0 (polar pt0 0 (* sca 450))) 
    (pt pt0) 
  ) 
 
)

西边日出 · 发表于 2005-12-17 13:25:35

*-*d
怎么没人回帖呢？
我都不敢用这个东西。
是不是真的呀？？？

david96007 · 发表于 2005-12-17 15:04:43

请楼上的放心用好了！

shuaier · 发表于 2005-12-18 09:19:19

不错,简便多了!希望继续有好的程序上传,我会关注此贴的!
我一直在用这个规划软件,很好用!

abcd321 · 发表于 2005-12-23 10:05:11

不会

小昕 · 发表于 2006-1-6 18:00:16

没有用过这个软件，不知道效果如何啊，用过的网友可以推荐一下吗

yangkerjkl · 发表于 2006-1-6 19:29:06

我也一直在用《湘源控制性详细规划CAD系统》，感觉它的用地图例不是很好。多谢楼主的修改。

david96007 · 发表于 2006-1-6 19:50:11

有人能用，真是高兴，一晚上没白忙活！

yangpan2005 · 发表于 2006-1-23 11:27:48

如何使用，难道要反汇编吗？

geminiyanc · 发表于 2006-7-29 07:22:05

我对这种什么程序向来就是白痴的！呵呵

zzkyn · 发表于 2006-8-3 15:28:11

这个软件很不错哟
我一直在用

yuhaifeng926 · 发表于 2006-8-9 15:19:29

不会用啊，怎么用这个啊，加载不了啊

geminiyanc · 发表于 2006-8-17 09:37:08

只是为了个图例就装个代码，感觉没必要啊，怎么回事？

GTJ116600 · 发表于 2013-5-30 05:46:19

呵呵，有机会尝试一下。希望跟楼主学习学习。

tss1390@163.com · 发表于 2015-6-16 17:18:15

什么东西，学习学习

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

[分享]：《湘源控制性详细规划CAD系统》用地图例生成l

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子