tozjerimiah 发表于 2022-7-6 06:40:29

LISP编程帮助-

你好
 
我想要一个lisp脚本,它执行以下操作:
 
1.在图形中扫描具有由通配符定义的特定图层名称的图层上的多段线(例如Plot-*其中可以表示Plot-001、Plot-200、Plot Green等)
 
a) 以CSV格式创建名为PlanPolylineCoords的文本文件。csv&包含以下字段:
图层名称、图元名称(内部AutoCAD参考)、坐标x、坐标y、凸出、HatchEntityName、HatchStyle
每个坐标对(如有凸出部分)(&bulge)应列在单独的一行上
如果多段线是闭合的,请列出另一个链接回第一个点的点(因此,如果闭合多段线有4个点,请添加与第一个点相同的第五个点)。
图案填充-将边界重新生成为多段线,如果其中有孔,则必须按从边界到图案填充的相反顺序列出坐标(例如顺时针边界、逆时针剪切或逆时针边界、顺时针剪切)
 
b) 图层上任何块参照的坐标和旋转,以及块的名称
以CSV格式创建一个名为PlanBlockCoords的文本文件。csv&包含以下字段:
块名称、坐标x、坐标y、旋转
每个块实例应列在单独的一行上
 
 
2.在图形中扫描具有由通配符定义的特定名称的块参照(例如Housetype-*其中可以表示Housetype-Detached3Bed、Housetype Flat、Housetype-2Bed等)
以CSV格式创建一个名为BlockCoords的文本文件。csv&包含以下字段:
块名称、图层名称、图元名称(内部AutoCAD参考)、坐标x、坐标y、凸出、HatchEntityName、HatchStyle
a) 块中多段线点的图层和坐标-相对于块的坐标,而不是其在图形上的位置。如果多段线是闭合的,请列出另一个链接回第一个点的点(因此,如果闭合多段线有4个点,请添加与第一个点相同的第五个点)。还需要任何曲线的凸出度。。。此外,如果有与多段线关联的图案填充,请尽可能列出图案填充的样式名称
图层名称(块图层,而不是其插入的CAD图层)、图元名称(内部AutoCAD参考)、坐标系、坐标系、凸出、图案填充样式
图案填充-将边界重新生成为多段线,如果其中有孔,则必须按从边界到图案填充的相反顺序列出坐标(例如顺时针边界、逆时针剪切或逆时针边界、顺时针剪切)
 
 
在例程开始时,应询问用户这3个文件应写入哪个文件夹。我们不需要任何菜单或图标,命令行界面很好,尽管程序可以请求:
a) 由通配符和
b) 哪些块名由通配符定义
应该被扫描——同样,可以在命令行进行扫描。
 
我附上了一个示例图纸和3个文件,这应该会让你更好地了解我们的要求。请查看附件以获取解释,如果需要更多详细信息,请联系。
 
非常感谢
托兹
方块坐标。csv
实例图纸
平面块坐标。csv
平面多段线坐标。csv

tozjerimiah 发表于 2022-7-6 06:54:15

碰撞。。。会认为这对一个有经验的Lisp程序的人来说是相当容易的。。。如果你想打电话,我可以把我的号码传给你。。。
 

fixo 发表于 2022-7-6 07:02:06

尝试仅开始写入块

(defun C:demo(/ date dx dy elist en file fname headers lay line name plott pt rot sset)
(defun dxf( key alist / )(cdr (assoc key alist)))
; Convert value in radians to degrees
(defun rtd (a) (* 180.0 (/ a pi)))
; Convert value in degrees to radians
(defun dtr (a) (* pi (/ a 180.0)))
(setvar "dimzin" 0)
(if (setq sset (ssget "_X" '((0 . "insert")(8 . "Plot-*"))))
(progn
   (setq headers "Layer Name, Block Name, CoordX, CoordY, Rotation")
(setq plott (cons headers plott))
   (while (setq en (ssname sset 0))
   (setq elist (entget en))
   (setq lay (dxf 8 elist)
    name (dxf 2 elist)
    pt (dxf 10 elist)
    dx (car pt)
    dy (cadr pt)
    rot (rtd (dxf 50 elist)))
   (setq line (strcat lay ","name","(rtos dx 2 1)","(rtos dy 2 1)"," (rtos rot 2 0)))
   (setq plott (cons line plott))
   (ssdel en sset))
(setq plott (reverse plott))
(if plott
   (progn

(setq date (menucmd "M=$(edtime,$(getvar,date),MO_DD_YY_HH_MM)"))

(setq fname (strcat (getvar "dwgprefix") (strcat "PlanBlockCoords_" date ".csv")))

(if (setq file (open fname "w"))
       (progn

         (foreach line plott

               (write-line line file)
         )
         (close file)
          )
       )
)
   )
(alert (strcat "Saved in file: \n" fname))
)
)
(princ)
)
(prompt "\n\t---\tType demo to write blocks to csv\t---")
(prin1)

tozjerimiah 发表于 2022-7-6 07:13:55

fixo太好了。如果你有信心完成剩下的工作,我会授予你独家经营权。如果你明天这个时候能完成,我会把费用提高到100英镑。如果你乐意接受,请将你的paypal详细信息发送给我&我将支付10英镑的首付款。
 
谢谢
 

fixo 发表于 2022-7-6 07:20:57

我会尽力,但没有担保,
请稍候,仍在继续

fixo 发表于 2022-7-6 07:29:28

这是下一个命令,我很快就可以了
里面有些错误
 

(defun C:demo2 (/ bulge ec date dx dy en enh eparfile fname found headers
hobjs hset info inspts line obj plott pt rest spar sset tail)
(vl-load-com)

(setvar "dimzin" 0)
(command "_zoom" "_e")
(if (setq sset (ssget'((0 . "lwpolyline")(8 . "Plot-*"))))
(progn
   (setq hset (ssget "_X" '((0 . "hatch")(8 . "Plot-*"))))
   (while (setq enh (ssname hset 0))
   (setq hobjs (cons (vlax-ename->vla-object enh) hobjs))
   (ssdel enh hset))
   (setq headers "Layer Name, Entity Name, CoordX, CoordY, Bulge, HatchEntityName, HatchStyle")
   (setq plott (cons headers plott))
   (while (setq en (ssname sset 0))
   
   (setq obj (vlax-ename->vla-object en))
   (setq found nil)
   (foreach hobj hobjs
   (if (not (vl-catch-all-error-p (setq inspts (vl-catch-all-apply'(lambda()(vla-intersectwith obj hobj acExtendNone))))))
(progn
(setq found T)
(setq tail (strcat "," (vla-get-handle hobj) "," (vla-get-patternname hobj))))
       (setq tail (strcat ",NULL,NULL"))))
(setq line (strcat (vla-get-layer obj) ","(vla-get-handle obj)","))
(setq spar (vlax-curve-getstartparam obj)
         epar (vlax-curve-getendparam obj))
   (if (eq :vlax-true (vla-get-closed obj))(setq ec epar)(setq ec (+ epar 1)))
(while (< spar ec)

   (setq pt (vlax-curve-getpointatparam obj spar))
   (setq dx (car pt)
    dy (cadr pt))
   (setq bulge (abs (vlax-invoke obj 'getbulge spar)))
   (setq rest (strcat (rtos dx 2 1)"," (rtos dy 2 1)"," (rtos bulge 2 2)))
   (setq info (strcat line rest tail))
   (setq plott (cons info plott))
   (setq spar (1+ spar)))
   (ssdel en sset))
(setq plott (reverse plott))
(if plott
   (progn

(setq date (menucmd "M=$(edtime,$(getvar,date),MO_DD_YY_HH_MM)"))

(setq fname (strcat (getvar "dwgprefix") (strcat "PlanPolylineCoords_" date ".csv")))

(if (setq file (open fname "w"))
       (progn
         
         (foreach line plott
   
               (write-line line file)
         )
         (close file)
          )
       )
)   
)
   )
)
(princ)
)
(prompt "\n")
(prompt "\n\t***\tType demo2 to execute...\t***\n")
(princ)

tozjerimiah 发表于 2022-7-6 07:33:31

没有收到电子邮件通知&只是看到了这个-谢谢。我还没有机会测试它,我明天上班时会做。
 

fixo 发表于 2022-7-6 07:47:14

我也没有收到你的PM,如果你想的话,就让你寄吧
嗯,我几乎听不懂英语,更不用说我帖子里恶心的语法了,
我不完全理解所有要点的原因,而您的任务也不确定它是否能按您的需要工作。
虽然如果这是工作,你可以发送一些美分为这个论坛捐款,没有更多
页: [1]
查看完整版本: LISP编程帮助-