注册 登录
明经CAD社区 返回首页

树櫴希德的个人空间 http://www.mjtd.com/?401940 [收藏] [复制] [分享] [RSS]

留言板

facelist doodle涂鸦板

您需要登录后才可以留言 登录 | 注册


czb203 2019-6-29 08:30
三维网表面积的有更新吗??老大
lizhigang.jin 2017-9-6 21:31
大师:能编一个按展点点号提取图上高程点的程序吗,就是展点时点号和高程一起展出来,提取坐标时按点号提取对应的高程点。顺序可以乱,但点号高程要对应,后期用EXCEL排个序就好了。这样有利于修改高程而不变点号
测绘 2017-3-3 21:14
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=174781&page=1&extra=#pid791715
求帮忙编个程序,断面数据转换
zhangxin0298 2016-10-22 17:49
同行,通过一下好友验证,好吗
请教LSP
zhangxin0298 2016-10-22 17:46
(defun c:ggcd ()
  (princ "\n 选取要修改的高程点:")
  (setq ss (ssget))
  (setq zz (getreal "\n 输入增(+)减(-)高程值:"))
  (setq n 0)
  (repeat (sslength ss)
    (setq ssn (ssname ss n))
    (setq ssdata (entget ssn))
    (setq mms (assoc 2 ssdata))
    (setq mmm (cdr mms))
    (if (= mmm "GC200")
       (progn
         (setq en1 (assoc 10 ssdata))
         (setq old_zz (cdr en1))
         (setq X (car old_zz))
         (setq Y (cadr old_zz))
         (setq Z (caddr old_zz))
         (setq m (+ Z zz))
         (setq new_zz (cons 10 endata))
         (setq ssdata (subst new_zz en1 ssdata))
         (entmod ssdata)
         )
      )
    (setq n (1+ n))         
  )
  (prin1)
)

帮忙看下好吗?
测不准 2016-7-30 15:46
同行加个q    949621238
测不准 2016-7-30 15:46
同行加个q    949621238
暮雨寒阳 2015-9-10 13:07
选取奇数等高线有弊端,有的地方是可以选出来的,有的地方不能判别出来,希望楼主优化
xujinhua 2015-8-21 19:58
我以前在吴献文那里上班,你应该不认识我,我只是认得你,好像二调的时候,胡龚你认识不,那时我跟着他
我的微信  15989144277     我也在学LISP 有机会请教你
yx1985321 2014-5-31 19:49
;这个程序是批量宗地编号程序,是从下至上,从右到左的,我想改成自上至下,从左到右。那位大神请帮改一下啊谢谢
(defun c:zdbh()
  (setq ss (ssget (list '(0 . "LWPOLYLINE"))))
  (setq n 0 k 1)
  (repeat (sslength ss)
    (setq na (ssname ss n))
    (setq po (Get_center_relative na))
    (command "text" "j" "mc" po 2.5 0 k "")
    (setq k (1+ k))
    (setq n (1+ n))
    )
  )
(defun Get_center_relative (ename /  Pts   2R Mk   Mkline  points   DelLine   Tssred
     i   lst  N  Newlst    DistList     R   Number  Tssbak TssSub  Pt)
    (setq Obj     (Vlax-Ename->Vla-Object ename)
   Tssbak  (Vlax-Get Obj 'Thickness )
   TssSub  (Vlax-Put Obj 'Thickness 0 ))
    (setq Pts     (GetBoundingBox ename)
   2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))
   Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))
   Mkline  (entlast)
   points  (vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
   Tssred  (Vlax-Put Obj 'Thickness (eval Tssbak) )
   DelLine (entdel Mkline)
   i       0
   lst     nil
   )
  (repeat (/ (length points) 3)
       (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
       (setq i (+ i 3))
  )
  (setq lst (px lst))
  (if (>= (length lst) 4)
      (progn
   (setq N      0
  Newlst nil)
   (repeat (/ (length lst) 2)
       (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
       (setq N (+ 2 N))
   )
   (setq DistList nil
         R        0)
   (repeat (length Newlst)
     (setq Number (nth R Newlst)
           DistList (append DistList  (list(distance (car Number) (cadr Number)))))
     (setq R (1+ R))
   )
   (setq  Pt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
(MJ:MIDPOINT (car pt) (cadr pt));返回值
      )
      (MJ:MIDPOINT (car lst) (cadr lst));返回值
  )
)
(defun MJ:MIDPOINT (P1 P2)
  (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
(defun GetBoundingBox (ent / ll ur)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
)
(defun px (X)
    (vl-sort  X
             (function (lambda (e1 e2)
                         (< (car e1) (car e2)) ) ) )
)

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2019-12-11 17:02 , Processed in 0.075545 second(s), 12 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

返回顶部