Grid Line (Mleader circle block txt ) Error

[Batuhan Anyığ]

(defun c:017-gridline (); *********

 

;  HELP HELP ( Mleader circle block txt ) ERROR

; secim penceresini acar
(setq ss (ssget) say (sslength ss)) 
(setq c 0)
(setq dizix '() diziy '())
; döngü secili obje sayisi kadar tekrar edecek
(repeat say
(setq ssobj (ssname ss c)) 
(setq pt1 (cdr (assoc 10 (entget ssobj))))
(setq pt2 (cdr (assoc 11 (entget ssobj))))
(if (= (car pt1) (car pt2)) 
   (setq dizix (cons (car pt1) dizix)) ) ; if bitis
(if (= (cadr pt1) (cadr pt2)) 
   (setq diziy (cons (cadr pt1) diziy)) ) ; if bitis
(setq c (1+ c)) ) ; repeat bitis
 (vl-sort dizix '>)  ; x ve y koordinatlarini 
(vl-sort diziy '>)  ;kücükten büyüge dogru 
 (princ " >> X koordinatlari :")
  (princ dizix)
  (princ " >> Y koordinatlari :")
  (princ diziy)
  ) ;defun bitis

[mhupp]

First https://www.cadtutor.net/forum/topic/427-code-posting-guidelines/#comment-555280

@SLW210 Double post

 

(defun c:017-gridline (/ ss c dizix diziy ssobj pt1 pt2)
  ; HELP HELP ( Mleader circle block txt ) ERROR
  ;secim penceresini acar
  (setq ss (ssget))
  ;(setq dizix '() diziy '()) ;not needed
  ;döngü secili obje sayisi kadar tekrar edecek
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq ssobj (entget ent))
    (setq pt1 (cdr (assoc 10 ssobj)))
    (setq pt2 (cdr (assoc 11 ssobj)))
    (if (> (distance pt1 pt2) 0.01) ;nokta1 ve nokta2 arasındaki mesafe 0,01'den büyükse
      (progn
        (setq dizix (cons (car pt1) dizix))   ;if bitis
        (setq diziy (cons (cadr pt1) diziy))  ;if bitis
      )
      ;mesafeden daha azsa hiçbir şey yapma
    )
  )
  (if (and dizix diziy) ;Si aut sunt indeterminata
    (progn                             ; sıralamadan sonra listeyi saklamanız gerekir  
      (setq dizix (vl-sort dizix '>))  ; x koordinatlarini kücükten büyüge dogru
      (setq diziy (vl-sort diziy '>))  ; y koordinatlarini kücükten büyüge dogru  
      (prompt "\n>> X koordinatlari :")
      (foreach x dizix
        (prompt (strcat "\n" (rtos x 2))) ;(rtos x 2 #) # istediğiniz hassasiyete ayarlayın
      )
      (prompt "\n>> Y koordinatlari :")
      (foreach y diziy
        (prompt (strcat "\n" (rtos y 2))) ;(rtos y 2 #) # istediğiniz hassasiyete ayarlayın
      )
      (textscr)
    )
    (princ "\nkoordinat yok")
  )
  (princ)
)

 

Edited February 2, 2023 by mhupp