乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 72|回复： 0

[编程交流] 三维圆拟合LISP不再是w

[复制链接]
jeremyw

2

主题

3

帖子

1

银币

初来乍到

Rank: 1

铜币
11
发表于 2022-7-29 17:30:09 | 显示全部楼层 |阅读模式
大家好，我们目前在C3D2016中使用3D Circle Fit LISP来报告测量的法兰面，但注意到，由于我们将模板单元设置修改为从北顺时针读取，Circle Fit例程不再按预期工作，而是以正确的大小绘制圆，但角度似乎是随机的。
 
我不确定这个文件是从哪里来的，因为它没有包含在代码中，再也无法在网上找到，并且比为我们工作的任何CAD人员都要过时。这个文件很可能是内部开发的，因为我们还有其他较旧的程序是内部编写的
 
如果有人能看一看，看看他们是否能看到是什么导致了它；或者甚至为我们指出一个不同的圆拟合LISP，这将不胜感激。我看不出是什么原因造成的，因为我不知道角度单位设置和UCS之间的联系，而且这个程序似乎只是在不同的UCS处绘制多个圆来拟合每个3点圆，然后平均这些圆以获得最佳拟合圆。
 
  1. (defun rtd (r) 
  2.   (/ (* r 180.0) pi))
  3. (defun dtr (d)
  4.   (/ (* d pi) 180.0))
  6. (defun c:3dcf (/ OSM) 
  7.   (setvar "cmdecho" 0)
  8.   (setq OSM (getvar "osmode"))
  9.   (setvar "osmode" 8)
  10.   (command "ucs" "w") 
  11.   (setq all_pn nil)
  12.     (while (setq cir_pn(getpoint "\nGet circle points (Enter when finished): "))
  13.          (setq all_pn(append all_pn(list cir_pn)))
  14.     )
  15.   (setvar "osmode" 0)
  16.   (command "ucsicon" "off") 
  17.   (setq loop_pn all_pn)
  18.   (setq radii nil)
  19.   (setq verts nil)
  20.   (setq wcents nil)
  21.   (setq len_all (length all_pn))
  22.   (repeat len_all  ; Draw circles from each set of 3 points in list
  23.      (setq w1_p (car loop_pn))
  24.      (setq w2_p (cadr loop_pn))
  25.      (setq w3_p (caddr loop_pn))
  26.      (setq w3_pall (cddr loop_pn))
  27.      (command "ucs" "3P" w1_p w2_p w3_p)                            
  28.      (setq u1_p (trans w1_p 0 1)) ; Convert each to local ucs.
  29.      (setq u2_p (trans w2_p 0 1))
  30.      (setq u3_p (trans w3_p 0 1))
  31.      (command "circle" "3p" u1_p u2_p u3_p)
  32.      (setq circ_1 (entlast))
  33.      (command "ucs" "w")
  34.      (command "ucs" "za" w1_p w2_p)
  35.      (setq l1_p (trans w1_p 0 1))
  36.      (setq l2_p (trans w2_p 0 1))
  37.      (setq l3_p (trans w3_p 0 1))
  38.      (command "ucs" "z" l1_p l3_p)
  39.      (setq uc1_p (trans w1_p 0 1))
  40.      (setq uc2_p (trans w2_p 0 1))
  41.      (setq u3_pall nil)
  42.      (foreach wp_n w3_pall
  43.        (setq ucs_t (trans wp_n 0 1))
  44.        (setq u3_pall (append u3_pall (list ucs_t)))
  45.      )
  46.      (setq u3_angs nil)
  47.      (foreach a3 u3_pall
  48.        (setq ucs_a3 (rtd (angle uc1_p a3)))
  49.        (cond
  50.           ((>= ucs_a3 270)(setq ucs_a3 (- ucs_a3 360))) 
  51.           ((and (>= ucs_a3 90)(< ucs_a3 270))(setq ucs_a3 (- ucs_a3 180)))
  52.        )
  53.        (setq u3_angs (append u3_angs (list ucs_a3)))
  54.      )
  55.      (setq u3_len  (length u3_angs))
  56.      (setq u3_mean (/ (apply '+ u3_angs) u3_len))
  57.      (command "rotate" circ_1 "" uc1_p u3_mean) 
  58.        (setq st_circ (entget circ_1))
  59.        (setq v1 (cdr(assoc 210 st_circ)))        
  60.        (setq v_pl1 v1) 
  61.        (setq verts (append verts(list v_pl1)))   
  62.        (setq c1 (cdr(assoc 10 st_circ)))          
  63.        (setq c1w (trans c1 v1 0))                   
  64.        (setq wcents (append wcents(list c1w)))     
  65.        (setq r1 (cdr(assoc 40 st_circ)))        
  66.        (setq radii (append radii(list r1)))
  67.       (command "erase" "last" "")
  68.       (command "ucs" "world")
  69.      (setq 1st_loop (car loop_pn))
  70.      (setq rest_loop (cdr loop_pn))     
  71.      (setq loop_pn (append rest_loop (list 1st_loop)))
  72.   )
  73.    (setq divi (list len_all len_all len_all))
  74.    (setq new_rad (/ (apply'+ radii) len_all))
  75.   (setq v1_b (car verts))
  76.   (setq verts_1 verts)
  77.   (setq cvt_2 (list 0 0 0)) 
  78.   (setq mis_1 (list -1 -1 -1))
  79.   (repeat len_all
  80.     (setq v1_n (car verts_1))
  81.     (setq v1_d (mapcar'- v1_n v1_b))
  82.     (setq v1_d1 (car v1_d))
  83.     (setq v1_d2 (cadr v1_d))
  84.     (setq v1_d3 (caddr v1_d))
  85.      (cond
  86.        ((> v1_d1 1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  87.        ((< v1_d1 -1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  88.        ((> v1_d2 1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  89.        ((< v1_d2 -1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  90.        ((> v1_d3 1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  91.        ((< v1_d3 -1.0)(setq v1_n(mapcar'* v1_n mis_1)))
  92.      )
  93.     (setq cvt_2 (mapcar'+ v1_n cvt_2))
  94.     (setq verts_1 (cdr verts_1))
  95.   )
  96.   (setq new_ver (mapcar'/ cvt_2 divi))
  97.   (setq wcents_1 wcents)
  98.   (setq wct_2 (list 0 0 0)) 
  99.   (repeat len_all
  100.     (setq wct_1 (car wcents_1))
  101.     (setq wct_2 (mapcar'+ wct_1 wct_2))
  102.     (setq wcents_1 (cdr wcents_1))
  103.   )
  104.   (setq new_cenw (mapcar'/ wct_2 divi))
  105.   (command "vpoint" new_ver)
  106.   (command "ucs" "view")
  107.   (command "zoom" "previous")
  108.   (setq new_cenuc(trans new_cenw 0 1))
  109.   (command "circle" new_cenuc new_rad)
  110.   (command "ucs" "world")
  111.    (setq circ_2 (entlast))
  112.    (setq lcirc_2 (entget circ_2))
  113.    (command "ucs" "object" "last")
  114.    (setq all_errs nil)
  115.      (foreach wp_er all_pn
  116.        (setq ucs_er (trans wp_er 0 1))
  117.        (setq all_errs (append all_errs (list ucs_er)))
  118.      ) 
  119.      (foreach zer all_errs
  120.      (princ (cddr zer))
  121.      ) 
  122.      (setq err_cen (list 0 0 0))
  123.        (foreach den all_errs
  124.          (princ (fix (- (distance err_cen den) new_rad)))
  125.        ) 
  127.    (command "ucs" "w")
  128.    (command "ucsicon" "on")
  129.    (setvar "cmdecho" 1)
  130.    (setvar "osmode" OSM)
  131.    (princ "3dcf" )
  132. )
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-4 01:52 , Processed in 0.423426 second(s), 54 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表