Convert Hatching to Polyline

[exceed]

; SHLEN - 2023.09.05 exceed
; Extract hatch outlines from straight feature or elbow feature
; used in structural member systems, trays, piping, ducts, etc., 
; then estimate their width, and add up the lengths.

(defun C:SHLEN (/ thisdrawing mspace myline index entl ent pss ss pssl 
                resultformula resultsum pent pobj ptype plength plist pclosed
                plistlen pindex distlist p1 p2 pdist
                distlistlen dindex memorydist widthconjecture
                1dist resultlen)
  (vl-load-com)
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace thisdrawing))
  (if (setq entl (entlast))
    (progn
      (setq entl (entlast))
    )
    (progn
      (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1))))
      (setq entl (entlast))
    )
  )
  (setq pss (ssadd))
  (princ "\n Select Hatches : ")
  (setq ss (ssget '((0 . "HATCH"))))
  (command "_.hatchgenerateboundary" ss "")
  (while (> (getvar 'cmdactive) 0)
    (command pause)
  )
  (setq index 0)
  (while (setq ent (entnext entl))
    (ssadd ent pss)
    (if (= index 0)
      (progn
        (if (/= myline nil)
          (vla-delete myline)
        )
      )
    )
    (setq entl ent)
    (setq index (+ index 1))
  )
  (sssetfirst nil pss)
  (setq pssl (sslength pss))
  (setq index 0)
  (setq resultformula "")
  (setq resultsum 0)
  (repeat pssl
    (setq pent (ssname pss index))
    (setq pobj (vlax-ename->vla-object pent))
    (setq ptype (vlax-get-property pobj 'entityname))
    (setq plength (vlax-get-property pobj 'length))
    (setq plist (vlax-safearray->list (vlax-variant-value (vlax-get-property pobj 'coordinates))))
    (setq pclosed (vlax-get-property pobj 'closed))
    (if (= pclosed :vlax-true)
      (progn
        (setq plist (append plist (list (car plist) (cadr plist))))
      )
      (progn)
    )
    ;(princ pclosed)
    ;(princ plist)
    ;(princ plength)
    ;(princ ptype)
    (setq plistlen (length plist))
    (setq pindex 0)
    (setq distlist '())
    (repeat (- (/ plistlen 2) 1)
      (setq p1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
      (setq p2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
      (setq pdist (distance p1 p2))
      (setq distlist (cons pdist distlist))
      (setq pindex (+ pindex 2))
    )
    ;(princ distlist)
    (setq distlist (vl-sort distlist '<))
    (setq distlistlen (length distlist))
    (setq dindex 0)
    (setq memorydist -1)
    (setq widthconjecture 0)
    (repeat distlistlen 
      (setq 1dist (nth dindex distlist))
      (if (and (= memorydist 1dist) (= widthconjecture 0))
        (setq widthconjecture 1dist) 
      )
      (setq memorydist 1dist)
      (setq dindex (+ dindex 1))
    )
    ;(princ "\n this solid's width conjecture is = ")
    ;(princ widthconjecture)
    (setq resultlen (/ (- plength (* 2 widthconjecture)) 2))
    (setq resultformula (strcat resultformula (if (= index 0) "" "+") (vl-princ-to-string resultlen)))
    (setq resultsum (+ resultsum resultlen))
    (setq index (+ index 1))
  )
  (princ "\n total lenght of you selected")
  (princ "\n ")
  (princ resultformula)
  (princ " = ")
  (princ resultsum)
  

  (princ)
)

 

Because drawing the center line requires more time, I first calculated the length as an outline.

 

This routine guesses the width of the selected solid hatchs,

calculates the length by subtracting the width twice from the length of the OUTLINE and then dividing by 2. this is the centerline length. normally (normal means Unless there is a tee with more than 3 exits or a cross with 4 exits.)

 

This is a mathematical problem rather than a programming(coding) problem. So you too can participate.

Since the problem is how to derive the general formula for the center line using only the OUTLINE coordinate list (X Y X Y X Y X Y...)

 

Edited September 5, 2023 by exceed

[exceed]

 

; HCEN - 2023.09.05 exceed
; Draw CenterLine in hatch (straight feature or elbow feature shape)
; for structural member systems, trays, piping, ducts, etc.,

(defun C:HCEN (/ *error* thisdrawing util mspace myline index entl ent pss ss pssl 
                resultformula resultsum pent pobj ptype plength plist pclosed
                plistlen pindex distlist p1 p2 pdist
                distlistlen dindex memorydist widthconjecture
                1dist resultlen rss
                breakptlist breakp1 breakp2 bpllen bpindex
                bplistlen eobjlist eobjlistlen eindex
                remainlist 1obj 1objtype 1objsp 1objep
                bindex rssflag b1 rsslen rsindex rsofflist
                rs1 rsoff1 rsoff2 midptlist midpt rsoff1sp rsoff1ep
                mindex mflag 1midpt x delindex delrss mss 
                newmss m1 oss ossl oindex oent oobj each 
                hyp_txt )
  (vl-load-com)
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (setvar 'cmdecho oldcmdecho)
    (setvar 'peditaccept oldpeditaccept)
    (vla-EndUndoMark thisdrawing)
    (princ)
  )
  ;; Round Multiple  -  Lee Mac
  ;; Rounds 'n' to the nearest multiple of 'm'
  
  (defun LM:roundm ( n m )
      (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
  )
  ;; Round To  -  Lee Mac
  ;; Rounds 'n' to 'p' decimal places
  (defun LM:roundto (n p) 
    (LM:roundm n (expt 10.0 (- p)))
  )
  
  (vla-startundomark thisdrawing)
  (setq oldpeditaccept 0)
  (setq oldpeditaccept (getvar 'peditaccept))
  (setq oldcmdecho 0)
  (setq oldcmdecho (getvar 'cmdecho))
  (setvar 'peditaccept 1)
  (setvar 'cmdecho 0)
  
  (setq util (vla-get-utility thisdrawing))
  (setq mspace (vla-get-modelspace thisdrawing))
  (if (setq entl (entlast))
    (progn
      (setq entl (entlast))
    )
    (progn
      (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1))))
      (setq entl (entlast))
    )
  )
  (setq pss (ssadd))
  (princ "\n Select Hatches : ")
  (setq ss (ssget '((0 . "HATCH"))))
  (command "_.hatchgenerateboundary" ss "")
  (while (> (getvar 'cmdactive) 0)
    (command pause)
  )
  (setq index 0)
  (while (setq ent (entnext entl))
    (ssadd ent pss)
    (if (= index 0)
      (progn
        (if (/= myline nil)
          (vla-delete myline)
        )
      )
    )
    (setq entl ent)
    (setq index (+ index 1))
  )
  (sssetfirst nil pss)
  (setq pssl (sslength pss))
  (setq index 0)
  (setq resultformula "")
  (setq resultsum 0)
  (setq mss (ssadd))
  (repeat pssl
    
    (setq pent (ssname pss index))
    (setq pobj (vlax-ename->vla-object pent))
    (setq ptype (vlax-get-property pobj 'entityname))
    (setq plength (vlax-get-property pobj 'length))
    (setq plist (vlax-safearray->list (vlax-variant-value (vlax-get-property pobj 'coordinates))))
    (setq pclosed (vlax-get-property pobj 'closed))
    (if (= pclosed :vlax-true)
      (progn
        (setq plist (append plist (list (car plist) (cadr plist))))
      )
      (progn)
    )
    ;(princ pclosed)
    ;(princ plist)
    ;(princ plength)
    ;(princ ptype)
    (setq plistlen (length plist))
    (setq pindex 0)
    (setq distlist '())
    (repeat (- (/ plistlen 2) 1)
      (setq p1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
      (setq p2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
      (setq pdist (distance p1 p2))
      (setq distlist (cons pdist distlist))
      (setq pindex (+ pindex 2))
    )
    
    (setq sorteddistlist (vl-sort distlist '<))
    (setq distlistlen (length sorteddistlist))
    (setq dindex 0)
    (setq memorydist -1)
    (setq widthconjecture 0)
    ;(princ sorteddistlist)
    (repeat distlistlen 
      (setq 1dist (nth dindex sorteddistlist))
      ;(princ "\n 1dist - ")
      ;(princ 1dist)
      ;(princ "\n memorydist - ")
      ;(princ memorydist)
      ;(princ "\n widthconjecture - ")
      ;(princ widthconjecture)
      (if (and (= widthconjecture 0) (= (vl-princ-to-string memorydist) (vl-princ-to-string 1dist)))
        (setq widthconjecture 1dist) 
        ;(princ "\n why")
      )
      (setq memorydist 1dist)
      (setq dindex (+ dindex 1))
    )
    ;(princ "\n this solid's width conjecture is = ")
    ;(princ widthconjecture)
    (setq dindex 0)
    (setq pindex 0)
    (setq breakptlist '())
    (setq distlist (reverse distlist))
    (repeat distlistlen
      (setq 1dist (nth dindex distlist))
      (if (= (lm:roundto widthconjecture 0) (lm:roundto 1dist 0))
        (progn
          (setq breakp1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
          (setq breakp2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
          (setq breakptlist (cons (list breakp1 breakp2) breakptlist))
        )
      )
      (setq dindex (+ dindex 1))
      (setq pindex (+ pindex 2))
    )
    ;(princ breakptlist)
    (setq bplistlen (length breakptlist))
    (setq eobjlist (vlax-safearray->list (vlax-variant-value (vla-explode pobj))))
    (entdel pent)
    ;(princ eobjlist)
    (setq eobjlistlen (length eobjlist))    
    (setq eindex 0)
    (setq remainlist '())
    (setq rss (ssadd))
    
    (repeat eobjlistlen
      (setq 1obj (nth eindex eobjlist))
      (setq 1objtype (vlax-get-property 1obj 'entityname))
      (cond
        ((= 1objtype "AcDbArc")
          (setq remainlist (cons 1obj remainlist))
          (ssadd (vlax-vla-object->ename 1obj) rss)
        )
        ((= 1objtype "AcDbLine")
          (setq 1objsp (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'startpoint))))
          (setq 1objep (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'endpoint))))
          (setq bindex 0)
          (setq rssflag 0)
          ;(princ "\n bp list len - ")
          ;(princ bplistlen)
          (repeat bplistlen
            (setq b1 (nth bindex breakptlist))
            ;(princ "\n b1 - ")
            ;(princ b1)
            (if 
              (or 
                (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0))) 
                     (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0)))
                )
                (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0))) 
                     (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0)))
                )
              )
              (progn
                (setq rssflag (+ rssflag 1))
              )
              (progn 
                ;(princ "\ntest")
                ;(princ b1)
                ;(princ 1objsp)
                ;(princ 1objep)
              )
            )
            (setq bindex (+ bindex 1))
          )
          (if (/= rssflag 0)
            (progn
              (entdel (vlax-vla-object->ename 1obj))
            )
            (progn
              (setq remainlist (cons 1obj remainlist))
              (ssadd (vlax-vla-object->ename 1obj) rss)
            )
          )
        )  
        (t
          ;(ssdel (vlax-vla-object->ename 1obj) rss)
        )
      )
      (setq eindex (+ eindex 1))
    )
    ;(sssetfirst nil rss)
    (setq rsslen (sslength rss))
    ;(princ "\n rss length - ")
    ;(princ rsslen)
    ;(princ "\n remainlist - ")
    ;(princ remainlist)
    
    (setq rsindex 0)
    (setq rsofflist '())
    
    (setq bindex 0)
    (setq midptlist '())
    (repeat bplistlen
      (setq bp1 (nth bindex breakptlist))
      (setq midpt (polar (car bp1) (angle (car bp1) (cadr bp1)) (/ (distance (car bp1) (cadr bp1)) 2)))
      (setq midptlist (cons midpt midptlist))
      (setq bindex (+ bindex 1))
    )
    
    ;(princ "\n mid pt list - ")
    ;(princ midptlist)
    
    (repeat rsslen
      (setq rs1 (vlax-ename->vla-object (ssname rss rsindex)))
      ;(princ rs1)
      
      (setq rsoff1 (car 
                       (vlax-safearray->list 
                         (vlax-variant-value 
                           (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) 1))
                         )
                       )
                   )
      )
      (setq rsoff1sp (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'startpoint))))
      (setq rsoff1ep (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'endpoint))))
      (setq miptlistlen (length midptlist))      
      (setq mindex 0)
      (setq mflag 0)
      (repeat miptlistlen
        (setq 1midpt (nth mindex midptlist))
        (if 
          (or 
            (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1sp) 2 2) (rtos (cadr rsoff1sp) 2 2)))
            (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1ep) 2 2) (rtos (cadr rsoff1ep) 2 2)))
          )
          (progn
            ;(princ "\n Same 1midpt - ")
            ;(princ 1midpt)
            ;(princ " / ")
            ;(princ rsoff1sp)
            ;(princ " / ")
            ;(princ rsoff1ep)
            ;(princ " select 1")
            (setq mflag (+ mflag 1))
          )
          (progn
            ;(princ "\n Same 1midpt - ")
            ;(princ 1midpt)
            ;(princ " / ")
            ;(princ rsoff1sp)
            ;(princ " / ")
            ;(princ rsoff1ep)            
;
            ;(princ " select 2")
          )
        )
        (setq mindex (+ mindex 1))
      )
      (if (= mflag 0)
        (progn
          (entdel (vlax-vla-object->ename rsoff1))
          (setq rsoff1 (car 
                           (vlax-safearray->list 
                             (vlax-variant-value 
                               (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) -1))
                             )
                           )
                       )
          )
        )
      )
      (ssadd (vlax-vla-object->ename rsoff1) mss)
      (vlax-for x (vla-get-hyperlinks rsoff1) (vla-delete x))
      (vla-add (vlax-get-property rsoff1 'Hyperlinks) (vl-princ-to-string widthconjecture))
      ;(vl-cmdf "_pedit" (vlax-vla-object->ename rsoff1) "w" widthconjecture "")
      ;(ssadd (entlast) mss)
      ;(setq rsofflist (cons rsoff1 rsofflist))
      ;(setq rsofflist (cons rsoff2 rsofflist))
      (setq rsindex (+ rsindex 1))
    )
    
    ;(princ remainlist)
    ;(setq bpllen (length breakptlist))
    ;(setq bpindex 0)
    ;(repeat bpllen
    ;  (setq bp1 (nth bpindex breakptlist))

    ;  (setq bpindex (+ bpindex 1))
    ;)
    ;(setq resultlen (/ (- plength (* 2 widthconjecture)) 2))
    ;(setq resultformula (strcat resultformula (if (= index 0) "" "+") (vl-princ-to-string resultlen)))
    ;(setq resultsum (+ resultsum resultlen))
    (setq delindex 0)
    (repeat (sslength rss)
      (setq delrss (ssname rss delindex)) 
      (entdel delrss)
      (setq delindex (+ delindex 1))
    )
    (setq index (+ index 1))
  )

  (command "-overkill" mss "o" "0.000001" "")
  
  ;(while (setq ent (entnext entl))
  ;  (ssadd ent oss)
  ;  (setq entl ent)
  ;)
  ;(sssetfirst nil)
  ;(sssetfirst nil mss)
  (setq newmss (ssadd))
  (setq mindex 0)
  (repeat (sslength mss)
    (setq m1 (ssname mss mindex))
    ;(princ m1)
    (if (entget m1)
      (progn
        (ssadd m1 newmss)
      )
      
    )
    (setq mindex (+ mindex 1))
  )
  (sssetfirst nil newmss)
  ;(command "regen")
  ;(command "select" newmss "")
  ;(princ (sslength newmss))
  (setq oss (ssadd))
  (setq entl (entlast))
  (vl-cmdf "_pedit" "_M" newmss "" "J" "0" "")
  (while (setq ent (entnext entl))
    (ssadd ent oss)
    (setq entl ent)
  )
  (sssetfirst nil oss)
  
  (setq ossl (sslength oss))
  (setq oindex 0)
  (repeat ossl
    (setq oent (ssname oss oindex))
    (setq oobj (vlax-ename->vla-object oent))
    (vlax-for each (vlax-get-property oobj 'Hyperlinks) (setq hyp_txt (strcat (vla-get-url each))))
    (vlax-put-property oobj 'constantwidth (atoi hyp_txt))
    (vlax-for x (vla-get-hyperlinks oobj) (vla-delete x))
    (setq olen (vlax-get-property oobj 'length))
    (setq resultformula (strcat resultformula (if (= oindex 0) "" "+") (vl-princ-to-string olen)))
    (setq resultsum (+ resultsum olen))
    (setq oindex (+ oindex 1))
  )
  
  (princ "\n hatches count = ")
  (princ (sslength ss))
  (princ "\n plines count - ")
  (princ oindex)
  
  ;(setq mpl (entlast))
  (princ "\n total lenght of you selected")
  (princ "\n ")
  (princ resultformula)
  (princ " = ")
  (princ resultsum)
  

  
  (setvar 'cmdecho oldcmdecho)
  (setvar 'peditaccept oldpeditaccept)
  (vla-EndUndoMark thisdrawing)
  (princ)
)

 

Edited September 5, 2023 by exceed

[Nikon]

exceed, thank you for your participation
The image shows what I need, the hatches are converted into polylines, but unfortunately your 
program creates only the outlines of the hatches for me.
"Select Hatches :
Select objects: Opposite corner: found: 32
Select objects:
Error: error Automation. Ambiguous conclusion"

Hatching - pline.dwg

Edited September 5, 2023 by Nikon

[exceed]

13 minutes ago, Nikon said:

exceed, thank you for your participation
The image shows what I need, the hatches are converted into polylines, but unfortunately your 
program creates only the outlines of the hatches for me.
"Select Hatches :
Select objects: Opposite corner: found: 32
Select objects:
Error: error Automation. Ambiguous conclusion"

Hatching - pline.dwg 53.87 kB · 0 downloads

 

 

The sample drawing also works well in my situation (zwcad).

zwcad has fewer functions than autocad, so there are usually no problems running it on autocad.

 

This difference usually occurs in lines that start with (vl-cmdf~ or (command~~ 

You can try running overkill or pedit in autocad and change the (vl-cmdf or (command~~ order accordingly.

 

This is a version that requires manual overkill and pedit.

The center line is also drawn with this. but 2lines

; HCEN - 2023.09.05 exceed
; Draw CenterLine in hatch (straight feature or elbow feature shape)
; for structural member systems, trays, piping, ducts, etc.,

(defun C:HCEN (/ *error* thisdrawing util mspace myline index entl ent pss ss pssl 
                resultformula resultsum pent pobj ptype plength plist pclosed
                plistlen pindex distlist p1 p2 pdist
                distlistlen dindex memorydist widthconjecture
                1dist resultlen rss
                breakptlist breakp1 breakp2 bpllen bpindex
                bplistlen eobjlist eobjlistlen eindex
                remainlist 1obj 1objtype 1objsp 1objep
                bindex rssflag b1 rsslen rsindex rsofflist
                rs1 rsoff1 rsoff2 midptlist midpt rsoff1sp rsoff1ep
                mindex mflag 1midpt x delindex delrss mss 
                newmss m1 oss ossl oindex oent oobj each 
                hyp_txt )
  (vl-load-com)
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (setvar 'cmdecho oldcmdecho)
    (setvar 'peditaccept oldpeditaccept)
    (vla-EndUndoMark thisdrawing)
    (princ)
  )
  
  ;; Round Multiple  -  Lee Mac
  ;; Rounds 'n' to the nearest multiple of 'm'
  (defun LM:roundm ( n m )
      (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
  )
  ;; Round To  -  Lee Mac
  ;; Rounds 'n' to 'p' decimal places
  (defun LM:roundto (n p) 
    (LM:roundm n (expt 10.0 (- p)))
  )
  
  (vla-startundomark thisdrawing)
  (setq oldpeditaccept 0)
  (setq oldpeditaccept (getvar 'peditaccept))
  (setq oldcmdecho 0)
  (setq oldcmdecho (getvar 'cmdecho))
  (setvar 'peditaccept 1)
  (setvar 'cmdecho 0)
  
  (setq util (vla-get-utility thisdrawing))
  (setq mspace (vla-get-modelspace thisdrawing))
  (if (setq entl (entlast))
    (progn
      (setq entl (entlast))
    )
    (progn
      (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1))))
      (setq entl (entlast))
    )
  )
  (setq pss (ssadd))
  (princ "\n Select Hatches : ")
  (setq ss (ssget '((0 . "HATCH"))))
  (command "_.hatchgenerateboundary" ss "")
  (while (> (getvar 'cmdactive) 0)
    (command pause)
  )
  (setq index 0)
  (while (setq ent (entnext entl))
    (ssadd ent pss)
    (if (= index 0)
      (progn
        (if (/= myline nil)
          (vla-delete myline)
        )
      )
    )
    (setq entl ent)
    (setq index (+ index 1))
  )
  (sssetfirst nil pss)
  (setq pssl (sslength pss))
  (setq index 0)
  (setq resultformula "")
  (setq resultsum 0)
  (setq mss (ssadd))
  (repeat pssl
    
    (setq pent (ssname pss index))
    (setq pobj (vlax-ename->vla-object pent))
    (setq ptype (vlax-get-property pobj 'entityname))
    (setq plength (vlax-get-property pobj 'length))
    (setq plist (vlax-safearray->list (vlax-variant-value (vlax-get-property pobj 'coordinates))))
    (setq pclosed (vlax-get-property pobj 'closed))
    (if (= pclosed :vlax-true)
      (progn
        (setq plist (append plist (list (car plist) (cadr plist))))
      )
      (progn)
    )
    ;(princ pclosed)
    ;(princ plist)
    ;(princ plength)
    ;(princ ptype)
    (setq plistlen (length plist))
    (setq pindex 0)
    (setq distlist '())
    (repeat (- (/ plistlen 2) 1)
      (setq p1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
      (setq p2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
      (setq pdist (distance p1 p2))
      (setq distlist (cons pdist distlist))
      (setq pindex (+ pindex 2))
    )
    
    (setq sorteddistlist (vl-sort distlist '<))
    (setq distlistlen (length sorteddistlist))
    (setq dindex 0)
    (setq memorydist -1)
    (setq widthconjecture 0)
    ;(princ sorteddistlist)
    (repeat distlistlen 
      (setq 1dist (nth dindex sorteddistlist))
      ;(princ "\n 1dist - ")
      ;(princ 1dist)
      ;(princ "\n memorydist - ")
      ;(princ memorydist)
      ;(princ "\n widthconjecture - ")
      ;(princ widthconjecture)
      (if (and (= widthconjecture 0) (= (vl-princ-to-string memorydist) (vl-princ-to-string 1dist)))
        (setq widthconjecture 1dist) 
        ;(princ "\n why")
      )
      (setq memorydist 1dist)
      (setq dindex (+ dindex 1))
    )
    ;(princ "\n this solid's width conjecture is = ")
    ;(princ widthconjecture)
    (setq dindex 0)
    (setq pindex 0)
    (setq breakptlist '())
    (setq distlist (reverse distlist))
    (repeat distlistlen
      (setq 1dist (nth dindex distlist))
      (if (= (lm:roundto widthconjecture 0) (lm:roundto 1dist 0))
        (progn
          (setq breakp1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
          (setq breakp2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
          (setq breakptlist (cons (list breakp1 breakp2) breakptlist))
        )
      )
      (setq dindex (+ dindex 1))
      (setq pindex (+ pindex 2))
    )
    ;(princ breakptlist)
    (setq bplistlen (length breakptlist))
    (setq eobjlist (vlax-safearray->list (vlax-variant-value (vla-explode pobj))))
    (entdel pent)
    ;(princ eobjlist)
    (setq eobjlistlen (length eobjlist))    
    (setq eindex 0)
    (setq remainlist '())
    (setq rss (ssadd))
    
    (repeat eobjlistlen
      (setq 1obj (nth eindex eobjlist))
      (setq 1objtype (vlax-get-property 1obj 'entityname))
      (cond
        ((= 1objtype "AcDbArc")
          (setq remainlist (cons 1obj remainlist))
          (ssadd (vlax-vla-object->ename 1obj) rss)
        )
        ((= 1objtype "AcDbLine")
          (setq 1objsp (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'startpoint))))
          (setq 1objep (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'endpoint))))
          (setq bindex 0)
          (setq rssflag 0)
          ;(princ "\n bp list len - ")
          ;(princ bplistlen)
          (repeat bplistlen
            (setq b1 (nth bindex breakptlist))
            ;(princ "\n b1 - ")
            ;(princ b1)
            (if 
              (or 
                (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0))) 
                     (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0)))
                )
                (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0))) 
                     (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0)))
                )
              )
              (progn
                (setq rssflag (+ rssflag 1))
              )
              (progn 
                ;(princ "\ntest")
                ;(princ b1)
                ;(princ 1objsp)
                ;(princ 1objep)
              )
            )
            (setq bindex (+ bindex 1))
          )
          (if (/= rssflag 0)
            (progn
              (entdel (vlax-vla-object->ename 1obj))
            )
            (progn
              (setq remainlist (cons 1obj remainlist))
              (ssadd (vlax-vla-object->ename 1obj) rss)
            )
          )
        )  
        (t
          ;(ssdel (vlax-vla-object->ename 1obj) rss)
        )
      )
      (setq eindex (+ eindex 1))
    )
    ;(sssetfirst nil rss)
    (setq rsslen (sslength rss))
    ;(princ "\n rss length - ")
    ;(princ rsslen)
    ;(princ "\n remainlist - ")
    ;(princ remainlist)
    
    (setq rsindex 0)
    (setq rsofflist '())
    
    (setq bindex 0)
    (setq midptlist '())
    (repeat bplistlen
      (setq bp1 (nth bindex breakptlist))
      (setq midpt (polar (car bp1) (angle (car bp1) (cadr bp1)) (/ (distance (car bp1) (cadr bp1)) 2)))
      (setq midptlist (cons midpt midptlist))
      (setq bindex (+ bindex 1))
    )
    
    ;(princ "\n mid pt list - ")
    ;(princ midptlist)
    
    (repeat rsslen
      (setq rs1 (vlax-ename->vla-object (ssname rss rsindex)))
      ;(princ rs1)
      
      (setq rsoff1 (car 
                       (vlax-safearray->list 
                         (vlax-variant-value 
                           (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) 1))
                         )
                       )
                   )
      )
      (setq rsoff1sp (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'startpoint))))
      (setq rsoff1ep (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'endpoint))))
      (setq miptlistlen (length midptlist))      
      (setq mindex 0)
      (setq mflag 0)
      (repeat miptlistlen
        (setq 1midpt (nth mindex midptlist))
        (if 
          (or 
            (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1sp) 2 2) (rtos (cadr rsoff1sp) 2 2)))
            (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1ep) 2 2) (rtos (cadr rsoff1ep) 2 2)))
          )
          (progn
            ;(princ "\n Same 1midpt - ")
            ;(princ 1midpt)
            ;(princ " / ")
            ;(princ rsoff1sp)
            ;(princ " / ")
            ;(princ rsoff1ep)
            ;(princ " select 1")
            (setq mflag (+ mflag 1))
          )
          (progn
            ;(princ "\n Same 1midpt - ")
            ;(princ 1midpt)
            ;(princ " / ")
            ;(princ rsoff1sp)
            ;(princ " / ")
            ;(princ rsoff1ep)            
;
            ;(princ " select 2")
          )
        )
        (setq mindex (+ mindex 1))
      )
      (if (= mflag 0)
        (progn
          (entdel (vlax-vla-object->ename rsoff1))
          (setq rsoff1 (car 
                           (vlax-safearray->list 
                             (vlax-variant-value 
                               (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) -1))
                             )
                           )
                       )
          )
        )
      )
      (ssadd (vlax-vla-object->ename rsoff1) mss)
      (vlax-for x (vla-get-hyperlinks rsoff1) (vla-delete x))
      (vla-add (vlax-get-property rsoff1 'Hyperlinks) (vl-princ-to-string widthconjecture))
      ;(vl-cmdf "_pedit" (vlax-vla-object->ename rsoff1) "w" widthconjecture "")
      ;(ssadd (entlast) mss)
      ;(setq rsofflist (cons rsoff1 rsofflist))
      ;(setq rsofflist (cons rsoff2 rsofflist))
      (setq rsindex (+ rsindex 1))
    )
    
    ;(princ remainlist)
    ;(setq bpllen (length breakptlist))
    ;(setq bpindex 0)
    ;(repeat bpllen
    ;  (setq bp1 (nth bpindex breakptlist))

    ;  (setq bpindex (+ bpindex 1))
    ;)
    ;(setq resultlen (/ (- plength (* 2 widthconjecture)) 2))
    ;(setq resultformula (strcat resultformula (if (= index 0) "" "+") (vl-princ-to-string resultlen)))
    ;(setq resultsum (+ resultsum resultlen))
    (setq delindex 0)
    (repeat (sslength rss)
      (setq delrss (ssname rss delindex)) 
      (entdel delrss)
      (setq delindex (+ delindex 1))
    )
    (setq index (+ index 1))
  )

  ;(command "-overkill" mss "o" "0.000001" "")
  
  ;(while (setq ent (entnext entl))
  ;  (ssadd ent oss)
  ;  (setq entl ent)
  ;)
  ;(sssetfirst nil)
  ;(sssetfirst nil mss)
  (setq newmss (ssadd))
  (setq mindex 0)
  (repeat (sslength mss)
    (setq m1 (ssname mss mindex))
    ;(princ m1)
    (if (entget m1)
      (progn
        (ssadd m1 newmss)
      )
      
    )
    (setq mindex (+ mindex 1))
  )
  (sssetfirst nil newmss)
  ;(command "regen")
  ;(command "select" newmss "")
  ;(princ (sslength newmss))
  (setq oss (ssadd))
  (setq entl (entlast))
  ;(vl-cmdf "_pedit" "_M" newmss "" "J" "0" "")
  (while (setq ent (entnext entl))
    (ssadd ent oss)
    (setq entl ent)
  )
  (sssetfirst nil oss)
  
  (setq ossl (sslength oss))
  (setq oindex 0)
  (repeat ossl
    (setq oent (ssname oss oindex))
    (setq oobj (vlax-ename->vla-object oent))
    (vlax-for each (vlax-get-property oobj 'Hyperlinks) (setq hyp_txt (strcat (vla-get-url each))))
    (vlax-put-property oobj 'constantwidth (atoi hyp_txt))
    (vlax-for x (vla-get-hyperlinks oobj) (vla-delete x))
    (setq olen (vlax-get-property oobj 'length))
    (setq resultformula (strcat resultformula (if (= oindex 0) "" "+") (vl-princ-to-string olen)))
    (setq resultsum (+ resultsum olen))
    (setq oindex (+ oindex 1))
  )
  
  (princ "\n hatches count = ")
  (princ (sslength ss))
  (princ "\n plines count - ")
  (princ oindex)
  
  ;(setq mpl (entlast))
  (princ "\n total lenght of you selected")
  (princ "\n ")
  (princ resultformula)
  (princ " = ")
  (princ resultsum)
  

  
  (setvar 'cmdecho oldcmdecho)
  (setvar 'peditaccept oldpeditaccept)
  (vla-EndUndoMark thisdrawing)
  (princ)
)

 

Edited September 5, 2023 by exceed

[Nikon]

12 minutes ago, exceed said:

 

 

The sample drawing also works well in my situation (zwcad).

zwcad has fewer functions than autocad, so there are usually no problems running it on autocad.

 

This difference usually occurs in lines that start with (command~~

Вы можете попробовать запустить overkill или pedit в autocad и соответствующим образом изменить порядок (command~~).

 

[Nikon]

I'm sorry, but it doesn't work ...

On some straight sections, the middle line appears in the form of a line ...

Please help me adapt it to AutoCAD.

Edited September 5, 2023 by Nikon

[Nikon]

exceed, You've done a great job. Your work is very valuable...
Lisp is loading successfully, but
Command: ; error: invalid argument type: VLA-OBJECT nil

Edited September 5, 2023 by Nikon

[SLW210]

Maybe something like this will help...Centerline between two polylines

[SLW210]

I think you are confusing potential helpers by using the term hatch. I think you mean an outline that appears to be of a previous polyline with width and you would desire to have it as the single polyline with width.

 

Are you wanting to change a closed polyline to a single polyline with width?

 

You need to find the center between and add the width to the polyline.

 

This LISP I have not tested, but seems closer to what you might need, at least for a start.

 

Centerline to a Closed Polyline LISP Question - Autodesk Community - AutoCAD

[Nikon]

SLW210, no it is not necessary.

HCEN Lisp converts hatches into polylines of the same width and length in the zwcad program.

This is what I need, but unfortunately my AutoCAD 2015 rus does not work,

and I do not know what needs to be fixed to work...

Command: ; error: invalid argument type: VLA-OBJECT nil
 

Edited September 5, 2023 by Nikon

[SLW210]

Sorry I thought I posted this first, the ReBound LISP by Giles will put the boundary polyline around the hatch. 

 

Some of the other LISPs may help, but ReBound worked fine on your drawing.

 

Lisp for Hatch Boundary

 

Then run the Centerline LISP from the threads I posted.

[Nikon]

I need to replace the hatching with a polyline with the same width and length.

Creating borders for hatching is not a problem...
Now I am asking for help to adapt HCEN lisp for AutoCAD...

[Steven P]

Try this one so far.... as before not finished but it should replace a hatch with a polyline.... all I need to do is put in the offset to centralise it and give it a width

 

;;remake polyline
(defun c:testthis ( / MyPoly VertexList SplitHere )
  ;;https://www.cadtutor.net/forum/topic/24364-vertices-of-a-polyline/
  (defun mAssoc ( key lst / l x )
    (foreach x lst
     (if (= key (car x))
       (setq l (cons (cdr x) l))
     )
   )
   (reverse l)
  )

  (princ "\n Select Hatches : ")
(setq PolyList (ssadd))
(setq acount 0)
(setq ss (ssget '((0 . "HATCH"))))
(while (< acount (sslength ss))
    (command "-hatchedit" (ssname ss acount) "B" "" "Y")
    (setq APoly (entlast))
    (setq MyPoly (entget APoly))
    (setq MyPoly (subst (cons 70 0) (assoc 70 MyPoly) MyPoly )) ;; open polyline
    (entmod MyPoly)(entupd APoly)
    (setq MyPoly (entget APoly))
    (setq VertexList (massoc 10 MyPOly))
    (setq SplitHere (nth (/ (length VertexList) 2) VertexList))
    (command "._break" APOly SplitHere SplitHere)
    (entdel APoly)
    (entdel (ssname ss acount))
    (setq acount (+ acount 1))
  ) ; end while

;  (setq APoly (car (entsel "Select Polyline")))
;  (setq MyPoly (entget APoly))
;  (setq VertexList (massoc 10 MyPOly))
;  (setq SplitHere (nth (/ (length VertexList) 2) VertexList))
;  (princ SplitHere)
;  (command "._break" APOly SplitHere SplitHere)
;  (entdel APoly)

)

 

[Nikon]

Steven P,  the result is shown in the picture...

and it is necessary hatching-PL

[Steven P]

Going to leave this here overnight:

 

Command: Hatch2Poly - try and break it so it will work better.

Still got to set up layers and colours, the nice stuff but it works - for me - with your sample drawing and with a test I had

 

(I don't mind making this up, I have a reverse of this making a polyline into a borderless hatch which messes with people copy and paste PDFs a tiny bit... but I should also have a way to fix it!)

 

 

;;remake polyline
(defun c:Hatch2Poly ( / PolyList acount ss APoly MyPoly VertexList SplitHere MyWidth1 MyWidth2 MyWidth pt)
  ;;https://www.cadtutor.net/forum/topic/24364-vertices-of-a-polyline/
  (defun mAssoc ( key lst / l x ) ;Get association list entries for 'key' value
    (foreach x lst
     (if (= key (car x))
       (setq l (cons (cdr x) l))
     ) ; end if
   ) ; end foreach
   (reverse l)
  ) ; end defun


(setq PolyList (ssadd))
;;ADD IN HERE MUTE, MUTTERING AND COMMAND ECHO
;;ADD UNDO START MARKER HERE
  (setq acount 0)                           ; a counter
  (princ "\n Select Hatches : ")            ; Select Hatches message
  (setq ss (ssget '((0 . "HATCH"))))        ; Select hatches
;;  (mAssoc 10 (entget (ssname ss acount)))
  (while (< acount (sslength ss))           ; Loop therough selection set
(setq Apoly nil
      MyPoly nil
      VertexList nil
      SplitHere nil
      MyWidth1 nil
      MyWidth2 nil
      MyWidth nil
      pt nil
) ; reset variables - something funny happened - edit this list later

;;ADD DELETE ANY HATCH BOUNDARY HERE
    (command "-hatchedit" (ssname ss acount) "_B" "_P" "_Y") ; recreate hatch boundary
    (setq APoly (entlast))                                   ; entity name for the boundary
    (setq MyPoly (entget APoly))                             ; entity assoc. list for boundary
;;    (setq MyPoly (subst (cons 70 0) (assoc 70 MyPoly) MyPoly )) ;; Make as open polyline - don't think it is needed now
;;    (entmod MyPoly)(entupd APoly)         ;; as above
;;    (setq MyPoly (entget APoly))          ;; as above
    (setq VertexList (massoc 10 MyPoly))    ; get list of verticies for boundary
    (setq SplitHere (nth (/ (length VertexList) 2) VertexList))  ; split boundary coordinates
;;NOTE IF HATCH HAS UNEVEN NUMBER OF VERTICIES THIS COULD GO WEIRD. COULD DO mASSOC FOR THE HATCH
    (command "._break" APoly SplitHere SplitHere)                ; Break the boundary at split
    (entdel (entlast))                      ; Delete portion of boundary that split off

    (setq VertexList (massoc 10 (entget APoly) ))                      ; get retained vertex list
    (setq MyWidth1 (distance (nth 1 VertexList) (nth 0 VertexList) ))  ; get end segment widths
    (setq MyWidth2 (distance (nth 1 (reverse VertexList)) (nth 0 (reverse VertexList)) ))
    (if (< MyWidth1 MyWidth2)              ; work out where to split off remaining hatch end
      (setq SplitHere (nth 1 VertexList)
            MyWidth MyWidth1               ; and the hatch width
            pt (nth 0 vertexlist)
      ) ; end setq
      (setq SplitHere (nth 1 (reverse VertexList))
            MyWidth MyWidth2
            pt (nth 0 vertexlist)
      ) ; end setq
    ) ; end if
    (command "._break" APoly SplitHere SplitHere)               ; split off and delete the end marker
    (if (< MyWidth1 MyWidth2)
      (progn
        (entdel APoly)
        (setq APoly (entlast))
      ) ; end progn
      (entdel (entlast))
    ) ; end if
    (entdel (ssname ss acount))           ; delete the hatch
    (command "offset" (/ MyWidth 2) APoly pt "")
    (entdel APoly)
    (command "._pedit" (entlast) "W" MyWidth "")

;;DO SOME STUFF HERE FOR COLOURS AND LAYERS
                   
    (setq acount (+ acount 1))            ; increase counter
  ) ; end while                           ; end of while loop


;;END UNDO MARK, RESET VARIABLES
 (princ)
);End

 

[exceed]

20 hours ago, Nikon said:

I need to replace the hatching with a polyline with the same width and length.

Creating borders for hatching is not a problem...
Now I am asking for help to adapt HCEN lisp for AutoCAD...

 

 

 

This routine has been tested on AutoCAD 2023.

 

; HCEN - 2023.09.06 exceed
; Draw CenterLine in hatch (straight feature or elbow feature shape)
; for structural member systems, trays, piping, ducts, etc.,
; updated 
; - Tested in autocad 2023 and zwcad 2022.
; - color inherit & delete original hatches option. (by user input)
;  This routine requires that the two line segments have the same length 
; and that length must be the shortest length.
; Straight, 90 degree elbow, 45 degree elbow, 30 degree elbow, etc. 
; Tilted cuts or odd shapes are not supported.
;  If the r value of the elbow is small and smaller than the two line 
; segment values above, an error may occur.

(defun C:HCEN (/ *error* thisdrawing util mspace myline index entl ent pss ss pssl 
               resultformula resultsum pent pobj ptype plength plist pclosed plistlen 
               pindex distlist p1 p2 pdist distlistlen dindex memorydist 
               widthconjecture 1dist resultlen rss breakptlist breakp1 breakp2 bpllen 
               bpindex bplistlen eobjlist eobjlistlen eindex remainlist 1obj 1objtype 
               1objsp 1objep bindex rssflag b1 rsslen rsindex rsofflist rs1 rsoff1 
               rsoff2 midptlist midpt rsoff1sp rsoff1ep mindex mflag 1midpt x delindex 
               delrss mss newmss m1 oss ossl oindex oent oobj each hyp_txt ssindex 
               ssslen colorlist sssindex sscolor ssent
               coloruseranswer deleteuseranswer
              ) 
  (vl-load-com)
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (setvar 'cmdecho oldcmdecho)
    (setvar 'peditaccept oldpeditaccept)
    (vla-EndUndoMark thisdrawing)
    (princ)
  )

  ;; Round Multiple  -  Lee Mac
  ;; Rounds 'n' to the nearest multiple of 'm'
  (defun LM:roundm (n m) 
    (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
  )
  ;; Round To  -  Lee Mac
  ;; Rounds 'n' to 'p' decimal places
  (defun LM:roundto (n p) 
    (LM:roundm n (expt 10.0 (- p)))
  )
  (vla-EndUndoMark thisdrawing)
  (vla-startundomark thisdrawing)
  (setq oldpeditaccept 0)
  (setq oldpeditaccept (getvar 'peditaccept))
  (setq oldcmdecho 1)
  (setq oldcmdecho (getvar 'cmdecho))
  (setvar 'peditaccept 1)
  (setvar 'cmdecho 0)

  (setq util (vla-get-utility thisdrawing))
  (setq mspace (vla-get-modelspace thisdrawing))

  (if (setq entl (entlast)) 
    (progn 
      (setq entl (entlast))
    )
    (progn 
      (setq myline (vla-addline mspace 
                                (vlax-3d-point (list 0 0 0))
                                (vlax-3d-point (list 1 1 1))
                   )
      )
      (setq entl (entlast))
    )
  )
  (setq pss (ssadd))
  (princ "\n Select Hatches : ")
  (if (setq ss (ssget '((0 . "HATCH"))))
    (progn
      (setq ssslen (sslength ss))
      (setq colorlist '())
      (setq sssindex 0)
      (setq coloruseranswer (getstring "\n Do you want to inherit the color of the hatch to the polyline? (Space Bar or any key - Yes / N - Current Color"))
      (if (= coloruseranswer nil)
        (setq coloruseranswer "Y")
        (setq coloruseranswer (strcase coloruseranswer))
      )
      (repeat ssslen 
        (setq sssent (ssname ss sssindex))
        (setq sscolor (vlax-get-property 
                        (vlax-get-property (vlax-ename->vla-object sssent) 'truecolor)
                        'colorindex
                      )
        )
        ;(princ sscolor)
        (princ "\n")
        (command "_.hatchgenerateboundary" sssent "")
        (if (/= coloruseranswer "N")
          (vlax-put-property (vlax-ename->vla-object (entlast)) 'color sscolor)
        )
        (setq sssindex (+ sssindex 1))
      )
    
      (setq ssindex 0)
      (while (setq ent (entnext entl)) 
        (ssadd ent pss)
        (if (= ssindex 0) 
          (progn 
            (if (/= myline nil) 
              (vla-delete myline)
            )
          )
        )
        (setq entl ent)
        (setq ssindex (+ ssindex 1))
      )
      (sssetfirst nil pss)
      (setq pssl (sslength pss))
      (setq index 0)
      (setq resultformula "")
      (setq resultsum 0)
      (setq mss (ssadd))
    
      (repeat pssl 
        (setq pent (ssname pss index))
        (setq pobj (vlax-ename->vla-object pent))
        (setq ptype (vlax-get-property pobj 'entityname))
        (setq plength (vlax-get-property pobj 'length))
        (setq plist (vlax-safearray->list 
                      (vlax-variant-value (vlax-get-property pobj 'coordinates))
                    )
        )
        (setq pclosed (vlax-get-property pobj 'closed))
        (if (= pclosed :vlax-true) 
          (progn 
            (setq plist (append plist (list (car plist) (cadr plist))))
          )
          (progn)
        )
        (setq plistlen (length plist))
        (setq pindex 0)
        (setq distlist '())
        (repeat (- (/ plistlen 2) 1) 
          (setq p1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
          (setq p2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
          (setq pdist (distance p1 p2))
          (setq distlist (cons pdist distlist))
          (setq pindex (+ pindex 2))
        )
    
        (setq sorteddistlist (vl-sort distlist '<))
        (setq distlistlen (length sorteddistlist))
        (setq dindex 0)
        (setq memorydist -1)
        (setq widthconjecture 0)
        (repeat distlistlen 
          (setq 1dist (nth dindex sorteddistlist))
          (if 
            (and (= widthconjecture 0) 
                 (= (vl-princ-to-string memorydist) (vl-princ-to-string 1dist))
            )
            (setq widthconjecture 1dist)
          )
          (setq memorydist 1dist)
          (setq dindex (+ dindex 1))
        )
        (if (= widthconjecture 0)
          (setq widthconjecture (car sorteddistlist))
        )
        (setq dindex 0)
        (setq pindex 0)
        (setq breakptlist '())
        (setq distlist (reverse distlist))
        (repeat distlistlen 
          (setq 1dist (nth dindex distlist))
          (if (= (lm:roundto widthconjecture 0) (lm:roundto 1dist 0)) 
            (progn 
              (setq breakp1 (list (nth pindex plist) (nth (+ pindex 1) plist)))
              (setq breakp2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist)))
              (setq breakptlist (cons (list breakp1 breakp2) breakptlist))
            )
          )
          (setq dindex (+ dindex 1))
          (setq pindex (+ pindex 2))
        )
        (setq bplistlen (length breakptlist))
        (setq eobjlist (vlax-safearray->list (vlax-variant-value (vla-explode pobj))))
        (entdel pent)
        (setq eobjlistlen (length eobjlist))
        (setq eindex 0)
        (setq remainlist '())
        (setq rss (ssadd))
    
        (repeat eobjlistlen 
          (setq 1obj (nth eindex eobjlist))
          (setq 1objtype (vlax-get-property 1obj 'entityname))
          (cond 
            ((= 1objtype "AcDbArc")
             (setq remainlist (cons 1obj remainlist))
             (ssadd (vlax-vla-object->ename 1obj) rss)
            )
            ((= 1objtype "AcDbLine")
             (setq 1objsp (vlax-safearray->list 
                            (vlax-variant-value (vlax-get-property 1obj 'startpoint))
                          )
             )
             (setq 1objep (vlax-safearray->list 
                            (vlax-variant-value (vlax-get-property 1obj 'endpoint))
                          )
             )
             (if (/= (lm:roundto (distance 1objsp 1objep) 0) 0) 
               (progn 
                 (setq bindex 0)
                 (setq rssflag 0)
                 (repeat bplistlen 
                   (setq b1 (nth bindex breakptlist))
                   (if 
                     (or 
                       (and 
                         (= (lm:roundto (car (car b1)) 0) (lm:roundto (car 1objsp) 0))
                         (= (lm:roundto (cadr (car b1)) 0) 
                            (lm:roundto (cadr 1objsp) 0)
                         )
                         (= (lm:roundto (car (cadr b1)) 0) (lm:roundto (car 1objep) 0))
                         (= (lm:roundto (cadr (cadr b1)) 0) 
                            (lm:roundto (cadr 1objep) 0)
                         )
                       )
                       (and 
                         (= (lm:roundto (car (car b1)) 0) (lm:roundto (car 1objep) 0))
                         (= (lm:roundto (cadr (car b1)) 0) 
                            (lm:roundto (cadr 1objep) 0)
                         )
                         (= (lm:roundto (car (cadr b1)) 0) (lm:roundto (car 1objsp) 0))
                         (= (lm:roundto (cadr (cadr b1)) 0) 
                            (lm:roundto (cadr 1objsp) 0)
                         )
                       )
                     )
                     (progn 
                       (setq rssflag (+ rssflag 1))
                     )
                     (progn 
                     )
                   )
                   (setq bindex (+ bindex 1))
                 )
                 (if (/= rssflag 0) 
                   (progn 
                     (entdel (vlax-vla-object->ename 1obj))
                   )
                   (progn 
                     (setq remainlist (cons 1obj remainlist))
                     (ssadd (vlax-vla-object->ename 1obj) rss)
                   )
                 )
               )
               (progn 
                 (entdel (vlax-vla-object->ename 1obj))
               )
             )
            )
            (t
            )
          )
          (setq eindex (+ eindex 1))
        )
        (setq rsslen 0)
        (if rss 
          (progn 
            (setq rsslen (sslength rss))
            (setq rsindex 0)
            (setq rsofflist '())
    
            (setq bindex 0)
            (setq midptlist '())
            (repeat bplistlen 
              (setq bp1 (nth bindex breakptlist))
              (setq midpt (polar (car bp1) 
                                 (angle (car bp1) (cadr bp1))
                                 (/ (distance (car bp1) (cadr bp1)) 2)
                          )
              )
              (setq midptlist (cons midpt midptlist))
              (setq bindex (+ bindex 1))
            )
            (repeat rsslen 
              (setq rs1 (vlax-ename->vla-object (ssname rss rsindex)))
              (setq rsoff1 (car 
                             (vlax-safearray->list 
                               (vlax-variant-value 
                                 (vlax-invoke-method rs1 
                                                     'Offset
                                                     (* (/ widthconjecture 2) 1)
                                 )
                               )
                             )
                           )
              )
              (setq rsoff1sp (vlax-safearray->list 
                               (vlax-variant-value 
                                 (vlax-get-property rsoff1 'startpoint)
                               )
                             )
              )
              (setq rsoff1ep (vlax-safearray->list 
                               (vlax-variant-value (vlax-get-property rsoff1 'endpoint))
                             )
              )
              (setq miptlistlen (length midptlist))
              (setq mindex 0)
              (setq mflag 0)
              (repeat miptlistlen 
                (setq 1midpt (nth mindex midptlist))
                (if 
                  (or 
                    (and (= (rtos (car 1midpt) 2 2) (rtos (car rsoff1sp) 2 2)) 
                         (= (rtos (cadr 1midpt) 2 2) (rtos (cadr rsoff1sp) 2 2))
                    )
                    (and (= (rtos (car 1midpt) 2 2) (rtos (car rsoff1ep) 2 2)) 
                         (= (rtos (cadr rsoff1ep) 2 2) (rtos (cadr 1midpt) 2 2))
                    )
                  )
                  (progn 
                    (setq mflag (+ mflag 1))
                  )
                  (progn 
                  )
                )
                (setq mindex (+ mindex 1))
              )
              (if (= mflag 0) 
                (progn 
                  (entdel (vlax-vla-object->ename rsoff1))
                  (setq rsoff1 (car 
                                 (vlax-safearray->list 
                                   (vlax-variant-value 
                                     (vlax-invoke-method rs1 
                                                         'Offset
                                                         (* (/ widthconjecture 2) -1)
                                     )
                                   )
                                 )
                               )
                  )
                  (entdel (vlax-vla-object->ename rs1))
                )
                (progn 
                  (entdel (vlax-vla-object->ename rs1))
                )
              )
              (ssadd (vlax-vla-object->ename rsoff1) mss)
              (vlax-for x (vla-get-hyperlinks rsoff1) (vla-delete x))
              (vla-add (vlax-get-property rsoff1 'Hyperlinks) 
                       (vl-princ-to-string widthconjecture)
              )
              (setq rsindex (+ rsindex 1))
            )
          )
        )
        (setq index (+ index 1))
      )
      (setq newmss (ssadd))
      (setq mindex 0)
      (repeat (sslength mss) 
        (setq m1 (ssname mss mindex))
        ;(princ m1)
        (if (entget m1) 
          (progn 
            (ssadd m1 newmss)
          )
        )
        (setq mindex (+ mindex 1))
      )
      (sssetfirst nil newmss)
      (setq oss (ssadd))
      (setq entl (entlast))
      (command "_pedit" "_M" newmss "" "J" "0" "")
      (while (setq ent (entnext entl)) 
        (ssadd ent oss)
        (setq entl ent)
      )
      (sssetfirst nil oss)
    
      (setq ossl (sslength oss))
      (setq oindex 0)
      (repeat ossl 
        (setq oent (ssname oss oindex))
        (setq oobj (vlax-ename->vla-object oent))
        (vlax-for each (vlax-get-property oobj 'Hyperlinks) 
          (setq hyp_txt (strcat (vla-get-url each)))
        )
        (vlax-put-property oobj 'constantwidth (atoi hyp_txt))
        (vlax-for x (vla-get-hyperlinks oobj) (vla-delete x))
        (setq olen (vlax-get-property oobj 'length))
        (setq resultformula (strcat resultformula 
                                    (if (= oindex 0) "" " + ")
                                    (vl-princ-to-string olen)
                            )
        )
        (setq resultsum (+ resultsum olen))
        (setq oindex (+ oindex 1))
      )
    
      (princ "\n hatches count = ")
      (princ (sslength ss))
      (princ "\n plines count - ")
      (princ oindex)
      (princ "\n total lenght of you selected")
      (princ "\n ")
      (princ resultformula)
      (princ " = ")
      (princ resultsum)
      (command "erase" rss "")
      (command "erase" pss "")
      (if (= (sslength ss) oindex)
        (progn
          (setq deleteuseranswer (getstring "\n The number of hatches and polylines is the same. Are you sure you want to delete the original hatch? (SpaceBar or AnyKey - Yes / N - No)"))
          (if (= deleteuseranswer nil)
            (setq deleteuseranswer "Y")
            (setq deleteuseranswer (strcase deleteuseranswer))
          )
          (if (/= deleteuseranswer "N")
            (command "erase" ss "")
          )
        )
        (progn
          (princ "\n The number of hatches and polylines does not match. There may be a problem, so please check manually.")
        )
      )
      (sssetfirst nil oss)
    )
    (progn
      (princ "\n There are no hatches in the selection set. Please try again.")
    )
  )

  (setvar 'cmdecho oldcmdecho)
  (setvar 'peditaccept oldpeditaccept)
  (vla-EndUndoMark thisdrawing)
  (princ)
)

 

below memo is for other people who lisping. not how to use this.

there was a difference in the basic command, hatchgenerateboundary works differently in zwcad and autocad.

In autocad, length 0 line is created, and in zwcad, it does not.

 

Since it is the same hatch in the same drawing, there is a difference even if the boundary is a dirty issue. I didn't handle the exception for that.

even in the case of doing entdel to not exist entities. zwcad moves on to the next step without an error.

 

 

Edited September 6, 2023 by exceed
add 2 user input option

[Nikon]

@exceed, thank. You have helped me a lot!
Now polylines are created on top of the hatches.

Now the work will go faster ...

Good luck to you!

Edited December 14, 2023 by Nikon

[SLW210]

Exceed's is working here, doesn't delete the hatches. 

 

I use this to remove all hatches in a drawing.

 

(defun c:DeHatch (/)
    (if (setq h (ssget "_X" '((0 . "HATCH"))))
        (repeat (setq a (sslength h)) (entdel (ssname h (setq a (1- a)))))
    )
    (princ)
)

 

Steven P I get the arc offset.

 

[Steven P]

7 minutes ago, SLW210 said:

Exceed's is working here, doesn't delete the hatches. 

 

I use this to remove all hatches in a drawing.

 

(defun c:DeHatch (/)
    (if (setq h (ssget "_X" '((0 . "HATCH"))))
        (repeat (setq a (sslength h)) (entdel (ssname h (setq a (1- a)))))
    )
    (princ)
)

 

Steven P I get the arc offset.

 

 

 

Thanks, I'll have a look and see what I did wrong - looks like it is offsetting outwards and not inwards - and the line going down too, the same thing (they are still joined 'after')

 

[SLW210]

I'll try to look if work gives me some slack. I have short days tomorrow and Friday so trying to get ahead.