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

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

感觉原系统的图例生成不太好，自己捣腾一晚上，编了一个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)
)

)

西边日出 发表于 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

什么东西，学习学习
页: [1]
查看完整版本: [分享]：《湘源控制性详细规划CAD系统》用地图例生成l