主意环问题

scubastu · 发表于 2022-7-6 12:19:58

嗨，博学的朋友们，

到底实现了什么？

这是我的Lisp程序。。它是一种改进的linesum lisp。我的想法是，在绘制了一条不闭合的线路（带有misclose）后，将此回路作为调整应用于每条线路，使其成为单个线路的闭合回路，方法是在拾取misclose点后按顺序选择每条线路。我可能做错了，但如果是的话请告诉我。因此，它通过在每条导线的末端绘制一条错误闭合线来工作。然后通过将长度（从起点到绘制错误闭合线的直线终点）除以所有直线长度的总和来缩放它(

问题

变量totdis，即所有线的总距离，在循环结束之前为null或等于tot，但我需要它在循环内缩放每条线，而无需再次选择（需要最少的手指点击（和思考））。当Lisp在没有称重行李的情况下运行时，变量为“满”时，它起作用。我可以跳起得到所有线路的总和，然后返回到循环吗？

或

我是否可以将所有新的misclose行存储到一个集合中，以返回并按其相关联的行的长度（第一个集合中位于该行之前的行）对其进行缩放。这可能是一种方式，但不确定如何进行。需要存储indx和线路长度，以正确缩放每个线路。。然后是所有变化的基点问题。

我要做的就是将每条导线与新调整线的终点对齐，然后使下一条导线的起点与上一条导线的终点相同。。。从断开的正方形创建新的未断开的重新定位正方形。

copy

(defun c:adjust()
   (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
   (setvar "osnapcoord" 1)
  (setq p1 (getpoint "n\Pick unadjusted end of Traverse")
p2 (getpoint "n\Pick closing point or start of Traverse"))
 (command "line" p1 p2 "")
(setq mis (entlast))
(setq sset (ssget '((0 . "LINE"))))
 (if sset
   (progn
     (setq tot 0.0)
     (setq len (sslength sset) indx 0)
     (while (< indx len)
       (setq lobj (ssname sset indx))
       (setq objd (entget lobj))
       (setq pt1 (cdr (assoc 10 objd)))
       (setq pt2 (cdr (assoc 11 objd)))
       (setq dis (distance pt1 pt2))
       (setq tot (+ tot dis))
(setq indx (1+ indx))
(command "._layer" "_M" "Misclose" "")
(command "._layer" "_C" "2" "Misclose" "")
(setvar "clayer" "Misclose")
(command "._copy" mis "" p1 pt2)
(setq obj (entlast))
(setq disa (distance p1 p2))
(if (= indx len) (setq totdis tot))
(setq dist (* (/ tot totdis) disa))
(command "._scale" obj "" pt2 "r" p1 p2 "p" dist)
)
     )
   )
)

提前谢谢。

斯图

CarlB · 发表于 2022-7-6 12:54:33

我不确定你是否做错了。。。但我想是的。这听起来确实像是在测量中尝试“闭合导线测量”。搜索“导线闭合克兰德尔规则”（最小二乘平差）

一个在http://faculty.matcmadison.edu/gmahun/2006MSPS/pdf/Technical/traverse.pdf

是的，你可以将这些线循环一次，得到总长度。
再次循环以调整每条线
或创建一个包含数据的集合以供检索；使用该集合，而不是再次查询对象。

CAB · 发表于 2022-7-6 13:14:38

示例：

copy

(defun c:adjust (/ ss tot ename i mis len ent elst ent+)
 (vl-load-com)
 (defun LayerMake(lyrname Color ltype)
   (if (tblsearch "LAYER" lyrname)
     (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
     (command "._Layer" "_Make" lyrname "_Color"
            (if (or (null color)(= Color "")) "_White" Color) lyrname
            "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
   )
 )
 
 (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setvar "osnapcoord" 1)
 (LayerMake "Misclose" "2" nil)
 (if (and
       (setq p1 (getpoint "n\Pick unadjusted end of Traverse"))
       (setq p2 (getpoint "n\Pick closing point or start of Traverse"))
     )
   (progn
     (command "line" "_non" p1 "_non" p2 "")
     (setq mis (entlast))
   )
 )
 (if (and mis (setq ss (ssget '((0 . "LINE")))))
   (progn
     ;;  collect the ename & length in a list while getting total lenght
     (setq tot 0.0)
     (setq i -1)
     (while (setq ename (ssname ss (setq i (1+ i))))
       (setq len (vla-get-length (vlax-ename->vla-object ename)))
       (setq lst (cons (list ename len) lst))
       (setq tot (+ len tot))
     )
     ;;  don't know what you are trying to do here??????
     (foreach ent+ (reverse lst)
       (setq elst (car ent+))
       (setq dis (cadr ent+))
       (setq pt1 (cdr (assoc 10 elst)))
       (setq pt2 (cdr (assoc 11 elst)))
       (command "._copy" mis "" p1 pt2)
       (setq obj (entlast))
       (setq disa (distance p1 p2))
       (setq dist (* (/ tot totdis) disa))
       (command "._scale" obj "" pt2 "r" p1 p2 "p" dist)
     )
   )
 )
 (princ)
)

scubastu · 发表于 2022-7-6 13:28:53

谢谢大家，你们的回复给了我一些想法。我越来越接近我的非工作相关工作计划：wink：。。

是的，卡尔。。使用Bowditch或“指南针规则”有趣地执行测量调整程序。

在新手受挫后，我最终通过使用两个循环结构使程序工作。。由于从第二条线开始，这些点就很容易混淆，因为它们改变了起点和终点坐标，因此只需绘制一条代表调整的新线，然后替换现有线的起点和终点坐标就更容易了。现在将尝试包括辐射和块，以适应它。。。英雄联盟

cab没有让你参与到项目中，但那可能是因为我不知道我在做什么：？

以下是我所做的。。感谢反馈。。e、 g.如果用户按顺序操作，我没有错误检查，或者程序可以正常工作（我认为）。

copy

(defun c:adjust (/ mis sset tot num itm totdis
  hnd ent dis indx lobj disa dist)
   (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
   (setvar "osnapcoord" 1)
  (command "._layer" "_M" "Misclose" "")
(command "._layer" "_C" "2" "Misclose" "")
(setvar "clayer" "Misclose")
     (setq p1 (getpoint "n\Pick unadjusted end of Traverse")
p2 (getpoint "n\Pick closing point"))
 (command "line" p1 p2 "")
(setq mis (entlast))
(setq sset (ssget '((0 . "LINE"))))
 (if sset
   (progn
     (setq tot 0.0)
     (setq num (sslength sset) itm 0)
     (repeat num
     (while (< itm num)
       (setq hnd (ssname sset itm))
       (setq ent (entget hnd))
       (setq pt1 (cdr (assoc 10 ent)))
       (setq pt2 (cdr (assoc 11 ent)))
       (setq dis (distance pt1 pt2))
       (setq tot (+ tot dis))
       (setq itm (1+ itm))
     )
     )))
     (if (= itm num) (setq totdis tot))
     (if totdis
(progn
     (setq tot 0.0)
     (setq len (sslength sset) indx 0)
     (while (< indx len)
       (setq lobj (ssname sset indx))
       (setq objd (entget lobj))
       (setq pt1 (cdr (assoc 10 objd)))
       (setq pt2 (cdr (assoc 11 objd)))
(if (> indx 0) (setq pl1 pl2))
(setq dis (distance pt1 pt2))
       (setq tot (+ tot dis))
(command "._copy" mis "" p1 pt2)
(setq obj (entlast))
(setq disa (distance p1 p2))
(setq dist (* (/ tot totdis) disa))
(command "._scale" obj "" pt2 "r" p1 p2 "p" dist)
(command "._layer" "_M" "Traverse Adjusted" "")
(command "._layer" "_C" "1" "Traverse Adjusted" "")
(setvar "clayer" "Traverse Adjusted")
(setq pl2 (cdr (assoc 11 (entget obj))))
(if (= indx 0) (command "._line" pt1 pl2 ""))
(if (> indx 0) (command "._line" pl1 pl2 ""))
(setq indx (1+ indx))
)
     )
   )
 )

[编程交流] 主意环问题

发表回复

精选推荐