Zykl0 发表于 2022-7-6 17:12:10

Lisp-将pt1切换到pt2-

你好
 
我正在寻找一个lisp能够切换pt1到pt2从一行
有一个条件。。。仅当Y轴上的pt2>pt1时。
 
pt1=良好
l
l
l
l
pt2=良好
 
pt2=坏
l
l
l
l
pt1=坏
 
知道吗?
非常感谢。

Zykl0 发表于 2022-7-6 17:22:31

我真的很想知道是否可能请

ASMI 发表于 2022-7-6 17:26:29

你考虑到了吗?
 
(defun c:test(/ pt1 pt2)
(and
   (setq pt1(getpoint "\nSpecify pt1: "))
   (setq pt2(getpoint "\nSpecify pt2: "))
   (>(cadr pt2)(cadr pt1))
   (vl-cmdf "_.line" pt1 pt2 "")
   ); end and
(princ)
); end of c:test

wizman 发表于 2022-7-6 17:35:22

以下是线路:
 
(defun c:linewiz ()
   (vl-load-com)
   (defun MkLine (p1 p2 lw_lay)
(entmakex (list        (cons 0 "LINE")
                (cons 8 lw_lay)
                (cons 10 p1)
                (cons 11 p2)
          ) ;_ end_list
) ;_ end_entmakex
   ) ;_ end_defun
   (if        (setq lw_set (ssget '((0 . "LINE"))))
(progn
    (setq counter 0)
    (while (< counter (sslength lw_set))
        (setq lw_ent (ssname lw_set counter))
        (setq lw_lay (cdr (assoc 8 (entget lw_ent))))
        (if
          (< (cadr (setq lw_stpt
                              (vlax-curve-getStartPoint
                                  lw_ent
                              ) ;_ end_vlax-curve-getStartPoint
                     ) ;_ end_setq
             ) ;_ end_cadr
             (cadr (setq lw_endpt
                              (vlax-curve-getendpoint
                                  lw_ent
                              ) ;_ end_vlax-curve-getendpoint
                     ) ;_ end_setq
             ) ;_ end_cadr
          ) ;_ end_<
             (progn
                   (mkline lw_endpt lw_stpt lw_lay)
                   (entdel lw_ent)
             ) ;_ end_progn
        ) ;_ end_if
        (setq counter (1+ counter))
    ) ;_ end_while
) ;_ end_progn
   ) ;_ end_if
   (princ)
) ;_ end_defun

CAB 发表于 2022-7-6 17:36:46

这可能会引起一些兴趣。
WallHatch。lsp

Zykl0 发表于 2022-7-6 17:47:57

工作很好,但这并不能解决我的问题。
 
我会解释为什么。。。
 
这是CAB为我做的一个代码
 

;;CAB 10.23.08version 1.4
;;added skip of length too short for sizing
;;CAB 10.24.08version 1.5
;;Changed test for Metric using MEASUREMENT ILO MEASUREINIT system var
;;Zykl0 10.24.08version 1.5.1
;;Changed Some Layers and textstyle to fit new template
(defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits
                   MinLen Metric
                   txtoffset 25Size 32Size 40Size 50Size 65Size maketext kdub:roundNearest GetUnits)

(defun maketext (pt ang str ht just lay sty / dxf72 dxf73)
   ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 )))))
   (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1)))))
   (entmakex (list (cons 0 "TEXT")
                   (cons 1 str) ; (the string itself)
                   (cons 6 "BYLAYER") ; Linetype name
                   (cons 7 sty) ;* Text style name, defaults to STANDARD, not current
                   (cons 8 lay) ; layer
                   (cons 10 pt) ;* First alignment point (in OCS)
                   (cons 11 pt) ;* Second alignment point (in OCS)
                   ;;(cons 39 0.0) ; Thickness (optional; default = 0)
                   (cons 40 ht) ;* Text height
                   ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0
                   (cons 50 ang) ; Text rotation ange
                   ;;(cons 51 0.0) ; Oblique angle
                   (cons 71 0) ; Text generation flags
                   (cons 72 1) ; Horizontal text justification type
                   (cons 73 dxf73) ; Vertical text justification type
             )
   )
)

;;* kdub:roundNearest (numVal roundTo displayPrecision)
;; Round a numeric positive number to the NEAREST 'rounded' number
;; and format to n digits
;; kwb@theSwamp 20070814
(DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum)
   (SETQ remNum (REM numVal roundTo))
   (RTOS (IF (>= (* 2 remNum) roundTo)
               (+ numVal (- roundTo remNum))
               (- numVal remNum)
         )
         2
         displayPrecision
   )
)


;;Returns the type of units
(defun GetUnits (/ Units)
   (setq Units (getvar "InsUnits")) ; DesignCenter Drag Units
   (cond
   ((= Units 0) ;NoUnit
      (if (= (getvar "MEASUREMENT") 1) ; if metric
      "mm"                           ; use Millimeter
      "inch"                         ; else Inch
      )
   )
   (t
      (nth
      (1- Units)
      (list
          "inch"       ;Inch
          "feet"       ;Feet
          "mile"       ;Mile
          "mm"         ;Millimeter
          "cm"         ;Centimeter
          "m"          ;Meter
          "km"         ;Kilometer
          "microinch";Micro inch
          "mil"      ;Milli inch
          "yard"       ;Yard
          "angstrom"   ;Angstrom
          "nm"         ;Nanometer
          "micron"   ;Micron
          "dm"         ;Decimeter
          "dam"      ;Decameter
          "hm"         ;Hectometer
          "gm"         ;Gigameter
          "au"         ;Astronomic unit
          "light_year" ;Light year
          "parsec"   ;Parsec
         )
      )
   )
   )
)

;;use Royal Text Style if it exist
(if (setq lst (tblsearch "style" "Royaltech"))
   (setq sty "Royaltech"
         txtht (cdr (assoc 40 lst)) ; calc the text height
         txtht (if (zerop txtht)(* (getvar "dimscale") 0.09375)txtht) ; correct for 0
   )
   ;; else use current text height
   (setq sty "STANDARD"
         ;;txtht (getvar 'textsize) ; calc the text height
         txtht (* (getvar "dimscale") 0.09375) ; calc the text height
   )
)


(setq dUnits (strcat " "(GetUnits)))
(if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17))
               (= (getvar "MEASUREMENT") 1) ; if metric
         )
   ;;Metric Units
   (setq txtoffset (/ txtht 2.0) ; text offset from line
         25Size(strcat "25")
         32Size(strcat "32")
         40Size(strcat "40")
         50Size(strcat "50")
         65Size(strcat "65")
         MinLen    305; Min Length to add text
         Metric    t
   )
   ;;English Units
   (setq txtoffset (/ txtht 2.0) ; text offset from line
         25Size"1\""
         32Size"1¼\""
         40Size"1½\""
         50Size"2\""
         65Size"2½\""
         MinLen    12; Min Length to add text
   )
)

(setq index -1)
(prompt "\nSelect pipes to label.")
(if (setq ss (ssget '((0 . "LINE") (8 . "M-N-INC-CPVC-25,M-N-INC-CPVC-32,M-N-INC-CPVC-40,M-N-INC-CPVC-50,M-N-INC-CPVC-65"))))
   (progn
   (command "._Undo" "_begin")
   (while (< (setq index (1+ index)) (sslength ss))
       (setq obj (vlax-ename->vla-object (ssname ss index))
             lyr (vla-get-layer obj)
             ept (vlax-get obj 'endpoint)
             spt (vlax-get obj 'startpoint)
             ang (angle spt ept)
             mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0))
             len (vlax-get obj 'length)
       )
       (if (> len MinLen)
         (progn
       (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi)))
         (setq ang (+ ang pi))
       )
       ;;text offset from pipe
       (setq mpt1(polar mpt (+ ang (/ pi 2.0)) txtoffset)
             mpt2 (polar mpt (+ ang (* pi 1.5)) txtoffset)
       )
       ;;adjust for Metric units rounded to 5 & 0 decimal points
       ;;or English Units rounded to 1/4
       (if Metric ; if metric
         (setq len$ (strcat (kdub:roundNearest len 5 0))) ; use Millimeter 05
         (setq len$ (rtos len 4 2)) ; else Inch & 0.00
       )
       (cond
         ((= lyr "M-N-INC-CPVC-25")
          (maketext mpt1 ang 25Size txtht "BC" "M-N-INC-CPVC-25-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-25-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-32")
          (maketext mpt1 ang 32Size txtht "BC" "M-N-INC-CPVC-32-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-32-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-40")
          (maketext mpt1 ang 40Size txtht "BC" "M-N-INC-CPVC-40-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-40-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-50")
          (maketext mpt1 ang 50Size txtht "BC" "M-N-INC-CPVC-50-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-50-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-65")
          (maketext mpt1 ang 65Size txtht "BC" "M-N-INC-CPVC-65-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-65-LIN" sty)
         )
       )
      ))
   )
   (command "._Undo" "_end")
   )
)
(princ)
)
(prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.")
(princ)

wizman 发表于 2022-7-6 17:53:42

另一种解决方案是使用:
(如果(和(>ang(-0.5 pi)0.0001))(

wizman 发表于 2022-7-6 17:59:59

添加了代码,加上我修改了你调用maketext的方式。
;;CAB 10.23.08版本1.4;;增加了长度过短的尺寸跳过;;CAB 10.24.08版本1.5;;使用测量ILO MEASUREINIT system var;更改了度量测试;;Zykl0 10.24.08版本1.5.1;;更改了一些图层和文本样式以适应新模板;;CAB 11.08.08版本1.6;;对线角度测试和修改的maketext调用进行了更正(defun c:LabelPipe(/index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$lst dUnits MinLen Metric txtoffset 25大小32大小40大小50大小65大小maketext kdub:roundNearest GetUnits)(defun maketext(pt ang str ht just lay sty sty/dxf72 dxf73);;(setq dxf72(cdr(assoc just’((“TC.1”)(“BC.1 kа))(setq dxf73(cdr(assoc just’((“TC.3”)(“BC.1аа”))(entmakex(list(cons 0“TEXT”)(cons 1 str);(字符串本身)(cons 6“BYLAYER”);线型名称(cons 7 sty);*文字样式名称,默认为标准,非当前(cons 8 lay);层(cons 10 pt);*第一个对齐点(OCS中)(cons 11 pt);*第二对齐点(OCS中);;(cons 39 0.0);厚度(可选;默认值=0)(cons 40 ht);*文字高度;;(cons 41 1.0);相对X比例因子、宽度因子默认为1.0(cons 50 ang);文本旋转范围;;(cons 51 0.0);斜角(cons 71 0);文本生成标志(cons 72 1);水平文本对齐类型(cons 73 dxf73);垂直文字对齐类型));;*kdub:roundNearest(numVal roundTo displayPrecision);;将数字正数四舍五入到最近的“四舍五入”数字;;和格式为n位;;kwb@theSwamp20070814(DEFUN kdub:roundNearest(numVal roundTo displayPrecision/remNum)(SETQ remNum(REM numVal roundTo))(RTOS(IF(>=(*2 remNum)roundTo)(+numVal(-roundTo remNum))(-numVal remNum))2 displayPrecision));;返回单位类型(defun GetUnits(/单位)(setq units(getvar“InsUnits”));设计中心阻力单位(cond(=单位0);名词(if(=(getvar“MEASUREMENT”)1);如果公制“mm”;使用毫米“英寸”;else Inch))(t(n(1-单位)(列出“Inch”;Inch“feet”;feet“mile”;mile“mm”;mmm“cm”;Meter“km”;km“microinch”;microinch“mil”;mili Inch“yard”;yard“angstrom”   ;埃“nm”;纳米“微米”;微米“dm”;分米“坝”;十米“hm”;百米“gm”;千兆“au”;天文单位“光年”;光年“parsec”;Parsec)));;如果存在皇家文本样式,请使用该样式(if(setq lst(tblsearch“Style”“Royaltech”))(setq sty“Royaltech”txtht(cdr(assoc 40 lst));计算文本高度txtht(if(zerop txtht)(*(getvar“dimscale”)0.09375)txtht);校正为0);;否则使用当前文本高度(setq sty“标准”;txtht(getvar的文本大小);计算文本高度txtht(*(getvar“dimscale”)0.09375);计算文本高度)(setq dUnits(strcat“”(GetUnits))(if(or(vl position(getvar“InsUnits”)'(4 5 6 7 12 14 15 16 17))(=(getvar“MEASUREMENT”)1);如果是公制);;公制单位(setq txtoffset(/txtht 2.0);第25行文字偏移量大小(strcat“25”)32大小(strcat“32”)40大小(strcat“40”)50大小(strcat“50”)65大小(strcat“65”)最小305;添加文本度量t)的最小长度;;英制单位(setq txtoffset(/txtht 2.0);从第25Size“1”32Size“1¼”40Size“1½”50Size“2”65Size“2½”MinLen 12;添加文本的最小长度)的文本偏移量(setq index-1)(提示“\n选择要标签的管道”)(if(setq ss(ssget’((0)”第“)(8”行M-N-INC-CPVC-25、M-N-INC-CPVC-32、M-N-INC-CPVC-40、M-N-INC-CPVC-50、,M-N-INC-CPVC-65”))(progn(命令“.u Undo”“\u begin”)(while(<(setq index(1+index))(sslength ss))(setq obj(vlax ename->vla object(ssname ss index))lyr(vla get layer obj)ept(vlax get obj’endpoint)spt(vlax get obj’startpoint)ang(angle spt ept)mpt(polar ept(angle ept spt)(/(distance ept spt)2.0)len(vlax get obj’length))(if(>len MinLen)(progn(if(and(>ang(-0.5 pi)0.0001))(

CAB 发表于 2022-7-6 18:01:06

 
好的解决方案一如既往,艾伦,谢谢分享。

CAB 发表于 2022-7-6 18:08:58

页: [1] 2
查看完整版本: Lisp-将pt1切换到pt2-