用grread做一个动态等分

admin1

理想：点击内空，移动鼠标，根据鼠标与点击点的距离 来自动调整等分数量，根据鼠标的方向自动变化等分的方向
进阶理想：二次单击鼠标左键，确定等分的数量和方向后，将等分线由单线变成双线。并根据鼠标的位置调整双线之间的距离！
我感觉离目标已经不远了，跟我说说，再绘制了一次等分后，移动鼠标，如何删除上一次等分，然后更新新的等分。


动态等分.lsp
(defun C:t4( / )
(YL_begin)
                (if (setq pta (getpoint "\n层板位置"))
        (progn
        (setq ent0 (entlast))
        (COMMAND "-BOUNDARY" pta "")
        (mc:wk (last_ent ent0))
        (setq ent (entlast))
        (setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))));提取多段线坐标
        (setq p1 (car ss) p2 (cadr ss)        p3 (caddr ss) p4 (cadddr ss) pz (Mc:Md p1 p3) H (distance P1 P4) W (distance P1 P2))               
         )       
                )                   
              (setq bb T)
              (while bb
        (setq mouse (grread t 12 0))
        (setq a (car mouse) aa (cadr mouse))
        (cond
         ((= 5 a)
                                                                (PROGN
                                                          (setq R (MC:ROZ (angle Pz AA))
                                                                            d (distance  Pz AA)
                      dd (distance  p1 p3)                                                                       
                                                                )                                                               
                                                                (if (> 2 (setq n (fix (atof (MC:RTOSZ (/ (* d 10) dd))))))
                                  (setq n 2))       
                        (if (/= n nn)       
                  (PROGN
                        (COMMAND "_.erase"  (last_ent ent0) "")                                                                               
                                                                        (mc:EQ-LINE P1 P2 P3 P4 n R)
                                                                                (setq nn n))
                                                                        )                                                                       
                                                                 )                                         
                                                         )


          ((or (= 3 a);左键
                                                 (= 25 a) (= 11 a) ;右键
             (and (= a 2) (= aa 13));回车
             (and (= a 2) (= aa 32));或空格.
           )
            (setq bb nil)
          )
        );cond
      )     
                                                (setq cb (getdist aa "设置层板厚度"))
                                                (if (/= cb nil)
                                                        (PROGN
                                                          (if (= r 0)
                                                                        (setq pa p1 pb p4 k w)
                                                                  (setq pa p1 pb p2 k h)
                                                                  )                                                       
                                                                (COMMAND "_.erase"  (last_ent ent0) "")       
                                                                (repeat (1- n)
                                                                (setq pa (polar Pa R (/ (- k (* cb(1- n))) n)))
                                                                (setq pb (polar Pb R (/ (- k (* cb(1- n))) n)))
                                                                (setq pc (polar Pb R cb))
                                                                (setq pd (polar Pa R cb))               
                                                          (Mc:spl (list pa pb pc pd))
                                                                (setq pa pd pb pc)
                                                                )
                                                                )
                                                )
                (YL_end)
                (princ)
        )

;;点表生成多段线
(defun Mc:spl (lst / pt)
   (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
      (mapcar '(lambda (pt)(cons 10 pt)) lst ))
  )
)

;;在指定区域内绘图
(defun mc:EQ-LINE (PT1 PT2 PT3 PT4 n r /  nww nhh)
(SETQ HH (distance PT1 PT4) WW (distance PT1 PT2))
(if (= r 0)
        (PROGN
                  (PROGN                                       
                        (SETQ Nww (/ ww n))
        (repeat (1- n)
                (setq Pt1 (polar Pt1 R nww))
                (setq Pt4 (polar Pt4 R nww))
                (mc:zx pt1 pt4)
                )
                )
        )
                (PROGN                       
                        (SETQ NHH (/ HH n))
          (repeat (1- n)
                (setq Pt1 (polar Pt1 R nhh))
                (setq Pt2 (polar Pt2 R nhh))
                (mc:zx pt1 pt2)
                )
                )
))


;;四舍五入取整
(defun MC:RTOSZ (STR / )
(setq STR (rtos STR 2 0))
)


;;;两点画直线
(defun Mc:ZX (PT1 PT2 /)
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
)

;;返回垂直或水平方向
(defun Mc:roz ( R / )
(IF
  (or (< (* 0.25 pi) R (* 0.75 pi))
      (< (* 1.25 pi) R (* 1.75 pi))
      )
  (SETQ  R  (* PI 0.5))
        (SETQ  R 0)
)
)



;;;;===============================必备函数=============================
;;*****************************************************************************
;;功 能：绘图程序的初始化处理，记录当前层名、线型、颜色、捕捉方式、文本样式、文本高度,
;; 控制点标记可见方式、主单位值消零处理方式、命令行回显方式、然后关闭目标捕捉,
;; 设置线形随层、颜色随层、设置命令行不回显、不显示控制点标记、对主单位值后续零作消零处理
;;说 明：和函数YL_end配对使用。
(defun YL_begin ()
        (setq oderr *error*) ;;保存原来的*error*
        (setq *error* YL_err) ;;将*error*用自己的错误处理函数替代
        (setq odltp (getvar "celtype")) ;;记录当前线型设置
        (setq odclr (getvar "cecolor")) ;;记录当前颜色设置
        (setq odosm (getvar "osmode")) ;;记录当前捕捉方式
        (setq odlay (getvar "clayer")) ;;记录当前层
        (setq odsty (getvar "textstyle")) ;;记录当前文本样式
        (setq odtsz (getvar "textsize")) ;;记录当前文本高度
        (setq odbpm (getvar "blipmode")) ;;记录当前控制点标记是否可见
        (setq odzin (getvar "dimzin")) ;;记录主单位值消零处理方式
        (setq odcmd (getvar "cmdecho")) ;;记录命令行回显方式
        (setvar "celtype" "bylayer") ;;设置线形随层
        (setvar "cecolor" "bylayer") ;;设置颜色随层
        (setvar "cmdecho" 0) ;;设置命令行不回显
        (setvar "blipmode" 0) ;;不显示控制点标记
        (setvar "dimzin" 8) ;;对主单位值后续零作消零处理,因为DIMZIN 对 AutoLISP rtos 和 angtos 函数执行实数向字符串转换操作有影响。
        (setvar "osmode" 0) ;;关闭对象捕捉方式
)
;;*****************************************************************************
;;YL_end
;;功 能：程序结束，恢复程序开始前的设置。
;; 恢复YL_begin设置的系统变量表中的数值。
;;说 明：和函数YL_begin配对使用。
(defun YL_end ()
        (setvar "celtype" odltp)
        (setvar "cecolor" odclr)
        (setvar "osmode" odosm)
        (setvar "textstyle" odsty)
        (setvar "textsize" odtsz)
        (setvar "blipmode" odbpm)
        (setvar "dimzin" odzin) ;;恢复主单位值消零处理方式
        (setvar "cmdecho" odcmd)
        (setq *error* oderr) ;;恢复原来的*error*
        (princ)
)
;;*****************************************************************************
;;YL_err
;;功 能：错误处理函数。
(defun YL_err (msg)
        (princ (strcat "\n错误:" msg "\n")) ;;打印错误原因
        (YL_end) ;;调用函数YL_end恢复程序开始前的设置
        (setq *error* oderr) ;;恢复原来的*error*
        (princ)
)

;;39外框
(defun mc:wk (ss / oldos oldla  lst n obj minx miny maxx  maxy pt1
         pt2 pt3 pt4)
  (setq oldos (getvar "osmode"))
  (setq oldla (getvar "clayer"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (repeat (setq n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    (vla-getboundingbox obj 'x 'y)
    (setq lst (cons (vlax-safearray->list y)
        (cons (vlax-safearray->list x) lst)
        )
    )
  )
  (setq  minx (car (vl-sort (mapcar 'car lst) '<))
  miny (car (vl-sort (mapcar 'cadr lst) '<))
  maxx (car (vl-sort (mapcar 'car lst) '>))
  maxy (car (vl-sort (mapcar 'cadr lst) '>))
  )
  (setq pt1 (list minx miny))
  (setq pt2 (list maxx miny))
  (setq pt3 (list maxx maxy))
  (setq pt4 (list minx maxy))
        (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 pt1) (cons 10 pt2) (cons 10 pt3) (cons 10 pt4)))
  (setvar "osmode" oldos)
  (setvar "clayer" oldla)
  (setvar "cmdecho" 1)
  (princ)
)


;;40最后生产出的图元
(defun last_ent (en / ss)
        (if en
                (progn
                        (setq ss (ssadd))
                        (while (setq en (entnext en))
                                (if (not (member (cdr (assoc 0 (entget en)))
                                                                         '("ATTRIB" "VERTEX" "SEQEND")
                                                                 )
                                                )
                                        (ssadd en ss)
                                );if
                        );while
                        (if (zerop (sslength ss)) (setq ss nil))
                        ss
                );progn
                (ssget "_x")
        );if
)


;两点中
(defun Mc:Md (pt1 pt2 / ptn)
        (setq ptn (mapcar'(lambda(X Y)(/(+ X Y)2.0)) pt1 pt2))
)












层板jj.lsp

(defun C:jj( / ent0 ent ss p1 p2 p3 p4 pz h w a aa d dd n nn nm mouse r )
        (YL_begin)
        (if (setq pta (getpoint "\n层板位置"))
                (progn
                        (setq ent0 (entlast))
                        (COMMAND "-BOUNDARY" pta "")
                        (mc:wk (last_ent ent0))
                        (setq ent (entlast))
                        (setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))));提取多段线坐标
                        (setq p1 (car ss) p2 (cadr ss)        p3 (caddr ss) p4 (cadddr ss) pz (Mc:Md p1 p3) H (distance P1 P4) W (distance P1 P2))
                )
        )
        (setq bb T)
        (while bb
                (setq mouse (grread t 12 0))
                (setq a (car mouse))
                (if( /= a 3) (setq  aa (cadr mouse)) (setq aa nil))
                (cond
                        ((= 5 a)
                                (PROGN
                                        (setq R (MC:ROZ (angle Pz AA))
                                                d (distance  Pz AA)
                                                dd (distance  p1 p3)
                                        )
                                        (if (> 2 (setq n (fix (atof (MC:RTOSZ (/ (* d 10) dd))))))
                                                (setq n 2))
                                        (if (/= n nn)
                                                (PROGN
                                                        (mc:EQ-LINE P1 P2 P3 P4 n R)
                                                        (setq ptmin (car (viewpnts)) ptmax (cadr (viewpnts)))
                                                        (entmake (list '(0 . "TEXT") (cons 1 (itoa n)) (cons 10 aa) (cons 40 (/ (distance ptmin ptmax) 80))(cons 62 3)))
                                                        (Mc:ZXc pz aa 3)
                                                        (setq nn n nm nn)
                                                )
                                        )
                                )
                        )
                        ((equal mouse '(2 50))
                                (PROGN     (setq  nm 2)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 51))
                                (PROGN     (setq  nm 3)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 52))
                                (PROGN     (setq  nm 4)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 53))
                                (PROGN     (setq  nm 5)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 54))
                                (PROGN     (setq  nm 6)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 55))
                                (PROGN     (setq  nm 7)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 56))
                                (PROGN     (setq  nm 8)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((equal mouse '(2 57))
                                (PROGN     (setq  nm 9)
                                        (mc:EQ-LINE P1 P2 P3 P4 nm R)))
                        ((or (= 3 a);左键
                                 (= 25 a) (= 11 a) ;右键
                                 (and (= a 2) (= aa 13));回车
                                 (and (= a 2) (= aa 32));或空格.
                         )
                                (setq bb nil)
                        )
                );cond
        )
        (mc:cbl p1 p2 p4 nm r)
        (YL_end)
        (princ)
)
;;在指定区域内绘直线
(defun mc:EQ-LINE (PT1 PT2 PT3 PT4 n r /  nww nhh)
        (COMMAND "_.erase"  (last_ent ent0) "")
        (SETQ HH (distance PT1 PT4) WW (distance PT1 PT2))
        (if (= r 0)
                (PROGN
                  (PROGN
                                (SETQ Nww (/ ww n))
                                (repeat (1- n)
                                        (setq Pt1 (polar Pt1 R nww))
                                        (setq Pt4 (polar Pt4 R nww))
                                        (mc:zx pt1 pt4)
                                )
                        )
                )
                (PROGN
                        (SETQ NHH (/ HH n))
                        (repeat (1- n)
                                (setq Pt1 (polar Pt1 R nhh))
                                (setq Pt2 (polar Pt2 R nhh))
                                (mc:zx pt1 pt2)
                        )
                )
        ))
;;在指定区域内绘矩形
(defun mc:cbl (p1 p2 p4 n r  / pa pb pc pd cb)
        (setvar "OSMODE" 6079)
        (setq cb (getdist  "设置层板厚度"))
        (if (/= cb nil)
                (progn
                        (if (= r 0)
                                (setq pa p1 pb p4 k w)
                                (setq pa p1 pb p2 k h)
                        )
                        (COMMAND "_.erase"  (last_ent ent0) "")
                        (repeat (1- n)
                                (setq pa (polar Pa R (/ (- k (* cb(1- n))) n)))
                                (setq pb (polar Pb R (/ (- k (* cb(1- n))) n)))
                                (setq pc (polar Pb R cb))
                                (setq pd (polar Pa R cb))
                                (Mc:spl (list pa pb pc pd pa))
                                (setq pa pd pb pc)
                        )
                        (mc:newlayer "F-家具内线"  252  "Continuous")
                        (mc:ggtc (last_ent ent0) "F-家具内线")        ))
)

jxmjg

  法拉利膜材作为一种高性能的建筑材料，在建筑、汽车及广告等多个领域有着广泛的应用。以下是对法拉利膜材型号、特点及优点的详细分析：
[img]http://www.mjgou.com/data/attachment/forum/202403/13/223041uiqmeujen4jjj6zv.jpg[/img]
[b]一、法拉利膜材型号[/b]
法拉利膜材有多种型号，包括但不限于以下几种：1302 S2 Flexlight Advanced：这是一种高性能IV型柔性复合膜材，以其卓越的透光性、耐久性和易维护性而受到青睐。942、1202 S2、1002 S2、902 S2、1212 S2、912 S2：这些型号同样属于法拉利膜材系列，各自具有不同的特性和适用范围，但具体特点需根据具体型号进一步分析。需要注意的是，法拉利膜材的型号可能随着产品更新换代而有所变化，具体型号及其特性请参考最新产品资料。
[img=860,1255]http://www.mjgou.com/data/attachment/forum/202403/13/223254bbblwlbvbvsbwlsl.jpg[/img]
[b]二、法拉利膜材特点[/b]
法拉利膜材的特点主要体现在以下几个方面：
1、高强度与耐用性：法拉利膜材采用高强度材料制成，具有良好的抗拉强度和撕裂强度，能够承受较大的外力作用而不易破损。耐用性强，能够在恶劣气候条件下保持稳定的性能，延长使用寿命。
2、透光性与美观性：部分型号如1302 S2 Flexlight Advanced具有高透光性，能够在保持室内光线充足的同时，提供清晰的视野。膜材表面平整光滑，色彩丰富多样，能够满足不同建筑和装饰需求，提升整体美观性。
3、轻质与灵活性：法拉利膜材重量较轻，便于运输和安装，能够降低施工成本和时间。膜材具有一定的柔韧性，能够适应各种复杂形状和结构的设计要求。
4、环保与可回收性：法拉利膜材符合环保要求，部分材料可回收利用，减少了对环境的影响。
[img]http://www.mjgou.com/data/attachment/forum/202403/13/223128owhn0099rrds5h5y.jpg[/img]
[b]三、法拉利膜材优点[/b]
法拉利膜材的优点主要体现在以下几个方面：
1、提升建筑性能：高强度与耐用性使得法拉利膜材能够提升建筑的稳定性和安全性，延长使用寿命。透光性与美观性使得建筑内部光线充足、视野开阔，同时提升整体美观度。
2、降低施工成本：轻质特性使得运输和安装成本降低，施工效率提高。膜材的柔韧性使得施工更加灵活多变，能够适应各种复杂地形和结构要求。
3、节能环保：部分材料可回收利用，符合环保要求，减少了对环境的影响。良好的透光性能够减少室内照明需求，降低能耗。
4、广泛应用领域：
法拉利膜材不仅适用于建筑领域（如体育设施、商业设施、文化设施、交通设施等），还广泛应用于汽车及广告领域（如高档车辆贴膜保护和装饰、广告招贴等），展现出其多功能的特性。

综上所述，法拉利膜材以其高强度、耐用性、透光性、美观性、轻质灵活性以及环保可回收性等优点，在建筑、汽车及广告等多个领域发挥着重要作用。具体型号的选择应根据实际需求和应用场景进行综合考虑。
[url=http://www.mjgou.com/forum-17-1.html][size=92821][color=Red]法拉利膜材中国代理商 - 膜结构网[/color][/size][/url]