lisp Edit the existing lisp

[leanhlongpro]

This lisp can only run with CAD 2007, please edit it to run with higher generation AutoCAD (2021..). thanks

chialo.lspFetching info...

[Steven P]

To help us out, does the script just not work, or does it return any errors. Second question, what is the LISP meant to do?

[leanhlongpro]

HERE IS ITS USE

 

 

 

[leanhlongpro]

BlockMau.dwgFetching info...

[Steven P]

Did this ever work properly? There are a couple of things in the LISP that need fixing

[leanhlongpro]

  On 2/29/2024 at 3:16 PM, Steven P said:

Did this ever work properly? There are a couple of things in the LISP that need fixing

Expand  

it works with autocad 2007, can you fix it for me?

[Steven P]

Try this:

 

(defun c:clo ( / )
  ;;Add in error function in the case of cancelling, OS mode resets to as before

  (defun MyBoundary ( pt / ) (command "-BOUNDARY" pt "")(entlast)) ; to catch errors in boundary creation
  (defun RtD (r / ) (* 180.0 (/ r pi)))          ; Radians to degrees
  (defun LM:vl-setattributevalue ( blk tag val ) ; Set attribute
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
  )
  (defun LM:str->lst ( str del / pos )         ; split text
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
  )

  (setq el (entlast))
  (princ "Select Block: ")
  (setq OS_Old (getvar 'osmode))
  (setq bm (ssget "_+.:E:S" '((0 . "INSERT"))))        ; filter to single block
  (setq bn     (cdr (assoc 2 (entget (ssname bm 0))))) ; block name
  (setq Tenlo  (cdr (assoc 1 (entget (entnext (entnext (ssname bm 0))))))) ; Text value
  (setq TagName1 (cdr (assoc 2 (entget (entnext (ssname bm 0)))))); Attribute Name
  (setq TagName2 (cdr (assoc 2 (entget (entnext (entnext (ssname bm 0))))))); Attribute Name
  (setq splittext (LM:str->lst Tenlo ":"))             ; text splt at :
  (setq tengoc (last splittext))                       ; Text 'number'
  (setq stt    (getint "\nso lo dat bat dau: / Enter Value: "))

  (while (setq pt (getpoint "\npick diem: / Internal Point: "))   ; loop while points are selected
    (vl-catch-all-apply 'MyBoundary (list pt))
    (setq elSS (ssadd (entlast)))
    (if (/= el nil) (setq elSS (ssadd el elSS)) )
    (if (and (/= el nil)(= (sslength elSS) 1) )
      (progn
        (princ "\nNot enough boundary")
      )
      (progn
        (setvar 'osmode 512)                               ;set snap mode
        (setq p1 (getpoint "\nChon diem 1: Point on Boundary 1: "))   ; get point 1
        (setq p2 (getpoint p1 "\nChon diem 2: Point on Boundary 2: ")); get point 2
        (setvar 'osmode OS_Old)                            ; reset snap mode
        (setq ang (angle p1 p2))                           ; angle in radians

        (setq area (vlax-curve-getArea (entlast)))         ; get area. Error if no boundary created
        (setq st (if (< stt 10)                            ; leading zero
                   (strcat "0" (rtos stt))
                   (rtos stt)
                 )
        )

        (entdel (entlast))                                ; delete boundary. Error if no boundary
        (setq ang (+ ang (/ pi 2)))
        (if (> ang pi)
          (setq ang (- ang pi))
        )

;;Insert Block
        (command "insert" bn pt 1 1 (RtD ang))
;;Set attributes
        (LM:vl-setattributevalue (vlax-ename->vla-object (entlast)) TagName2 (strcat (car splittext) ":" st))
        (LM:vl-setattributevalue (vlax-ename->vla-object (entlast)) TagName1 (rtos area 2 1))

        (setq el (entlast))
        (setq stt  (+ stt 1))
      ) ; end progn
    ) ; end if boundary
  ) ; end while
  (setvar 'osmode OS_Old)                            ; reset snap mode
  (princ)
)