سبع الليل 发表于 2022-7-5 23:58:06

ssget随机排列

嗨,伙计们
当我使用ssget函数时,autocad会随机选择实体、、、或我不知道选择实体的概念是什么>
如果我想让它根据特定的安排来选择它,我该怎么办。。。例如,沿x或y方向上升
 
 
我制作了这个lisp来计算多段线面积,,,,
 
(defun c:ar ()
(setq AnItem (getvar "OSMODE"))
(AList "OLDSNAP" AnItem)
(setq AnItem (getvar "HIGHLIGHT"))
(AList "OLDHIGH" AnItem)
(setq AnItem (getvar "CMDECHO"))
(AList "OLDECHO" AnItem)

(setq eset (ssget))
(setq cntr 0)
(setq tap (getpoint "Insertion point"))
(setq pt1 (mapcar '+ tap (list 0.5 -0.45)))
(setq pt2 (mapcar '+ pt1 (list 1 0)))
(setq pt4 (mapcar '+ pt2 (list 1 0)))
(setq pt5 (mapcar '+ pt4 (list 1 0)))
(setq h (getreal "\nHeight"))




(while (< cntr (sslength eset))
(setq en (ssname eset cntr))
   (setq enlist (entget en ))
   (setq myVertexList (list))

   (foreach a enlist                                          
   (if(= 10 (car a))                                          
      (setq myVertexList                              
         (append myVertexList                     
       (list                                                      
         (cdr a)                                          
      )                                                               
          )                                                                     
       )                                                                     
   )                                                                              
    )
(setq listana (vl-sort myVertexList '(lambda (j k)(< (car j) (car k)))))

(setq p1 (car listana))
(setq AnItem (getvar "OSMODE"))
(AList "OLDSNAP" AnItem)
(setq AnItem (getvar "HIGHLIGHT"))
(AList "OLDHIGH" AnItem)
(setq AnItem (getvar "CMDECHO"))
(AList "OLDECHO" AnItem)
(setvar "Osmode" 0)
(setvar "Highlight" 0)
(setvar "Cmdecho" 0)

(setq ptx1 (mapcar '+ p1 (list 0.20 0.20)))
(setq ptx2 (mapcar '+ p1 (list 0.20 0.50)))
(command "area" "Object" en)
(setq are (getvar "area"))
(setq ar (strcat (rtos are 2 2) " m2"))


(setq vol (strcat (rtos (* are h) 2 2) " m3" ))
(command "layer" "m" "ali_text" "")
(command "text" "j" "mc" pt1 "0.2" "0" (strcat "O" (rtos (+ 1 cntr) 2 0)) "")
(command "text" "j" "mc" pt2 "0.2" "0" ar "")
(command "text" "j" "mc" pt4 "0.2" "0" (rtos h 2 2) "")
(command "text" "j" "mc" pt5 "0.2" "0" vol "")




(command "text"ptx2 "0.25" "0" (strcat "O" (rtos (+ 1 cntr) 2 0))"")
(command "text"ptx1 "0.25" "0" (strcat "Area=" ar) "")

(setq cntr (+ 1 cntr))
(setq pt1 (mapcar '+ pt1 (list 0 -0.30)))
(setq pt2 (mapcar '+ pt2 (list 0 -0.30)))
(setq pt4 (mapcar '+ pt4 (list 0 -0.30)))
(setq pt5 (mapcar '+ pt5 (list 0 -0.30)))
)
(setvar "OSMODE" (RList "OLDSNAP"))
   ;retrieve and reset snap

   (setvar "HIGHLIGHT" (RList "OLDHIGH"))
   ;retrieve and reset highlight

   (setvar "CMDECHO" (RList "OLDECHO"))
   ;retrieve and reset command echo

(princ)

      
)


(defun AList (Name Val)

   (setq item (list (cons Name Val)))
   ;construct list

   (setq MainList (append item Mainlist))
   ;add it to the main list

);defun

;This function retrieves the values from the main list
(defun RList (TheName)

   (cdr (assoc TheName MainList))
   ;retrieve value from list

);defun
(princ)


(defun dtr (x)
   ;define degrees to radians function

   (* pi (/ x 180.0))
   ;divide the angle by 180 then
   ;multiply the result by the constant PI

)    ;end of function











你可以在这里看到如何使用它
 
 
 
问题是:
如果多段线的排列很重要,我必须一个接一个地选择它,,,因为如果我一次全部选择,它将是随机排列
 
所以,,,我希望如果你能帮我怎么修复它

ymg3 发表于 2022-7-6 00:17:36

尊敬的先生,
 
当您选择不带任何过滤器时,它或多或少是实体创建的顺序。
 
对于lisp,您不能依赖于此来给出有序序列。
 
你可以做的是得到每个区域的边界框(我想是lwpolyline)
并通过vl排序
 
 
السلام عليكم
 
ymg公司

ymg3 发表于 2022-7-6 00:27:14

سبع الليل
 
我看了你们的节目。
 
您已经对每条多段线进行排序,以获得点p1。
现在,如果您将所有p1保存在一个单独的列表中,您可以像获取p1一样对其进行排序。
 
缺点是它会改变程序的结构。那就是你会的
需要将所有内容保存在一个大列表中((p1“Surface”“height”“Volume”)……)
 
一旦你有了这个大列表,你就对它进行排序,然后,只有这样,你才能画出你的文本。
 
السلام عليكم
 
ymg公司

ymg3 发表于 2022-7-6 00:28:59

سبع الليل
 
希望你不会介意,但我对你的日常生活做了一些调整,
结果如下。
 

(defun c:ar (/ *acaddoc* are biglst cntr en errl eset h i item
                  p1 pt1 pt2 pt4 pt5 ptx1 ptx2 su tap tarea vol)

(vl-load-com)

;;; Error Handler by ElpanovEvgenyi                                    ;
(defun *error* (msg)
(mapcar 'eval errl)
   
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
          (princ (strcat "\nError: " msg))
       )
(and *AcadDoc* (vla-endundomark *AcadDoc*))
       (princ)
)
   
(setq errl '("CLAYER" "OSMODE" "CMDECHO" "HIGHLIGHT" "DIMZIN")
      errl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) errl)
)   
   
(or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
      
(setvar 'CMDECHO 0)
(setvar 'DIMZIN 0)
(setvar 'OSMODE 0)
(setvar 'HIGHLIGHT 0)

(princ "\nSelect Polylines:")
(setq eset (ssget '((0 . "*POLYLINE")))
       cntr 0
      tap (getpoint "\nInsertion point")
      pt1 (mapcar '+ tap (list 0.5 -0.45))
      pt2 (mapcar '+ pt1 (list 1 0))
      pt4 (mapcar '+ pt2 (list 1 0))
      pt5 (mapcar '+ pt4 (list 1 0))
          h (getreal "\nHeight of Footings:")
)

(command "layer" "m" "ali_text" "")

(setvar 'CLAYER "ali_text")

(setq tarea 0.0 biglst nil)
(repeat (setq i (sslength eset))
   (setq   en (ssname eset (setq i (1- i)))
            are (vlax-curve-getarea en)
          tarea (+ tarea are)
             su (strcat (rtos are 2 2) " m2")
            vol (strcat (rtos (* are h) 2 2) " m3")
             p1 (car (vl-sort (listpol en) '(lambda (j k) (< (car j) (car k)))))
         item (list p1 su (rtos h 2 2) vol)
         biglst (cons item biglst)   
   )
)

(setq biglst (vl-sort biglst '(lambda (j k) (< (caar j) (caar k)))))

(vla-startundomark *AcadDoc*)
(foreach item biglst      
   (command "text" "j" "mc" pt1 "0.2" "0" (strcat "O" (rtos (+ 1 cntr) 2 0)))
   (command "text" "j" "mc" pt2 "0.2" "0" (cadr item))
   (command "text" "j" "mc" pt4 "0.2" "0" (caddr item))
   (command "text" "j" "mc" pt5 "0.2" "0" (cadddr item))
   (setq p1 (car item))
   (setq ptx1 (mapcar '+ p1 (list 0.20 0.20)))
   (setq ptx2 (mapcar '+ p1 (list 0.20 0.50)))
   (command "text" ptx2 "0.25" "0" (strcat "O" (rtos (+ 1 cntr) 2 0)))
   (command "text" ptx1 "0.25" "0" (strcat "Area=" (cadr item)))
   (setq cntr (+ 1 cntr))
   (setq pt1 (mapcar '+ pt1 (list 0 -0.30))
         pt2 (mapcar '+ pt2 (list 0 -0.30))
         pt4 (mapcar '+ pt4 (list 0 -0.30))
         pt5 (mapcar '+ pt5 (list 0 -0.30))
   )
)


(*error* nil)

)

(defun dtr (x)(* pi (/ x 180.0)))

;;; Poly-Pts (gile)                                                         ;
;;; Returns the vertices list of any type of polyline (WCS coordinates)       ;
;;;                                                                           ;
;;; Argument                                                                  ;
;;; pl : a polyline (ename or vla-object)                                     ;

(defun listpol        (en / pa pt lst)
(vl-load-com)
(setq        pa (if (vlax-curve-IsClosed en)
      (vlax-curve-getEndParam en)
      (+ (vlax-curve-getEndParam en) 1)
   )
)
(while (setq pt (vlax-curve-getPointAtParam en (setq pa (- pa 1))))
   (setq lst (cons pt lst))
)
)




 
现在,如果我是你,我会去掉所有的命令并使用Entmake
输出文本。
 
ymg公司
基脚。图纸

asos2000 发表于 2022-7-6 00:39:15

李有一个很好的ssget教程

سبع الليل 发表于 2022-7-6 00:54:42

ymg3
非常感谢你,,,,
非常感谢您的帮助。。。。
现在我很高兴你们为我的节目做了精彩的编辑
我在afralisp学习autolisp。com和jefferyspanders。通用域名格式。。。。但我觉得我错过了autolisp的许多基础知识。。我不知道哪里是最好的网站,在那里我可以找到所有的东西,没有遗漏
我现在计划开始学习visual lisp教程
谢谢你,,,很抱歉我英语不好

سبع الليل 发表于 2022-7-6 00:59:27

asos2000年
شكراً للمرور يا برنس .... إنت منين من كايرو
أنا هندسة طنطا 2003 ... و ما كنتش فاكر إني هلاقي عرب في المنتدى ده
كل سنة و إنت طيب
页: [1]
查看完整版本: ssget随机排列